X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/8036afdd59468ace8110891047680f1d4622738a..b894e68096692a391421d7ab4ba2e4d9f382c01e:/contrib/stgit.el?ds=inline diff --git a/contrib/stgit.el b/contrib/stgit.el index 0201098..0a1aefb 100644 --- a/contrib/stgit.el +++ b/contrib/stgit.el @@ -42,8 +42,8 @@ directory DIR or `default-directory'" (with-current-buffer git-status-buffer (git-refresh-status)))))) -(defun switch-to-stgit-buffer (dir) - "Switch to a (possibly new) buffer displaying StGit patches for DIR." +(defun stgit-find-buffer (dir) + "Return the buffer displaying StGit patches for DIR, or nil if none." (setq dir (file-name-as-directory dir)) (let ((buffers (buffer-list))) (while (and buffers @@ -51,36 +51,46 @@ directory DIR or `default-directory'" (and (eq major-mode 'stgit-mode) (string= default-directory dir))))) (setq buffers (cdr buffers))) - (switch-to-buffer (if buffers - (car buffers) - (create-stgit-buffer dir))))) + (and buffers (car buffers)))) + +(defun switch-to-stgit-buffer (dir) + "Switch to a (possibly new) buffer displaying StGit patches for DIR." + (setq dir (file-name-as-directory dir)) + (let ((buffer (stgit-find-buffer dir))) + (switch-to-buffer (or buffer + (create-stgit-buffer dir))))) + (defstruct (stgit-patch) - status name desc empty) + status name desc empty files-ewoc) (defun stgit-patch-pp (patch) (let ((status (stgit-patch-status patch)) (start (point)) (name (stgit-patch-name patch))) - (insert (case status - ('applied "+") - ('top ">") - ('unapplied "-") - (t "·")) - (if (memq name stgit-marked-patches) - "*" " ") - (propertize (format "%-30s" (symbol-name name)) - 'face (case status - ('applied 'stgit-applied-patch-face) - ('top 'stgit-top-patch-face) - ('unapplied 'stgit-unapplied-patch-face))) - " " - (if (stgit-patch-empty patch) "(empty) " "") - (propertize (or (stgit-patch-desc patch) "") - 'face 'stgit-description-face)) - (add-text-properties start (point) (list 'entry-type 'patch - 'stgit-patchsym name)) + (case name + (:index (insert (propertize " Index" 'face 'italic))) + (:work (insert (propertize " Work tree" 'face 'italic))) + (t (insert (case status + ('applied "+") + ('top ">") + ('unapplied "-")) + (if (memq name stgit-marked-patches) + "*" " ") + (propertize (format "%-30s" + (symbol-name name)) + 'face (case status + ('applied 'stgit-applied-patch-face) + ('top 'stgit-top-patch-face) + ('unapplied 'stgit-unapplied-patch-face) + ('index nil) + ('work nil))) + " " + (if (stgit-patch-empty patch) "(empty) " "") + (propertize (or (stgit-patch-desc patch) "") + 'face 'stgit-description-face)))) + (put-text-property start (point) 'entry-type 'patch) (when (memq name stgit-expanded-patches) - (stgit-insert-patch-files name)) + (stgit-insert-patch-files patch)) (put-text-property start (point) 'patch-data patch))) (defun create-stgit-buffer (dir) @@ -150,6 +160,10 @@ Returns nil if there was no output." (setq args (stgit-make-run-args args)) (apply 'call-process "git" nil standard-output nil args)) +(defun stgit-index-empty-p () + "Returns non-nil if the index contains no changes from HEAD." + (zerop (stgit-run-git-silent "diff-index" "--cached" "--quiet" "HEAD"))) + (defun stgit-run-series (ewoc) (let ((first-line t)) (with-temp-buffer @@ -177,7 +191,19 @@ Returns nil if there was no output." :desc (match-string 5) :empty (string= (match-string 1) "0")))) (setq first-line nil) - (forward-line 1))))))) + (forward-line 1)) + (ewoc-enter-last ewoc + (make-stgit-patch + :status 'index + :name :index + :desc nil + :empty nil)) + (ewoc-enter-last ewoc + (make-stgit-patch + :status 'work + :name :work + :desc nil + :empty nil))))))) (defun stgit-reload () @@ -280,17 +306,18 @@ flag, which reduces performance." (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 +(defun stgit-file-status-code-as-string (file) + "Return stgit status code for FILE as a string" + (let* ((code (assq (stgit-file-status file) + stgit-file-status-code-strings)) + (score (stgit-file-cr-score file))) + (when code (format "%-11s " - (if (and str (consp code) (/= (cdr code) 100)) - (format "%s %s" (cdr str) - (propertize (format "%d%%" (cdr code)) + (if (and score (/= score 100)) + (format "%s %s" (cdr code) + (propertize (format "%d%%" score) 'face 'stgit-description-face)) - (cdr str)))))) + (cdr code)))))) (defun stgit-file-status-code (str &optional score) "Return stgit status code from git status string" @@ -362,68 +389,97 @@ Cf. `stgit-file-type-change-string'." (propertize (format "%o" new-perm) 'face 'stgit-file-permission-face))))))) -(defun stgit-insert-patch-files (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 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 '(entry-type file))) - (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 - properties) - 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) - properties) - change (match-string 9 result))) - - (let ((mode-change (stgit-file-mode-change-string old-perm - new-perm))) - (insert "\n " - (format "%-12s" (stgit-file-status-code-as-string - status)) +(defstruct (stgit-file) + old-perm new-perm copy-or-rename cr-score cr-from cr-to status file) + +(defun stgit-file-pp (file) + (let ((status (stgit-file-status file)) + (name (if (stgit-file-copy-or-rename file) + (concat (stgit-file-cr-from file) + (propertize " -> " + 'face 'stgit-description-face) + (stgit-file-cr-to file)) + (stgit-file-file file))) + (mode-change (stgit-file-mode-change-string + (stgit-file-old-perm file) + (stgit-file-new-perm file))) + (start (point))) + (insert (format " %-12s%1s%s%s\n" + (stgit-file-status-code-as-string file) mode-change - (if (> (length mode-change) 0) " " "") - change - (propertize (stgit-file-type-change-string old-perm - new-perm) + name + (propertize (stgit-file-type-change-string + (stgit-file-old-perm file) + (stgit-file-new-perm file)) 'face 'stgit-description-face))) - (add-text-properties line-start (point) properties)) - (setq mstart (match-end 0)))) - (when (= start (point)) - (insert " \n")) - (put-text-property start (point) 'stgit-file-patchsym patchsym))) + (add-text-properties start (point) + (list 'entry-type 'file + 'file-data file)))) + +(defun stgit-insert-patch-files (patch) + "Expand (show modification of) the patch with name PATCHSYM (a +symbol) after the line at point. +`stgit-expand-find-copies-harder' controls how hard to try to +find copied files." + (insert "\n") + (let* ((patchsym (stgit-patch-name patch)) + (end (progn (insert "#") (prog1 (point-marker) (forward-char -1)))) + (args (list "-z" (if stgit-expand-find-copies-harder + "--find-copies-harder" + "-C"))) + (ewoc (ewoc-create #'stgit-file-pp nil nil t))) + (setf (stgit-patch-files-ewoc patch) ewoc) + (with-temp-buffer + (apply 'stgit-run-git + (cond ((eq patchsym :work) + `("diff-files" ,@args)) + ((eq patchsym :index) + `("diff-index" ,@args "--cached" "HEAD")) + (t + `("diff-tree" ,@args "-r" ,(stgit-id patchsym))))) + (goto-char (point-min)) + (unless (or (eobp) (memq patchsym '(:work :index))) + (forward-char 41)) + (while (looking-at ":\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} ") + (let ((old-perm (string-to-number (match-string 1) 8)) + (new-perm (string-to-number (match-string 2) 8))) + (goto-char (match-end 0)) + (let ((file + (cond ((looking-at + "\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\0") + (make-stgit-file + :old-perm old-perm + :new-perm new-perm + :copy-or-rename t + :cr-score (string-to-number (match-string 2)) + :cr-from (match-string 3) + :cr-to (match-string 4) + :status (stgit-file-status-code (match-string 1)) + :file (match-string 3))) + ((looking-at "\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\0") + (make-stgit-file + :old-perm old-perm + :new-perm new-perm + :copy-or-rename nil + :cr-score nil + :cr-from nil + :cr-to nil + :status (stgit-file-status-code (match-string 1)) + :file (match-string 2)))))) + (ewoc-enter-last ewoc file)) + (goto-char (match-end 0)))) + (unless (ewoc-nth ewoc 0) + (ewoc-set-hf ewoc "" (propertize " \n" + 'face 'stgit-description-face)))) + (goto-char end) + (delete-char -2))) (defun stgit-select-file () - (let ((patched-file (stgit-patched-file-at-point))) - (unless patched-file - (error "No patch or file on the current line")) - (let ((filename (expand-file-name (cdr patched-file)))) - (unless (file-exists-p filename) - (error "File does not exist")) - (find-file filename)))) + (let ((filename (expand-file-name + (stgit-file-file (stgit-patched-file-at-point))))) + (unless (file-exists-p filename) + (error "File does not exist")) + (find-file filename))) (defun stgit-select-patch () (let ((patchname (stgit-patch-name-at-point))) @@ -450,7 +506,7 @@ Cf. `stgit-file-type-change-string'." (let ((patched-file (stgit-patched-file-at-point))) (unless patched-file (error "No file on the current line")) - (let ((filename (expand-file-name (cdr patched-file)))) + (let ((filename (expand-file-name (stgit-file-file patched-file)))) (unless (file-exists-p filename) (error "File does not exist")) (find-file-other-window filename)))) @@ -563,8 +619,20 @@ Commands: (set (make-local-variable 'stgit-marked-patches) nil) (set (make-local-variable 'stgit-expanded-patches) nil) (set-variable 'truncate-lines 't) + (add-hook 'after-save-hook 'stgit-update-saved-file) (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))) + (buffer (and gitdir (stgit-find-buffer gitdir)))) + (when buffer + (with-current-buffer buffer + ;; FIXME: just invalidate ewoc node + (stgit-reload))))) + (defun stgit-add-mark (patchsym) "Mark the patch PATCHSYM." (setq stgit-marked-patches (cons patchsym stgit-marked-patches))) @@ -589,29 +657,8 @@ If CAUSE-ERROR is not nil, signal an error if none found." (cause-error (error "No patch on this line"))))) -(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-file-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 (eq (stgit-patch-name-at-point) - 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-patched-file-at-point () + (get-text-property (point) 'file-data)) (defun stgit-patches-marked-or-at-point () "Return the symbols of the marked patches, or the patch on the current line." @@ -624,11 +671,13 @@ the new file names instead of just one name." (defun stgit-goto-patch (patchsym) "Move point to the line containing patch PATCHSYM. -If that patch cannot be found, return nil." - (let ((p (text-property-any (point-min) (point-max) - 'stgit-patchsym patchsym))) - (when p - (goto-char p) +If that patch cannot be found, do nothing." + (let ((node (ewoc-nth stgit-ewoc 0))) + (while (and node (not (eq (stgit-patch-name (ewoc-data node)) + patchsym))) + (setq node (ewoc-next stgit-ewoc node))) + (when node + (ewoc-goto-node stgit-ewoc node) (move-to-column goal-column)))) (defun stgit-init () @@ -778,16 +827,25 @@ If PATCHSYM is a keyword, returns PATCHSYM unmodified." (stgit-capture-output "*StGit patch*" (case (get-text-property (point) 'entry-type) ('file - (let ((patchsym (stgit-patch-name-at-point)) - (patched-file (stgit-patched-file-at-point t))) - (let ((id (stgit-id (car 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)))))) + (let* ((patched-file (stgit-patched-file-at-point)) + (patch-name (stgit-patch-name-at-point)) + (patch-id (stgit-id patch-name)) + (args (append (and (stgit-file-cr-from patched-file) + (if stgit-expand-find-copies-harder + '("--find-copies-harder") + '("-C"))) + (cond ((eq patch-id :index) + '("--cached")) + ((eq patch-id :work) + nil) + (t + (list (concat patch-id "^") patch-id))) + '("--") + (if (stgit-file-copy-or-rename patched-file) + (list (stgit-file-cr-from patched-file) + (stgit-file-cr-to patched-file)) + (list (stgit-file-file patched-file)))))) + (apply 'stgit-run-git "diff" args))) ('patch (stgit-run "show" "-O" "--patch-with-stat" "-O" "-M" (stgit-patch-name-at-point)))