X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/ddfdced94e9921382e8b2e90cb17df4bdb2273dc..6fdc354699860c63cc7fbab9c25b2b6c874074a8:/contrib/stgit.el diff --git a/contrib/stgit.el b/contrib/stgit.el index 3ebeb72..f08b007 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,11 +44,30 @@ 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 this \ +setting in an already-started StGit buffer." :type 'boolean :group 'stgit :link '(variable-link stgit-show-worktree)) +(defcustom stgit-default-show-unknown nil + "Set to non-nil to by default show unknown files a new stgit buffer. + +Use \\\\[stgit-toggle-unknown] to toggle this \ +setting in an already-started StGit buffer." + :type 'boolean + :group 'stgit + :link '(variable-link stgit-show-unknown)) + +(defcustom stgit-default-show-ignored nil + "Set to non-nil to by default show ignored files a new stgit buffer. + +Use \\\\[stgit-toggle-ignored] to toggle this \ +setting in an already-started StGit buffer." + :type 'boolean + :group 'stgit + :link '(variable-link stgit-show-ignored)) + (defcustom stgit-find-copies-harder nil "Try harder to find copied files when listing patches. @@ -98,8 +118,8 @@ variable is used instead." (defcustom stgit-noname-patch-line-format "%s%m%e%D" "The alternate format string used to format patch lines. It has the same semantics as `stgit-patch-line-format', and the -display can be toggled between the two formats using -\\>\\[stgit-toggle-patch-names]. +display can be toggled between the two formats using \ +\\\\[stgit-toggle-patch-names]. The alternate form is used when the patch name is hidden." :type 'string @@ -109,8 +129,8 @@ The alternate form is used when the patch name is hidden." (defcustom stgit-default-show-patch-names t "If non-nil, default to showing patch names in a new stgit buffer. -Use \\\\[stgit-toggle-patch-names] to toggle the -this setting in an already-started StGit buffer." +Use \\\\[stgit-toggle-patch-names] \ +to toggle the this setting in an already-started StGit buffer." :type 'boolean :group 'stgit :link '(variable-link stgit-show-patch-names)) @@ -269,14 +289,19 @@ A newline is appended." (error)) (insert (match-string 1 text) ?\n)) +(defun stgit-line-format () + "Return the current line format; one of +`stgit-patch-line-format' and `stgit-noname-patch-line-format'" + (if stgit-show-patch-names + stgit-patch-line-format + stgit-noname-patch-line-format)) + (defun stgit-patch-pp (patch) (let* ((status (stgit-patch->status patch)) (start (point)) (name (stgit-patch->name patch)) (face (cdr (assq status stgit-patch-status-face-alist))) - (fmt (if stgit-show-patch-names - stgit-patch-line-format - stgit-noname-patch-line-format)) + (fmt (stgit-line-format)) (spec (format-spec-make ?s (case status ('applied "+") @@ -291,8 +316,10 @@ A newline is appended." ?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)) + ?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))) @@ -315,6 +342,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. @@ -381,6 +410,10 @@ 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 (.) @@ -724,16 +757,20 @@ Cf. `stgit-file-type-change-string'." (defun stgit-insert-patch-files (patch) "Expand (show modification of) the patch PATCH after the line at point." - (let* ((patchsym (stgit-patch->name patch)) - (end (point-marker)) - (args (list "-z" (stgit-find-copies-harder-diff-arg))) - (ewoc (ewoc-create #'stgit-file-pp nil nil t))) + (let* ((patchsym (stgit-patch->name patch)) + (end (point-marker)) + (args (list "-z" (stgit-find-copies-harder-diff-arg))) + (ewoc (ewoc-create #'stgit-file-pp nil nil t)) + (show-ignored stgit-show-ignored) + (show-unknown stgit-show-unknown)) (set-marker-insertion-type end t) (setf (stgit-patch->files-ewoc patch) ewoc) (with-temp-buffer (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")) @@ -741,9 +778,9 @@ at point." `("diff-tree" ,@args "-r" ,(stgit-id patchsym))))) (when (and (eq patchsym :work)) - (when stgit-show-ignored + (when show-ignored (stgit-insert-ls-files '("--ignored" "--others") "I")) - (when stgit-show-unknown + (when show-unknown (stgit-insert-ls-files '("--directory" "--no-empty-directory" "--others") "X")) @@ -832,6 +869,8 @@ See also `stgit-expand'." (stgit-process-files (lambda (f) (setq node (ewoc-enter-after ewoc node f)))))) + (move-to-column (stgit-goal-column)) + (let ((inhibit-read-only t)) (put-text-property start end 'patch-data patch)))) @@ -932,14 +971,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) @@ -994,7 +1032,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) @@ -1075,6 +1114,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 @@ -1134,6 +1175,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 @@ -1189,6 +1232,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 @@ -1208,7 +1252,9 @@ Commands for branches: Customization variables: `stgit-abbreviate-copies-and-renames' +`stgit-default-show-ignored' `stgit-default-show-patch-names' +`stgit-default-show-unknown' `stgit-default-show-worktree' `stgit-find-copies-harder' `stgit-show-worktree-mode' @@ -1220,28 +1266,101 @@ See also \\[customize-group] for the \"stgit\" group." major-mode 'stgit-mode goal-column 2) (use-local-map stgit-mode-map) - (set (make-local-variable 'list-buffers-directory) default-directory) - (set (make-local-variable 'stgit-marked-patches) nil) - (set (make-local-variable 'stgit-expanded-patches) (list :work :index)) - (set (make-local-variable 'stgit-show-patch-names) - stgit-default-show-patch-names) - (set (make-local-variable 'stgit-show-worktree) stgit-default-show-worktree) - (set (make-local-variable 'stgit-index-node) nil) - (set (make-local-variable 'stgit-worktree-node) nil) - (set (make-local-variable 'parse-sexp-lookup-properties) t) + (mapc (lambda (x) (set (make-local-variable (car x)) (cdr x))) + `((list-buffers-directory . ,default-directory) + (parse-sexp-lookup-properties . t) + (stgit-expanded-patches . (:work :index)) + (stgit-index-node . nil) + (stgit-worktree-node . nil) + (stgit-marked-patches . nil) + (stgit-show-ignored . ,stgit-default-show-ignored) + (stgit-show-patch-names . ,stgit-default-show-patch-names) + (stgit-show-unknown . ,stgit-default-show-unknown) + (stgit-show-worktree . ,stgit-default-show-worktree))) (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))))))) + ;; lists of ( ...) to be advised + '((vc-git vc-git-rename-file vc-git-revert vc-git-register) + (git git-add-file git-checkout git-revert-file git-remove-file) + (dired dired-delete-file)))) + +(defvar stgit-pending-refresh-buffers nil + "Alist of (cons `buffer' `refresh-index') of buffers that need +to be refreshed. `refresh-index' is non-nil if both work tree +and index need to be refreshed.") + +(defun stgit-run-pending-refreshs () + "Run all pending stgit buffer updates as posted by `stgit-post-refresh'." + (let ((buffers stgit-pending-refresh-buffers) + (stgit-inhibit-messages t)) + (setq stgit-pending-refresh-buffers nil) + (while buffers + (let* ((elem (car buffers)) + (buffer (car elem)) + (refresh-index (cdr elem))) + (when (buffer-name buffer) + (with-current-buffer buffer + (stgit-refresh-worktree) + (when refresh-index (stgit-refresh-index))))) + (setq buffers (cdr buffers))))) + +(defun stgit-post-refresh (buffer refresh-index) + "Update worktree status in BUFFER when Emacs becomes idle. If +REFRESH-INDEX is non-nil, also update the index." + (unless stgit-pending-refresh-buffers + (run-with-idle-timer 0.1 nil 'stgit-run-pending-refreshs)) + (let ((elem (assq buffer stgit-pending-refresh-buffers))) + (if elem + ;; if buffer is already present, set its refresh-index flag if + ;; necessary + (when refresh-index + (setcdr elem t)) + ;; new entry + (setq stgit-pending-refresh-buffers + (cons (cons buffer refresh-index) + stgit-pending-refresh-buffers))))) + +(defun stgit-update-stgit-for-buffer (&optional refresh-index) + "When Emacs becomes idle, refresh worktree status in any +`stgit-mode' buffer that shows the status of the current buffer. + +If REFRESH-INDEX is non-nil, also update the index." + (let* ((dir (cond ((derived-mode-p 'stgit-status-mode 'dired-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-post-refresh buffer refresh-index)))) (defun stgit-add-mark (patchsym) "Mark the patch PATCHSYM." @@ -1301,7 +1420,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) @@ -1382,7 +1503,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 @@ -1440,9 +1561,16 @@ If ALL is not nil, also return non-stgit branches." ((not (string-match stgit-allowed-branch-name-re branch)) (error "Invalid branch name")) ((yes-or-no-p (format "Create branch \"%s\"? " branch)) - (stgit-capture-output nil (stgit-run "branch" "--create" "--" - branch)) - t)) + (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) @@ -1483,7 +1611,7 @@ what git-config branch..stgit.parentbranch is set to." 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) @@ -1617,23 +1745,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. @@ -1643,8 +1780,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)) @@ -1668,16 +1807,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. @@ -1685,21 +1841,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) @@ -1737,6 +1894,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 @@ -1775,6 +1933,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. @@ -1874,14 +2061,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)))) @@ -1966,9 +2153,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))))) @@ -1993,11 +2180,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 @@ -2010,8 +2198,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)) @@ -2034,7 +2223,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) @@ -2064,7 +2253,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 @@ -2082,7 +2271,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 @@ -2098,6 +2287,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. @@ -2184,6 +2442,8 @@ work tree will show up." "Toggle the visibility of files ignored by git in the work tree. With ARG, show these files if ARG is positive. +Its initial setting is controlled by `stgit-default-show-ignored'. + Use \\[stgit-toggle-worktree] to show the work tree." (interactive) (stgit-assert-mode) @@ -2197,6 +2457,8 @@ Use \\[stgit-toggle-worktree] to show the work tree." "Toggle the visibility of files not registered with git in the work tree. With ARG, show these files if ARG is positive. +Its initial setting is controlled by `stgit-default-show-unknown'. + Use \\[stgit-toggle-worktree] to show the work tree." (interactive) (stgit-assert-mode)