X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/15d774abedd480f35830f16c4872afd359664103..cd4aec96b72dda05135696da85b2d6ce7132bcea:/contrib/stgit.el?ds=inline diff --git a/contrib/stgit.el b/contrib/stgit.el index 1bc78a2..c71df4b 100644 --- a/contrib/stgit.el +++ b/contrib/stgit.el @@ -34,13 +34,6 @@ reload all StGit buffers." :link '(function-link stgit) :link '(url-link "http://www.procode.org/stgit/")) -(defcustom stgit-abbreviate-copies-and-renames t - "If non-nil, abbreviate copies and renames as \"dir/{old -> new}/file\" -instead of \"dir/old/file -> dir/new/file\"." - :type 'boolean - :group 'stgit - :set 'stgit-set-default) - (defcustom stgit-default-show-worktree t "Set to non-nil to by default show the working tree in a new stgit buffer. @@ -68,6 +61,34 @@ setting in an already-started StGit buffer." :group 'stgit :link '(variable-link stgit-show-ignored)) +(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." + :type 'boolean + :group 'stgit + :link '(variable-link stgit-show-patch-names)) + +(defcustom stgit-default-show-committed nil + "Set to nil to inhibit showing of historical git commits by default. + +Use \\\\[stgit-toggle-committed] \ +to toggle this setting and to control how many commits are +shown." + :type 'boolean + :group 'stgit + :link '(variable-link stgit-default-committed-count) + :link '(variable-link stgit-show-committed)) + +(defcustom stgit-default-committed-count 5 + "The number of historical commits to show when `stgit-show-committed' +is enabled." + :type 'number + :group 'stgit + :link '(variable-link stgit-default-show-committed) + :link '(variable-link stgit-committed-count)) + (defcustom stgit-default-show-svn t "Set to non-nil to by default show subversion information in a new stgit buffer. @@ -78,6 +99,13 @@ setting in an already-started StGit buffer." :group 'stgit :link '(variable-link stgit-show-worktree)) +(defcustom stgit-abbreviate-copies-and-renames t + "If non-nil, abbreviate copies and renames as \"dir/{old -> new}/file\" +instead of \"dir/old/file -> dir/new/file\"." + :type 'boolean + :group 'stgit + :set 'stgit-set-default) + (defcustom stgit-find-copies-harder nil "Try harder to find copied files when listing patches. @@ -136,31 +164,6 @@ The alternate form is used when the patch name is hidden." :group 'stgit :set 'stgit-set-default) -(defcustom stgit-default-show-committed nil - "Set to nil to inhibit showing of historical git commits by default. - -Use \\\\[stgit-toggle-committed] \ -to toggle this setting and to control how many commits are -shown." - :type 'boolean - :group 'stgit - :link '(variable-link stgit-show-committed)) - -(defcustom stgit-default-committed-count 5 - "The number of historical commits to show when `stgit-show-committed' -is enabled." - :type 'number - :link '(variable-link stgit-committed-count)) - -(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." - :type 'boolean - :group 'stgit - :link '(variable-link stgit-show-patch-names)) - (defcustom stgit-file-line-format " %-11s %-2m %n %c" "The format string used to format file lines. The format string is passed to `format-spec' and the following @@ -177,62 +180,76 @@ format characters are recognized: :group 'stgit :set 'stgit-set-default) +(defcustom stgit-git-program "git" + "The program used by `stgit-mode' to run git." + :type 'string + :group 'stgit) + +(defcustom stgit-stg-program "stg" + "The program used by `stgit-mode' to run StGit." + :type 'string + :group 'stgit) + +(defgroup stgit-faces nil + "Faces for `stgit-mode'." + :group 'stgit) + (defface stgit-branch-name-face '((t :inherit bold)) "The face used for the StGit branch name" - :group 'stgit) + :group 'stgit-faces) (defface stgit-top-patch-face '((((background dark)) (:weight bold :foreground "yellow")) (((background light)) (:weight bold :foreground "purple")) (t (:weight bold))) "The face used for the top patch names" - :group 'stgit) + :group 'stgit-faces) (defface stgit-applied-patch-face '((((background dark)) (:foreground "light yellow")) (((background light)) (:foreground "purple")) (t ())) "The face used for applied patch names" - :group 'stgit) + :group 'stgit-faces) (defface stgit-unapplied-patch-face '((((background dark)) (:foreground "gray80")) (((background light)) (:foreground "orchid")) (t ())) "The face used for unapplied patch names" - :group 'stgit) + :group 'stgit-faces) (defface stgit-committed-patch-face '((((background dark)) (:foreground "gray50")) (((background light)) (:foreground "gray50")) (t ())) "The face used for already committed patch names" - :group 'stgit) + :group 'stgit-faces) (defface stgit-description-face '((((background dark)) (:foreground "tan")) (((background light)) (:foreground "dark red"))) "The face used for StGit descriptions" - :group 'stgit) + :group 'stgit-faces) (defface stgit-index-work-tree-title-face '((((supports :slant italic)) :slant italic) (t :inherit bold)) "StGit mode face used for the \"Index\" and \"Work tree\" titles" - :group 'stgit) + :group 'stgit-faces) (defface stgit-unmerged-file-face '((((class color) (background light)) (:foreground "red" :bold t)) (((class color) (background dark)) (:foreground "red" :bold t))) "StGit mode face used for unmerged file status" - :group 'stgit) + :group 'stgit-faces) (defface stgit-unknown-file-face '((((class color) (background light)) (:foreground "goldenrod" :bold t)) (((class color) (background dark)) (:foreground "goldenrod" :bold t))) "StGit mode face used for unknown file status" - :group 'stgit) + :group 'stgit-faces) (defface stgit-ignored-file-face '((((class color) (background light)) (:foreground "grey60")) @@ -243,13 +260,13 @@ format characters are recognized: '((((class color) (background light)) (:foreground "green" :bold t)) (((class color) (background dark)) (:foreground "green" :bold t))) "StGit mode face used for permission changes." - :group 'stgit) + :group 'stgit-faces) (defface stgit-modified-file-face '((((class color) (background light)) (:foreground "purple")) (((class color) (background dark)) (:foreground "salmon"))) "StGit mode face used for modified file status" - :group 'stgit) + :group 'stgit-faces) (defun stgit (dir) "Manage StGit patches for the tree in DIR. @@ -269,7 +286,7 @@ See `stgit-mode' for commands available." (let ((cdup (with-output-to-string (with-current-buffer standard-output (cd dir) - (unless (eq 0 (call-process "git" nil t nil + (unless (eq 0 (call-process stgit-git-program nil t nil "rev-parse" "--show-cdup")) (error "Cannot find top-level git tree for %s" dir)))))) (expand-file-name (concat (file-name-as-directory dir) @@ -420,11 +437,11 @@ See also `stgit-message'.") (defun stgit-run (&rest args) (setq args (stgit-make-run-args args)) - (let ((msgcmd (mapconcat #'identity args " "))) - (stgit-message "Running stg %s..." msgcmd) + (let ((msgcmd (mapconcat #'identity (cons stgit-stg-program args) " "))) + (stgit-message "Running %s..." msgcmd) (prog1 - (apply 'call-process "stg" nil standard-output nil args) - (stgit-message "Running stg %s...done" msgcmd)))) + (apply 'call-process stgit-stg-program nil standard-output nil args) + (stgit-message "Running %s...done" msgcmd)))) (defun stgit-run-silent (&rest args) (let ((stgit-inhibit-messages t)) @@ -432,11 +449,11 @@ See also `stgit-message'.") (defun stgit-run-git (&rest args) (setq args (stgit-make-run-args args)) - (let ((msgcmd (mapconcat #'identity args " "))) - (stgit-message "Running git %s..." msgcmd) + (let ((msgcmd (mapconcat #'identity (cons stgit-git-program args) " "))) + (stgit-message "Running %s..." msgcmd) (prog1 - (apply 'call-process "git" nil standard-output nil args) - (stgit-message "Running git %s...done" msgcmd)))) + (apply 'call-process stgit-git-program nil standard-output nil args) + (stgit-message "Running %s...done" msgcmd)))) (defun stgit-run-git-silent (&rest args) (let ((stgit-inhibit-messages t)) @@ -506,8 +523,8 @@ using (make-hash-table :test 'equal)." (when stgit-show-committed (let* ((show-svn stgit-show-svn) (svn-hash stgit-svn-find-rev-hash) - (base (stgit-id "{base}")) - (range (format "%s~%d..%s" base stgit-committed-count base))) + (nentries (format "-%s" stgit-committed-count)) + (base (stgit-id "{base}"))) (with-temp-buffer (let* ((standard-output (current-buffer)) (fmt (stgit-line-format)) @@ -516,7 +533,8 @@ using (make-hash-table :test 'equal)." (exit-status (stgit-run-git-silent "--no-pager" "log" "--reverse" "--pretty=oneline" - range))) + nentries + base))) (goto-char (point-min)) (if (not (zerop exit-status)) (message "Failed to run git log") @@ -1065,15 +1083,80 @@ file for (applied) copies and renames." "Move cursor down ARG patches." (interactive "p") (stgit-assert-mode) - (ewoc-goto-next stgit-ewoc (or arg 1)) - (move-to-column goal-column)) + (unless arg (setq arg 1)) + (cond ((< arg 0) + (stgit-previous-patch (- arg))) + ((zerop arg) + (move-to-column (stgit-goal-column))) + (t + (when (stgit-at-header-p) + (ewoc-goto-node stgit-ewoc (ewoc-nth stgit-ewoc 0)) + (setq arg (1- arg))) + (ewoc-goto-next stgit-ewoc arg) + (move-to-column goal-column)))) (defun stgit-previous-patch (&optional arg) "Move cursor up ARG patches." (interactive "p") (stgit-assert-mode) - (ewoc-goto-prev stgit-ewoc (or arg 1)) - (move-to-column goal-column)) + (unless arg (setq arg 1)) + (cond ((< arg 0) + (stgit-next-patch (- arg))) + ((zerop arg) + (move-to-column (stgit-goal-column))) + ((stgit-at-header-p) + (goto-char (point-min))) + (t + (let ((opatch (stgit-patch-at-point))) + (ewoc-goto-prev stgit-ewoc arg) + (unless (zerop arg) + (when (eq opatch (stgit-patch-at-point)) + (goto-char (point-min))))) + (move-to-column (stgit-goal-column))))) + +(defun stgit-previous-patch-group (&optional arg) + "Move to the previous group of patches. + +If ARG is non-nil, do this ARG times. If ARG is negative, move +-ARG groups forward instead; cf. `stgit-next-patch-group'." + (interactive "p") + (stgit-assert-mode) + (if (< arg 0) + (stgit-previous-patch-group (- arg)) + (while (and (not (bobp)) + (> arg 0)) + (stgit-previous-patch 1) + (let* ((opoint (point)) + (patch (stgit-patch-at-point)) + (status (and patch (stgit-patch->status patch)))) + (while (and (not (bobp)) + (let* ((npatch (stgit-patch-at-point)) + (nstatus (and npatch (stgit-patch->status npatch)))) + (eq status nstatus))) + (setq opoint (point)) + (stgit-previous-patch 1)) + (goto-char opoint)) + (setq arg (1- arg))))) + +(defun stgit-next-patch-group (&optional arg) + "Move to the next group of patches. + +If ARG is non-nil, do this ARG times. If ARG is negative, move +-ARG groups backwards instead; cf. `stgit-previous-patch-group'." + (interactive "p") + (stgit-assert-mode) + (if (< arg 0) + (stgit-previous-patch-group (- arg)) + (while (and (not (eobp)) + (> arg 0)) + (let* ((patch (stgit-patch-at-point)) + (status (and patch (stgit-patch->status patch)))) + (while (and (not (eobp)) + (let* ((npatch (stgit-patch-at-point)) + (nstatus (and npatch (stgit-patch->status npatch)))) + (eq status nstatus))) + (stgit-next-patch 1))) + (setq arg (1- arg))))) (defvar stgit-mode-hook nil "Run after `stgit-mode' is setup.") @@ -1113,8 +1196,10 @@ file for (applied) copies and renames." ([down] . stgit-next-line) ("p" . stgit-previous-patch) ("n" . stgit-next-patch) - ("\M-{" . stgit-previous-patch) - ("\M-}" . stgit-next-patch) + ("\M-{" . stgit-previous-patch-group) + ("\M-}" . stgit-next-patch-group) + ([(control up)] . stgit-previous-patch-group) + ([(control down)] . stgit-next-patch-group) ("s" . stgit-git-status) ("g" . stgit-reload-or-repair) ("r" . stgit-refresh) @@ -1270,6 +1355,8 @@ file for (applied) copies and renames." :help "Switch to or create another branch"] ["Rebase branch" stgit-rebase t :help "Rebase the current branch"] + "-" + ["Customize StGit" (customize-group 'stgit)] )))) ;; disable tool bar editing buttons @@ -1301,6 +1388,8 @@ Movement commands: \\[stgit-next-line] Move to next line \\[stgit-previous-patch] Move to previous patch \\[stgit-next-patch] Move to next patch +\\[stgit-previous-patch-group] Move to previous patch group +\\[stgit-next-patch-group] Move to next patch group \\[stgit-mark-down] Mark patch and move down \\[stgit-unmark-up] Unmark patch and move up @@ -1943,6 +2032,14 @@ If ONLY-PATCHES is not nil, exclude index and work tree." (stgit-sort-patches (if unapplied unapplied patchsyms))))) (stgit-reload)) +(defun stgit-at-header-p () + "Return non-nil if point is in the header area above all patches." + (not (previous-single-property-change (point) 'patch-data))) + +(defun stgit-at-footer-p () + "Return non-nil if point is in the footer area below all patches." + (not (next-single-property-change (point) 'patch-data))) + (defun stgit-goto-target () "Return the goto target at point: a patchsym, :top, or :bottom." @@ -1952,9 +2049,9 @@ or :bottom." ((work index) nil) ((committed) :bottom) (t (stgit-patch->name patch)))) - ((not (next-single-property-change (point) 'patch-data)) + ((stgit-at-footer-p) :top) - ((not (previous-single-property-change (point) 'patch-data)) + ((stgit-at-header-p) :bottom)))) (defun stgit-goto () @@ -2016,6 +2113,8 @@ which stage to diff against in the case of unmerged files." (list unmerged-stage)) (t (list (concat patch-id "^") patch-id))) + (and (eq (stgit-file->status patched-file) 'copy) + '("--diff-filter=C")) '("--") (if (stgit-file->copy-or-rename patched-file) (list (stgit-file->cr-from patched-file) @@ -2031,7 +2130,8 @@ which stage to diff against in the case of unmerged files." (if (eq patch-id :index) '("--cached") (list unmerged-stage)))) - (let ((args (append '("show" "-O" "--patch-with-stat" "-O" "-M") + (let ((args (append '("show" "-O" "--patch-with-stat") + `("-O" ,(stgit-find-copies-harder-diff-arg)) (and space-arg (list "-O" space-arg)) '("--") (list (stgit-patch-name-at-point))))) @@ -2094,10 +2194,12 @@ greater than four (e.g., \\[universal-argument] \ (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)))) + (apply 'stgit-run-git + "diff" "--patch-with-stat" + (stgit-find-copies-harder-diff-arg) + (append (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))))) @@ -2326,16 +2428,13 @@ their position in the patch series, bottommost first. 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 - (stgit-run-silent "series" "--noprefix")))) - start) - (while (string-match "^\\(.+\\)" series start) - (let ((patchsym (intern (match-string 1 series)))) - (when (memq patchsym patchsyms) - (setq sorted-patchsyms (cons patchsym sorted-patchsyms)))) - (setq start (match-end 0))) + (let (sorted-patchsyms) + (ewoc-map #'(lambda (patch) + (let ((name (stgit-patch->name patch))) + (when (memq name patchsyms) + (setq sorted-patchsyms (cons name sorted-patchsyms)))) + nil) + stgit-ewoc) (setq sorted-patchsyms (nreverse sorted-patchsyms)) (unless allow-duplicates @@ -2469,13 +2568,16 @@ When the command has finished, reload the stgit buffer." (stgit-patches-marked-or-at-point nil 'allow-committed))) (patch-names (mapcar 'symbol-name patches)) (hyphens (find-if (lambda (s) (string-match "^-" s)) patch-names)) + (program (if git-mode stgit-git-program stgit-stg-program)) (defaultcmd (if patches - (concat (if git-mode "git" "stg") " " + (concat program + " " (and hyphens "-- ") (mapconcat (if git-mode 'stgit-id 'identity) patch-names " ")) - "stg ")) - (cmd (read-from-minibuffer "Shell command: " (cons defaultcmd 5) + (concat stgit-stg-program " "))) + (cmd (read-from-minibuffer "Shell command: " + (cons defaultcmd (+ (length program) 2)) nil nil 'shell-command-history)) (async (string-match "&[ \t]*\\'" cmd)) (buffer (get-buffer-create