X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/6c2d4962aa5811c49d5ffa1fbcf4772af94df427..84e1850a7cb61f9afa61eda5fa75ca14f672eadf:/contrib/stgit.el diff --git a/contrib/stgit.el b/contrib/stgit.el index f2fe021..d3d518d 100644 --- a/contrib/stgit.el +++ b/contrib/stgit.el @@ -14,6 +14,7 @@ (require 'git nil t) (require 'cl) +(require 'comint) (require 'ewoc) (require 'easymenu) (require 'format-spec) @@ -43,7 +44,8 @@ instead of \"dir/old/file -> dir/new/file\"." (defcustom stgit-default-show-worktree t "Set to non-nil to by default show the working tree in a new stgit buffer. -Use \\\\[stgit-toggle-worktree] to toggle the this setting in an already-started StGit buffer." +Use \\\\[stgit-toggle-worktree] to toggle the +this setting in an already-started StGit buffer." :type 'boolean :group 'stgit :link '(variable-link stgit-show-worktree)) @@ -262,6 +264,13 @@ directory DIR or `default-directory'" (:work "Work Tree") (t (symbol-name name))))) +(defun stgit-insert-without-trailing-whitespace (text) + "Insert TEXT in buffer using `insert', without trailing whitespace. +A newline is appended." + (unless (string-match "\\(.*?\\) *$" text) + (error)) + (insert (match-string 1 text) ?\n)) + (defun stgit-patch-pp (patch) (let* ((status (stgit-patch->status patch)) (start (point)) @@ -284,11 +293,14 @@ directory DIR or `default-directory'" ?e (if (stgit-patch->empty patch) "(empty) " "") ?d (propertize (or (stgit-patch->desc patch) "") 'face 'stgit-description-face) - ?D (propertize (or (stgit-patch->desc patch) - (stgit-patch-display-name patch)) - 'face face)))) - - (insert (format-spec fmt spec) "\n") + ?D (propertize (let ((desc (stgit-patch->desc patch))) + (if (zerop (length desc)) + (stgit-patch-display-name patch) + desc)) + 'face face))) + (text (format-spec fmt spec))) + + (stgit-insert-without-trailing-whitespace text) (put-text-property start (point) 'entry-type 'patch) (when (memq name stgit-expanded-patches) (stgit-insert-patch-files patch)) @@ -307,6 +319,8 @@ Argument DIR is the repository path." (setq buffer-read-only t)) buf)) +(def-edebug-spec stgit-capture-output + (form body)) (defmacro stgit-capture-output (name &rest body) "Capture StGit output and, if there was any output, show it in a window at the end. @@ -373,6 +387,17 @@ Returns nil if there was no output." (defvar stgit-index-node) (defvar stgit-worktree-node) +(defvar stgit-did-advise nil + "Set to non-nil if appropriate (non-stgit) git functions have +been advised to update the stgit status when necessary.") + +(defconst stgit-allowed-branch-name-re + ;; Disallow control characters, space, del, and "/:@^{}~" in + ;; "/"-separated parts; parts may not start with a period (.) + "^[^\0- ./:@^{}~\177][^\0- /:@^{}~\177]*\ +\\(/[^\0- ./:@^{}~\177][^\0- /:@^{}~\177]*\\)*$" + "Regular expression that (new) branch names must match.") + (defun stgit-refresh-index () (when stgit-index-node (ewoc-invalidate (car stgit-index-node) (cdr stgit-index-node)))) @@ -448,6 +473,12 @@ Returns nil if there was no output." stgit-marked-patches (intersection stgit-marked-patches all-patchsyms)))) +(defun stgit-current-branch () + "Return the name of the current branch." + (substring (with-output-to-string + (stgit-run-silent "branch")) + 0 -1)) + (defun stgit-reload () "Update the contents of the StGit buffer." (interactive) @@ -459,11 +490,8 @@ Returns nil if there was no output." (ewoc-filter stgit-ewoc #'(lambda (x) nil)) (ewoc-set-hf stgit-ewoc (concat "Branch: " - (propertize - (substring (with-output-to-string - (stgit-run-silent "branch")) - 0 -1) - 'face 'stgit-branch-name-face) + (propertize (stgit-current-branch) + 'face 'stgit-branch-name-face) "\n\n") (if stgit-show-worktree "--" @@ -641,7 +669,8 @@ Cf. `stgit-file-type-change-string'." (stgit-file->old-perm file) (stgit-file->new-perm file)) 'face 'stgit-description-face)))) - (insert (format-spec stgit-file-line-format spec) "\n") + (stgit-insert-without-trailing-whitespace + (format-spec stgit-file-line-format spec)) (add-text-properties start (point) (list 'entry-type 'file 'file-data file)))) @@ -715,6 +744,8 @@ at point." (let ((standard-output (current-buffer))) (apply 'stgit-run-git (cond ((eq patchsym :work) + (let (standard-output) + (stgit-run-git "update-index" "--refresh")) `("diff-files" "-0" ,@args)) ((eq patchsym :index) `("diff-index" ,@args "--cached" "HEAD")) @@ -913,14 +944,13 @@ file for (applied) copies and renames." (unless stgit-mode-map (let ((diff-map (make-sparse-keymap)) (toggle-map (make-sparse-keymap))) - (suppress-keymap diff-map) (mapc (lambda (arg) (define-key diff-map (car arg) (cdr arg))) '(("b" . stgit-diff-base) ("c" . stgit-diff-combined) ("m" . stgit-find-file-merge) ("o" . stgit-diff-ours) + ("r" . stgit-diff-range) ("t" . stgit-diff-theirs))) - (suppress-keymap toggle-map) (mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg))) '(("n" . stgit-toggle-patch-names) ("t" . stgit-toggle-worktree) @@ -975,7 +1005,8 @@ file for (applied) copies and renames." ("\C-c\C-b" . stgit-rebase) ("t" . ,toggle-map) ("d" . ,diff-map) - ("q" . stgit-quit)))) + ("q" . stgit-quit) + ("!" . stgit-execute)))) (let ((at-unmerged-file '(let ((file (stgit-patched-file-at-point))) (and file (eq (stgit-file->status file) @@ -1056,6 +1087,8 @@ file for (applied) copies and renames." "-" ["Show diff" stgit-diff :active (get-text-property (point) 'entry-type)] + ["Show diff for range of applied patches" stgit-diff-range + :active (= (length stgit-marked-patches) 1)] ("Merge" :active (stgit-git-index-unmerged-p) ["Combined diff" stgit-diff-combined @@ -1088,7 +1121,7 @@ file for (applied) copies and renames." :selected stgit-show-patch-names] "-" ["Switch branches" stgit-branch t - :help "Switch to another branch"] + :help "Switch to or create another branch"] ["Rebase branch" stgit-rebase t :help "Rebase the current branch"] )))) @@ -1115,6 +1148,8 @@ Basic commands: \\[stgit-git-status] Run `git-status' (if available) +\\[stgit-execute] Run an stg shell command + Movement commands: \\[stgit-previous-line] Move to previous line \\[stgit-next-line] Move to next line @@ -1170,6 +1205,7 @@ Display commands: Commands for diffs: \\[stgit-diff] Show diff of patch or file +\\[stgit-diff-range] Show diff for range of patches \\[stgit-diff-base] Show diff against the merge base \\[stgit-diff-ours] Show diff against our branch \\[stgit-diff-theirs] Show diff against their branch @@ -1184,7 +1220,7 @@ Commands for merge conflicts: \\[stgit-resolve-file] Mark unmerged file as resolved Commands for branches: -\\[stgit-branch] Switch to another branch +\\[stgit-branch] Switch to or create another branch \\[stgit-rebase] Rebase the current branch Customization variables: @@ -1211,18 +1247,53 @@ See also \\[customize-group] for the \"stgit\" group." (set (make-local-variable 'stgit-worktree-node) nil) (set (make-local-variable 'parse-sexp-lookup-properties) t) (set-variable 'truncate-lines 't) - (add-hook 'after-save-hook 'stgit-update-saved-file) + (add-hook 'after-save-hook 'stgit-update-stgit-for-buffer) + (unless stgit-did-advise + (stgit-advise) + (setq stgit-did-advise t)) (run-hooks 'stgit-mode-hook)) -(defun stgit-update-saved-file () - (let* ((file (expand-file-name buffer-file-name)) - (dir (file-name-directory file)) - (gitdir (condition-case nil (git-get-top-dir dir) - (error nil))) +(defun stgit-advise-funlist (funlist) + "Add advice to the functions in FUNLIST so we can refresh the +stgit buffers as the git status of files change." + (mapc (lambda (sym) + (when (fboundp sym) + (eval `(defadvice ,sym (after stgit-update-stgit-for-buffer) + (stgit-update-stgit-for-buffer t))) + (ad-activate sym))) + funlist)) + +(defun stgit-advise () + "Add advice to appropriate (non-stgit) git functions so we can +refresh the stgit buffers as the git status of files change." + (mapc (lambda (arg) + (let ((feature (car arg)) + (funlist (cdr arg))) + (if (featurep feature) + (stgit-advise-funlist funlist) + (add-to-list 'after-load-alist + `(,feature (stgit-advise-funlist + (quote ,funlist))))))) + '((vc-git vc-git-rename-file vc-git-revert vc-git-register) + (git git-add-file git-checkout git-revert-file git-remove-file)))) + +(defun stgit-update-stgit-for-buffer (&optional refresh-index) + "Refresh worktree status in any `stgit-mode' buffer that shows +the status of the current buffer. + +If REFRESH-INDEX is not-nil, also update the index." + (let* ((dir (cond ((eq major-mode 'git-status-mode) + default-directory) + (buffer-file-name + (file-name-directory + (expand-file-name buffer-file-name))))) + (gitdir (and dir (condition-case nil (git-get-top-dir dir) + (error nil)))) (buffer (and gitdir (stgit-find-buffer gitdir)))) (when buffer (with-current-buffer buffer - (stgit-refresh-worktree))))) + (stgit-refresh-worktree) + (when refresh-index (stgit-refresh-index)))))) (defun stgit-add-mark (patchsym) "Mark the patch PATCHSYM." @@ -1282,7 +1353,9 @@ PATCHSYM." (when (and node file) (let* ((file-ewoc (stgit-patch->files-ewoc (ewoc-data node))) (file-node (ewoc-nth file-ewoc 0))) - (while (and file-node (not (equal (stgit-file->file (ewoc-data file-node)) file))) + (while (and file-node + (not (equal (stgit-file->file (ewoc-data file-node)) + file))) (setq file-node (ewoc-next file-ewoc file-node))) (when file-node (ewoc-goto-node file-ewoc file-node) @@ -1363,7 +1436,7 @@ PATCHSYM." (stgit-assert-mode) (let ((old-patchsym (stgit-patch-name-at-point t t))) (stgit-capture-output nil - (stgit-run "rename" old-patchsym name)) + (stgit-run "rename" "--" old-patchsym name)) (let ((name-sym (intern name))) (when (memq old-patchsym stgit-expanded-patches) (setq stgit-expanded-patches @@ -1393,24 +1466,45 @@ was modified with git commands (`stgit-repair')." (stgit-run "repair")) (stgit-reload)) -(defun stgit-available-branches () - "Returns a list of the available stg branches" +(defun stgit-available-branches (&optional all) + "Returns a list of the names of the available stg branches as strings. + +If ALL is not nil, also return non-stgit branches." (let ((output (with-output-to-string (stgit-run "branch" "--list"))) + (pattern (format "^>?\\s-+%c\\s-+\\(\\S-+\\)" + (if all ?. ?s))) (start 0) result) - (while (string-match "^>?\\s-+s\\s-+\\(\\S-+\\)" output start) + (while (string-match pattern output start) (setq result (cons (match-string 1 output) result)) (setq start (match-end 0))) result)) (defun stgit-branch (branch) - "Switch to branch BRANCH." + "Switch to or create branch BRANCH." (interactive (list (completing-read "Switch to branch: " (stgit-available-branches)))) (stgit-assert-mode) - (stgit-capture-output nil (stgit-run "branch" "--" branch)) - (stgit-reload)) + (when (cond ((equal branch (stgit-current-branch)) + (error "Branch is already current")) + ((member branch (stgit-available-branches t)) + (stgit-capture-output nil (stgit-run "branch" "--" branch)) + t) + ((not (string-match stgit-allowed-branch-name-re branch)) + (error "Invalid branch name")) + ((yes-or-no-p (format "Create branch \"%s\"? " branch)) + (let ((branch-point (completing-read + "Branch from (default current branch): " + (stgit-available-branches)))) + (stgit-capture-output nil + (apply 'stgit-run + `("branch" "--create" "--" + ,branch + ,@(unless (zerop (length branch-point)) + (list branch-point))))) + t))) + (stgit-reload))) (defun stgit-available-refs (&optional omit-stgit) "Returns a list of the available git refs. @@ -1430,12 +1524,27 @@ If OMIT-STGIT is not nil, filter out \"resf/heads/*.stgit\"." result) result)))) +(defun stgit-parent-branch () + "Return the parent branch of the current stg branch as per +git-config setting branch..stgit.parentbranch." + (let ((output (with-output-to-string + (stgit-run-git-silent "config" + (format "branch.%s.stgit.parentbranch" + (stgit-current-branch)))))) + (when (string-match ".*" output) + (match-string 0 output)))) + (defun stgit-rebase (new-base) - "Rebase to NEW-BASE." + "Rebase the current branch to NEW-BASE. + +Interactively, first ask which branch to rebase to. Defaults to +what git-config branch..stgit.parentbranch is set to." (interactive (list (completing-read "Rebase to: " - (stgit-available-refs t)))) + (stgit-available-refs t) + nil nil + (stgit-parent-branch)))) (stgit-assert-mode) - (stgit-capture-output nil (stgit-run "rebase" new-base)) + (stgit-capture-output nil (stgit-run "rebase" "--" new-base)) (stgit-reload)) (defun stgit-commit (count) @@ -1569,23 +1678,32 @@ tree, or a single change in either." (stgit-reload))) +(defun stgit-push-or-pop-patches (do-push npatches) + "Push (if DO-PUSH is not nil) or pop (if DO-PUSH is nil) +NPATCHES patches, or all patches if NPATCHES is t." + (stgit-assert-mode) + (stgit-capture-output nil + (apply 'stgit-run + (if do-push "push" "pop") + (if (eq npatches t) + '("--all") + (list "-n" npatches)))) + (stgit-reload) + (stgit-refresh-git-status)) + (defun stgit-push-next (npatches) "Push the first unapplied patch. With numeric prefix argument, push that many patches." (interactive "p") - (stgit-assert-mode) - (stgit-capture-output nil (stgit-run "push" "-n" npatches)) - (stgit-reload) - (stgit-refresh-git-status)) + (stgit-push-or-pop-patches t npatches)) (defun stgit-pop-next (npatches) "Pop the topmost applied patch. -With numeric prefix argument, pop that many patches." +With numeric prefix argument, pop that many patches. + +If NPATCHES is t, pop all patches." (interactive "p") - (stgit-assert-mode) - (stgit-capture-output nil (stgit-run "pop" "-n" npatches)) - (stgit-reload) - (stgit-refresh-git-status)) + (stgit-push-or-pop-patches nil npatches)) (defun stgit-applied-patches (&optional only-patches) "Return a list of the applied patches. @@ -1595,8 +1713,10 @@ If ONLY-PATCHES is not nil, exclude index and work tree." '(applied top) '(applied top index work))) result) - (ewoc-map (lambda (patch) (when (memq (stgit-patch->status patch) states) - (setq result (cons patch result)))) + (ewoc-map (lambda (patch) + (when (memq (stgit-patch->status patch) states) + (setq result (cons patch result))) + nil) stgit-ewoc) result)) @@ -1620,16 +1740,33 @@ If ONLY-PATCHES is not nil, exclude index and work tree." (stgit-sort-patches (if unapplied unapplied patchsyms))))) (stgit-reload)) +(defun stgit-goto-target () + "Return the goto target a point; either a patchsym, :top, +or :bottom." + (let ((patchsym (stgit-patch-name-at-point))) + (cond ((memq patchsym '(:work :index)) nil) + (patchsym) + ((not (next-single-property-change (point) 'patch-data)) + :top) + ((not (previous-single-property-change (point) 'patch-data)) + :bottom)))) + (defun stgit-goto () "Go to the patch on the current line. -Pops or pushes patches to make this patch topmost." +Push or pop patches to make this patch topmost. Push or pop all +patches if used on a line after or before all patches." (interactive) (stgit-assert-mode) - (let ((patchsym (stgit-patch-name-at-point t))) - (stgit-capture-output nil - (stgit-run "goto" patchsym)) - (stgit-reload))) + (let ((patchsym (stgit-goto-target))) + (unless patchsym + (error "No patch to go to on this line")) + (case patchsym + (:top (stgit-push-or-pop-patches t t)) + (:bottom (stgit-push-or-pop-patches nil t)) + (t (stgit-capture-output nil + (stgit-run "goto" "--" patchsym)) + (stgit-reload))))) (defun stgit-id (patchsym) "Return the git commit id for PATCHSYM. @@ -1637,21 +1774,22 @@ If PATCHSYM is a keyword, returns PATCHSYM unmodified." (if (keywordp patchsym) patchsym (let ((result (with-output-to-string - (stgit-run-silent "id" patchsym)))) + (stgit-run-silent "id" "--" patchsym)))) (unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result) (error "Cannot find commit id for %s" patchsym)) (match-string 1 result)))) +(defun stgit-whitespace-diff-arg (arg) + (when (numberp arg) + (cond ((> arg 4) "--ignore-all-space") + ((> arg 1) "--ignore-space-change")))) + (defun stgit-show-patch (unmerged-stage ignore-whitespace) "Show the patch on the current line. UNMERGED-STAGE is the argument to `git-diff' that that selects which stage to diff against in the case of unmerged files." - (let ((space-arg (when (numberp ignore-whitespace) - (cond ((> ignore-whitespace 4) - "--ignore-all-space") - ((> ignore-whitespace 1) - "--ignore-space-change")))) + (let ((space-arg (stgit-whitespace-diff-arg ignore-whitespace)) (patch-name (stgit-patch-name-at-point t))) (stgit-capture-output "*StGit patch*" (case (get-text-property (point) 'entry-type) @@ -1689,6 +1827,7 @@ which stage to diff against in the case of unmerged files." (list unmerged-stage)))) (let ((args (append '("show" "-O" "--patch-with-stat" "-O" "-M") (and space-arg (list "-O" space-arg)) + '("--") (list (stgit-patch-name-at-point))))) (apply 'stgit-run args))))) (t @@ -1727,6 +1866,35 @@ greater than four (e.g., \\[universal-argument] \ "--cc" "show a combined diff") +(defun stgit-diff-range (&optional ignore-whitespace) + "Show diff for the range of patches between point and the marked patch. + +With a prefix argument, ignore whitespace. With a prefix argument +greater than four (e.g., \\[universal-argument] \ +\\[universal-argument] \\[stgit-diff-range]), ignore all whitespace." + (interactive "p") + (stgit-assert-mode) + (unless (= (length stgit-marked-patches) 1) + (error "Need exactly one patch marked")) + (let* ((patches (stgit-sort-patches (cons (stgit-patch-name-at-point t t) + stgit-marked-patches) + t)) + (first-patch (car patches)) + (second-patch (if (cdr patches) (cadr patches) first-patch)) + (whitespace-arg (stgit-whitespace-diff-arg ignore-whitespace)) + (applied (stgit-applied-patchsyms t))) + (unless (and (memq first-patch applied) (memq second-patch applied)) + (error "Can only show diff range for applied patches")) + (stgit-capture-output (format "*StGit diff %s..%s*" + first-patch second-patch) + (apply 'stgit-run-git (append '("diff" "--patch-with-stat") + (and whitespace-arg (list whitespace-arg)) + (list (format "%s^" (stgit-id first-patch)) + (stgit-id second-patch)))) + (with-current-buffer standard-output + (goto-char (point-min)) + (diff-mode))))) + (defun stgit-move-change-to-index (file &optional force) "Copies the work tree state of FILE to index, using git add or git rm. @@ -1826,14 +1994,14 @@ file ended up. You can then jump to the file with \ (setq default-directory dir) (let ((standard-output edit-buf)) (save-excursion - (stgit-run-silent "edit" "--save-template=-" patchsym))))) + (stgit-run-silent "edit" "--save-template=-" "--" patchsym))))) (defun stgit-confirm-edit () (interactive) (let ((file (make-temp-file "stgit-edit-"))) (write-region (point-min) (point-max) file) (stgit-capture-output nil - (stgit-run "edit" "-f" file stgit-edit-patchsym)) + (stgit-run "edit" "-f" file "--" stgit-edit-patchsym)) (with-current-buffer log-edit-parent-buffer (stgit-reload)))) @@ -1918,9 +2086,9 @@ the work tree and index." (if spill-p " (spilling contents to index)" ""))) - (let ((args (if spill-p - (cons "--spill" patchsyms) - patchsyms))) + (let ((args (append (when spill-p '("--spill")) + '("--") + patchsyms))) (stgit-capture-output nil (apply 'stgit-run "delete" args)) (stgit-reload))))) @@ -1945,11 +2113,12 @@ patches." (t (setq result :bottom))))) result))) -(defun stgit-sort-patches (patchsyms) +(defun stgit-sort-patches (patchsyms &optional allow-duplicates) "Returns the list of patches in PATCHSYMS sorted according to their position in the patch series, bottommost first. -PATCHSYMS must not contain duplicate entries." +PATCHSYMS must not contain duplicate entries, unless +ALLOW-DUPLICATES is not nil." (let (sorted-patchsyms (series (with-output-to-string (with-current-buffer standard-output @@ -1962,8 +2131,9 @@ PATCHSYMS must not contain duplicate entries." (setq start (match-end 0))) (setq sorted-patchsyms (nreverse sorted-patchsyms)) - (unless (= (length patchsyms) (length sorted-patchsyms)) - (error "Internal error")) + (unless allow-duplicates + (unless (= (length patchsyms) (length sorted-patchsyms)) + (error "Internal error"))) sorted-patchsyms)) @@ -1986,7 +2156,7 @@ Interactively, move the marked patches to where the point is." (let ((sorted-patchsyms (stgit-sort-patches patchsyms))) (stgit-capture-output nil (if (eq target-patch :top) - (apply 'stgit-run "float" sorted-patchsyms) + (apply 'stgit-run "float" "--" sorted-patchsyms) (apply 'stgit-run "sink" (append (unless (eq target-patch :bottom) @@ -2016,7 +2186,7 @@ deepest patch had before the squash." (let ((result (let ((standard-output edit-buf)) (save-excursion (apply 'stgit-run-silent "squash" - "--save-template=-" sorted-patchsyms))))) + "--save-template=-" "--" sorted-patchsyms))))) ;; stg squash may have reordered the patches or caused conflicts (with-current-buffer stgit-buffer @@ -2034,7 +2204,7 @@ deepest patch had before the squash." (let ((file (make-temp-file "stgit-edit-"))) (write-region (point-min) (point-max) file) (stgit-capture-output nil - (apply 'stgit-run "squash" "-f" file stgit-patchsyms)) + (apply 'stgit-run "squash" "-f" file "--" stgit-patchsyms)) (with-current-buffer log-edit-parent-buffer (stgit-clear-marks) ;; Go to first marked patch and stay there @@ -2050,6 +2220,75 @@ deepest patch had before the squash." (interactive) (describe-function 'stgit-mode)) +(defun stgit-execute-process-sentinel (process sentinel) + (let (old-sentinel stgit-buf) + (with-current-buffer (process-buffer process) + (setq old-sentinel old-process-sentinel + stgit-buf stgit-buffer)) + (and (memq (process-status process) '(exit signal)) + (buffer-live-p stgit-buf) + (with-current-buffer stgit-buf + (stgit-reload))) + (funcall old-sentinel process sentinel))) + +(defun stgit-execute-process-filter (process output) + (with-current-buffer (process-buffer process) + (let* ((old-point (point)) + (pmark (process-mark process)) + (insert-at (marker-position pmark)) + (at-pmark (= insert-at old-point))) + (goto-char insert-at) + (insert-before-markers output) + (comint-carriage-motion insert-at (point)) + (set-marker pmark (point)) + (unless at-pmark + (goto-char old-point))))) + +(defun stgit-execute () + "Prompt for an stg command to execute in a shell. + +The names of any marked patches or the patch at point are +inserted in the command to be executed. + +If the command ends in an ampersand, run it asynchronously. + +When the command has finished, reload the stgit buffer." + (interactive) + (stgit-assert-mode) + (let* ((patches (stgit-patches-marked-or-at-point nil t)) + (patch-names (mapcar 'symbol-name patches)) + (hyphens (find-if (lambda (s) (string-match "^-" s)) patch-names)) + (defaultcmd (if patches + (concat "stg " + (and hyphens "-- ") + (mapconcat 'identity patch-names " ")) + "stg ")) + (cmd (read-from-minibuffer "Shell command: " (cons defaultcmd 5) + nil nil 'shell-command-history)) + (async (string-match "&[ \t]*\\'" cmd)) + (buffer (get-buffer-create + (if async + "*Async Shell Command*" + "*Shell Command Output*")))) + ;; cannot use minibuffer as stgit-reload would overwrite it; if we + ;; show the buffer, shell-command will not use the minibuffer + (display-buffer buffer) + (shell-command cmd) + (if async + (let ((old-buffer (current-buffer))) + (with-current-buffer buffer + (let ((process (get-buffer-process buffer))) + (set (make-local-variable 'old-process-sentinel) + (process-sentinel process)) + (set (make-local-variable 'stgit-buffer) + old-buffer) + (set-process-filter process 'stgit-execute-process-filter) + (set-process-sentinel process 'stgit-execute-process-sentinel)))) + (with-current-buffer buffer + (comint-carriage-motion (point-min) (point-max))) + (shrink-window-if-larger-than-buffer (get-buffer-window buffer)) + (stgit-reload)))) + (defun stgit-undo-or-redo (redo hard) "Run stg undo or, if REDO is non-nil, stg redo.