X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/378a003d09d85f24eaaee0c3a0634e7c667326ed..e4f6fdcb38127754b8f0b31d202354db85553aff:/contrib/stgit.el diff --git a/contrib/stgit.el b/contrib/stgit.el index 0f47d4d..21ef28a 100644 --- a/contrib/stgit.el +++ b/contrib/stgit.el @@ -25,7 +25,7 @@ (cd dir) (unless (eq 0 (call-process "git" nil t nil "rev-parse" "--show-cdup")) - (error "cannot find top-level git tree for %s." dir)))))) + (error "Cannot find top-level git tree for %s" dir)))))) (expand-file-name (concat (file-name-as-directory dir) (car (split-string cdup "\n"))))))) @@ -97,6 +97,9 @@ Argument DIR is the repository path." (apply 'call-process "git" nil standard-output nil args) (message "Running git %s...done" msgcmd))) +(defun stgit-run-git-silent (&rest args) + (apply 'call-process "git" nil standard-output nil args)) + (defun stgit-reload () "Update the contents of the StGit buffer." (interactive) @@ -113,50 +116,224 @@ Argument DIR is the repository path." (goto-line curline))) (stgit-refresh-git-status)) +(defgroup stgit nil + "A user interface for the StGit patch maintenance tool." + :group 'tools) + (defface stgit-description-face '((((background dark)) (:foreground "tan")) (((background light)) (:foreground "dark red"))) - "The face used for StGit desriptions") + "The face used for StGit descriptions" + :group 'stgit) (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") + "The face used for the top patch names" + :group 'stgit) (defface stgit-applied-patch-face '((((background dark)) (:foreground "light yellow")) (((background light)) (:foreground "purple")) (t ())) - "The face used for applied patch names") + "The face used for applied patch names" + :group 'stgit) (defface stgit-unapplied-patch-face '((((background dark)) (:foreground "gray80")) (((background light)) (:foreground "orchid")) (t ())) - "The face used for unapplied patch names") + "The face used for unapplied patch names" + :group 'stgit) + +(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) + +(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) + +(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) + +(defface stgit-file-permission-face + '((((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) + +(defcustom stgit-expand-find-copies-harder + nil + "Try harder to find copied files when listing patches. + +When not nil, runs git diff-tree with the --find-copies-harder +flag, which reduces performance." + :type 'boolean + :group 'stgit) + +(defconst stgit-file-status-code-strings + (mapcar (lambda (arg) + (cons (car arg) + (propertize (cadr arg) 'face (car (cddr arg))))) + '((add "Added" stgit-modified-file-face) + (copy "Copied" stgit-modified-file-face) + (delete "Deleted" stgit-modified-file-face) + (modify "Modified" stgit-modified-file-face) + (rename "Renamed" stgit-modified-file-face) + (mode-change "Mode change" stgit-modified-file-face) + (unmerged "Unmerged" stgit-unmerged-file-face) + (unknown "Unknown" stgit-unknown-file-face))) + "Alist of code symbols to description strings") + +(defun stgit-file-status-code-as-string (code) + "Return stgit status code as string" + (let ((str (assq (if (consp code) (car code) code) + stgit-file-status-code-strings))) + (when str + (format "%-11s " + (if (and str (consp code) (/= (cdr code) 100)) + (format "%s %s" (cdr str) + (propertize (format "%d%%" (cdr code)) + 'face 'stgit-description-face)) + (cdr str)))))) + +(defun stgit-file-status-code (str &optional score) + "Return stgit status code from git status string" + (let ((code (assoc str '(("A" . add) + ("C" . copy) + ("D" . delete) + ("M" . modify) + ("R" . rename) + ("T" . mode-change) + ("U" . unmerged) + ("X" . unknown))))) + (setq code (if code (cdr code) 'unknown)) + (when (stringp score) + (if (> (length score) 0) + (setq score (string-to-number score)) + (setq score nil))) + (if score (cons code score) code))) + +(defconst stgit-file-type-strings + '((#o100 . "file") + (#o120 . "symlink") + (#o160 . "subproject")) + "Alist of names of file types") + +(defun stgit-file-type-string (type) + "Return string describing file type TYPE (the high bits of file permission). +Cf. `stgit-file-type-strings' and `stgit-file-type-change-string'." + (let ((type-str (assoc type stgit-file-type-strings))) + (or (and type-str (cdr type-str)) + (format "unknown type %o" type)))) + +(defun stgit-file-type-change-string (old-perm new-perm) + "Return string describing file type change from OLD-PERM to NEW-PERM. +Cf. `stgit-file-type-string'." + (let ((old-type (lsh old-perm -9)) + (new-type (lsh new-perm -9))) + (cond ((= old-type new-type) "") + ((zerop new-type) "") + ((zerop old-type) + (if (= new-type #o100) + "" + (format " (%s)" (stgit-file-type-string new-type)))) + (t (format " (%s -> %s)" + (stgit-file-type-string old-type) + (stgit-file-type-string new-type)))))) + +(defun stgit-file-mode-change-string (old-perm new-perm) + "Return string describing file mode change from OLD-PERM to NEW-PERM. +Cf. `stgit-file-type-change-string'." + (setq old-perm (logand old-perm #o777) + new-perm (logand new-perm #o777)) + (if (or (= old-perm new-perm) + (zerop old-perm) + (zerop new-perm)) + "" + (let* ((modified (logxor old-perm new-perm)) + (not-x-modified (logand (logxor old-perm new-perm) #o666))) + (cond ((zerop modified) "") + ((and (zerop not-x-modified) + (or (and (eq #o111 (logand old-perm #o111)) + (propertize "-x" 'face 'stgit-file-permission-face)) + (and (eq #o111 (logand new-perm #o111)) + (propertize "+x" 'face + 'stgit-file-permission-face))))) + (t (concat (propertize (format "%o" old-perm) + 'face 'stgit-file-permission-face) + (propertize " -> " + 'face 'stgit-description-face) + (propertize (format "%o" new-perm) + 'face 'stgit-file-permission-face))))))) (defun stgit-expand-patch (patchsym) + "Expand (show modification of) the patch with name PATCHSYM (a +symbol) at point. +`stgit-expand-find-copies-harder' controls how hard to try to +find copied files." (save-excursion (forward-line) - (let ((start (point))) - (stgit-run "files" (symbol-name patchsym)) - - ;; 'stg files' outputs a single newline for empty patches; it - ;; must be destroyed! - (when (and (= (1+ start) (point)) - (= (char-before) ?\n)) - (delete-backward-char 1)) - - (let ((end-marker (point-marker))) - (if (= start (point)) - (insert-string " \n") - (unless (looking-at "^") - (insert ?\n)) - (while (and (zerop (forward-line -1)) - (>= (point) start)) - (insert " "))) - (put-text-property start end-marker 'stgit-patchsym patchsym))))) + (let* ((start (point)) + (result (with-output-to-string + (stgit-run-git "diff-tree" "-r" "-z" + (if stgit-expand-find-copies-harder + "--find-copies-harder" + "-C") + (stgit-id (symbol-name patchsym)))))) + (let (mstart) + (while (string-match "\0:\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} \\(\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\\|\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\\)" + result mstart) + (let ((copy-or-rename (match-string 4 result)) + (old-perm (read (format "#o%s" (match-string 1 result)))) + (new-perm (read (format "#o%s" (match-string 2 result)))) + (line-start (point)) + status + change + properties) + (insert " ") + (if copy-or-rename + (let ((cr-score (match-string 5 result)) + (cr-from-file (match-string 6 result)) + (cr-to-file (match-string 7 result))) + (setq status (stgit-file-status-code copy-or-rename + cr-score) + properties (list 'stgit-old-file cr-from-file + 'stgit-new-file cr-to-file) + change (concat + cr-from-file + (propertize " -> " + 'face 'stgit-description-face) + cr-to-file))) + (setq status (stgit-file-status-code (match-string 8 result)) + properties (list 'stgit-file (match-string 9 result)) + change (match-string 9 result))) + + (let ((mode-change (stgit-file-mode-change-string old-perm + new-perm))) + (insert (format "%-12s" (stgit-file-status-code-as-string + status)) + mode-change + (if (> (length mode-change) 0) " " "") + change + (propertize (stgit-file-type-change-string old-perm + new-perm) + 'face 'stgit-description-face) + ?\n)) + (add-text-properties line-start (point) properties)) + (setq mstart (match-end 0)))) + (when (= start (point)) + (insert " \n")) + (put-text-property start (point) 'stgit-patchsym patchsym)))) (defun stgit-rescan () "Rescan the status buffer." @@ -229,7 +406,7 @@ Argument DIR is the repository path." "Show status using `git-status'." (interactive) (unless (fboundp 'git-status) - (error "stgit-git-status requires git-status")) + (error "The stgit-git-status command requires git-status")) (let ((dir default-directory)) (save-selected-window (pop-to-buffer nil) @@ -334,14 +511,17 @@ Commands: (run-hooks 'stgit-mode-hook)) (defun stgit-add-mark (patch) + "Mark the patch named PATCH." (let ((patchsym (intern patch))) (setq stgit-marked-patches (cons patchsym stgit-marked-patches)))) (defun stgit-remove-mark (patch) + "Unmark the patch named PATCH." (let ((patchsym (intern patch))) (setq stgit-marked-patches (delq patchsym stgit-marked-patches)))) (defun stgit-clear-marks () + "Unmark all patches." (setq stgit-marked-patches '())) (defun stgit-marked-patches () @@ -364,14 +544,29 @@ a patch." (and cause-error (error "No patch on this line")))) -(defun stgit-patched-file-at-point () - "Returns a cons of the patchsym and file name at point" - (let ((patchsym (get-text-property (point) 'stgit-patchsym))) - (when patchsym - (save-excursion - (beginning-of-line) - (when (looking-at " [A-Z] \\(.*\\)") - (cons patchsym (match-string-no-properties 1))))))) +(defun stgit-patched-file-at-point (&optional both-files) + "Returns a cons of the patchsym and file name at point. For +copies and renames, return the new file if the patch is either +applied. If BOTH-FILES is non-nil, return a cons of the old and +the new file names instead of just one name." + (let ((patchsym (get-text-property (point) 'stgit-patchsym)) + (file (get-text-property (point) 'stgit-file))) + (cond ((not patchsym) nil) + (file (cons patchsym file)) + (both-files + (cons patchsym (cons (get-text-property (point) 'stgit-old-file) + (get-text-property (point) 'stgit-new-file)))) + (t + (let ((file-sym (save-excursion + (stgit-previous-patch) + (unless (equal (stgit-patch-at-point) + (symbol-name patchsym)) + (error "Cannot find the %s patch" patchsym)) + (beginning-of-line) + (if (= (char-after) ?-) + 'stgit-old-file + 'stgit-new-file)))) + (cons patchsym (get-text-property (point) file-sym))))))) (defun stgit-patches-marked-or-at-point () "Return the names of the marked patches, or the patch on the current line." @@ -386,7 +581,8 @@ a patch." "Move point to the line containing PATCH." (let ((p (point))) (goto-char (point-min)) - (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ") nil t) + (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ") + nil t) (progn (move-to-column goal-column) t) (goto-char p) @@ -418,8 +614,8 @@ a patch." "Remove mark from the patch on the current line." (interactive) (stgit-remove-mark (stgit-patch-at-point t)) - (stgit-next-patch) - (stgit-reload)) + (stgit-reload) + (stgit-next-patch)) (defun stgit-rename (name) "Rename the patch under point to NAME." @@ -511,12 +707,18 @@ With numeric prefix argument, pop that many patches." (stgit-capture-output "*StGit patch*" (let ((patch (stgit-patch-at-point))) (if (not patch) - (let ((patched-file (stgit-patched-file-at-point))) + (let ((patched-file (stgit-patched-file-at-point t))) (unless patched-file (error "No patch or file at point")) (let ((id (stgit-id (symbol-name (car patched-file))))) (with-output-to-temp-buffer "*StGit diff*" - (stgit-run-git "diff" (concat id "^") id (cdr patched-file)) + (if (consp (cdr patched-file)) + ;; two files (copy or rename) + (stgit-run-git "diff" "-C" "-C" (concat id "^") id "--" + (cadr patched-file) (cddr patched-file)) + ;; just one file + (stgit-run-git "diff" (concat id "^") id "--" + (cdr patched-file))) (with-current-buffer standard-output (diff-mode))))) (stgit-run "show" (stgit-patch-at-point)) @@ -545,13 +747,19 @@ With numeric prefix argument, pop that many patches." (with-current-buffer log-edit-parent-buffer (stgit-reload)))) -(defun stgit-new () - "Create a new patch." - (interactive) +(defun stgit-new (add-sign) + "Create a new patch. +With a prefix argument, include a \"Signed-off-by:\" line at the +end of the patch." + (interactive "P") (let ((edit-buf (get-buffer-create "*StGit edit*")) (dir default-directory)) (log-edit 'stgit-confirm-new t nil edit-buf) - (setq default-directory dir))) + (setq default-directory dir) + (when add-sign + (save-excursion + (let ((standard-output (current-buffer))) + (stgit-run-silent "new" "--sign" "--save-template=-")))))) (defun stgit-confirm-new () (interactive) @@ -567,7 +775,8 @@ With numeric prefix argument, pop that many patches." (let ((patch "")) (while (> (length description) 0) (cond ((string-match "\\`[a-zA-Z_-]+" description) - (setq patch (downcase (concat patch (match-string 0 description)))) + (setq patch (downcase (concat patch + (match-string 0 description)))) (setq description (substring description (match-end 0)))) ((string-match "\\` +" description) (setq patch (concat patch "-")) @@ -640,9 +849,9 @@ With prefix argument, refresh the marked patch or the patch under point." (let ((patchargs (if arg (let ((patches (stgit-patches-marked-or-at-point))) (cond ((null patches) - (error "no patch to update")) + (error "No patch to update")) ((> (length patches) 1) - (error "too many patches selected")) + (error "Too many patches selected")) (t (cons "-p" patches)))) nil)))