X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/8f40753a9854938554c9cabcb296be077fd7a3eb..6f775ac964243b25490e056610e5be5527e90fa6:/contrib/stgit.el diff --git a/contrib/stgit.el b/contrib/stgit.el index 503caf7..6bb0928 100644 --- a/contrib/stgit.el +++ b/contrib/stgit.el @@ -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) @@ -144,27 +147,183 @@ Argument DIR is the repository path." "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) + (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) + (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) + (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) (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." @@ -372,14 +531,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." @@ -519,12 +693,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))