stgit.el: Add "U" for stgit-revert-file
[stgit] / contrib / stgit.el
index 9f47e54..c475fc2 100644 (file)
@@ -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,32 +51,43 @@ 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))
+    (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 patch))
@@ -149,6 +160,21 @@ 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")))
+
+(defvar stgit-index-node)
+(defvar stgit-worktree-node)
+
+(defun stgit-refresh-index ()
+  (when stgit-index-node
+    (ewoc-invalidate (car stgit-index-node) (cdr stgit-index-node))))
+
+(defun stgit-refresh-worktree ()
+  (when stgit-worktree-node
+    (ewoc-invalidate (car stgit-worktree-node) (cdr stgit-worktree-node))))
+
 (defun stgit-run-series (ewoc)
   (let ((first-line t))
     (with-temp-buffer
@@ -176,7 +202,21 @@ 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)))))
+    (if stgit-show-worktree
+        (setq stgit-index-node (cons ewoc (ewoc-enter-last ewoc
+                                                           (make-stgit-patch
+                                                            :status 'index
+                                                            :name :index
+                                                            :desc nil
+                                                            :empty nil)))
+              stgit-worktree-node (cons ewoc (ewoc-enter-last ewoc
+                                                              (make-stgit-patch
+                                                               :status 'work
+                                                               :name :work
+                                                               :desc nil
+                                                               :empty nil))))
+      (setq stgit-worktree-node nil))))
 
 
 (defun stgit-reload ()
@@ -192,9 +232,14 @@ Returns nil if there was no output."
                           (with-temp-buffer
                             (stgit-run-silent "branch")
                             (buffer-substring (point-min) (1- (point-max))))
-                          'face 'bold)
+                          'face 'stgit-branch-name-face)
                          "\n")
-                 "--")
+                 (if stgit-show-worktree
+                     "--"
+                   (propertize
+                    (substitute-command-keys "--\n\"\\[stgit-toggle-worktree]\"\
+ shows the working tree\n")
+                   'face 'stgit-description-face)))
     (stgit-run-series stgit-ewoc)
     (if curpatch
         (stgit-goto-patch curpatch)
@@ -211,6 +256,11 @@ Returns nil if there was no output."
   "The face used for StGit descriptions"
   :group 'stgit)
 
+(defface stgit-branch-name-face
+  '((t :inherit bold))
+  "The face used for the StGit branch name"
+  :group 'stgit)
+
 (defface stgit-top-patch-face
   '((((background dark)) (:weight bold :foreground "yellow"))
     (((background light)) (:weight bold :foreground "purple"))
@@ -279,17 +329,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"
@@ -364,7 +415,7 @@ Cf. `stgit-file-type-change-string'."
 (defstruct (stgit-file)
   old-perm new-perm copy-or-rename cr-score cr-from cr-to status file)
 
-(defun stgit-insert-file (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)
@@ -376,8 +427,8 @@ Cf. `stgit-file-type-change-string'."
                       (stgit-file-old-perm file)
                       (stgit-file-new-perm file)))
         (start (point)))
-    (insert (format "\n    %-12s%1s%s%s"
-                    (stgit-file-status-code-as-string status)
+    (insert (format "    %-12s%1s%s%s\n"
+                    (stgit-file-status-code-as-string file)
                     mode-change
                     name
                     (propertize (stgit-file-type-change-string
@@ -385,24 +436,30 @@ Cf. `stgit-file-type-change-string'."
                                  (stgit-file-new-perm file))
                                 'face 'stgit-description-face)))
     (add-text-properties start (point)
-                         `(entry-type file file ,(stgit-file-file file)))))
+                         (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."
-  (let* ((start (point))
-         (patchsym (stgit-patch-name patch))
-         (args (list "-r" "-z" (if stgit-expand-find-copies-harder
-                                   "--find-copies-harder"
-                                 "-C")))
-         (stgbuf (current-buffer)))
+  "Expand (show modification of) the patch PATCH after the line
+at point."
+  (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 "diff-tree"
-             (append args (list (stgit-id patchsym))))
+      (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))
-      (forward-char 41)
+      (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)))
@@ -429,14 +486,17 @@ find copied files."
                          :cr-to          nil
                          :status         (stgit-file-status-code (match-string 1))
                          :file           (match-string 2))))))
-            (with-current-buffer stgbuf
-              (stgit-insert-file file)))
-          (goto-char (match-end 0)))))
-    (when (= start (point))
-      (insert "    <no files>\n"))))
+            (ewoc-enter-last ewoc file))
+          (goto-char (match-end 0))))
+      (unless (ewoc-nth ewoc 0)
+        (ewoc-set-hf ewoc "" (propertize "    <no files>\n"
+                                         'face 'stgit-description-face))))
+    (goto-char end)
+    (delete-char -2)))
 
 (defun stgit-select-file ()
-  (let ((filename (expand-file-name (get-text-property (point) 'file))))
+  (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)))
@@ -466,7 +526,7 @@ find copied files."
   (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))))
@@ -524,46 +584,53 @@ find copied files."
   "Keymap for StGit major mode.")
 
 (unless stgit-mode-map
-  (setq stgit-mode-map (make-keymap))
-  (suppress-keymap stgit-mode-map)
-  (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
-        '((" " .        stgit-mark)
-          ("m" .        stgit-mark)
-          ("\d" .       stgit-unmark-up)
-          ("u" .        stgit-unmark-down)
-          ("?" .        stgit-help)
-          ("h" .        stgit-help)
-          ("\C-p" .     stgit-previous-line)
-          ("\C-n" .     stgit-next-line)
-          ([up] .       stgit-previous-line)
-          ([down] .     stgit-next-line)
-          ("p" .        stgit-previous-patch)
-          ("n" .        stgit-next-patch)
-          ("\M-{" .     stgit-previous-patch)
-          ("\M-}" .     stgit-next-patch)
-          ("s" .        stgit-git-status)
-          ("g" .        stgit-reload)
-          ("r" .        stgit-refresh)
-          ("\C-c\C-r" . stgit-rename)
-          ("e" .        stgit-edit)
-          ("M" .        stgit-move-patches)
-          ("S" .        stgit-squash)
-          ("N" .        stgit-new)
-          ("R" .        stgit-repair)
-          ("C" .        stgit-commit)
-          ("U" .        stgit-uncommit)
-          ("\r" .       stgit-select)
-          ("o" .        stgit-find-file-other-window)
-          (">" .        stgit-push-next)
-          ("<" .        stgit-pop-next)
-          ("P" .        stgit-push-or-pop)
-          ("G" .        stgit-goto)
-          ("=" .        stgit-show)
-          ("D" .        stgit-delete)
-          ([(control ?/)] . stgit-undo)
-          ("\C-_" .     stgit-undo)
-          ("B" .        stgit-branch)
-          ("q" .        stgit-quit))))
+  (let ((toggle-map (make-keymap)))
+    (suppress-keymap toggle-map)
+    (mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg)))
+          '(("t" .        stgit-toggle-worktree)))
+    (setq stgit-mode-map (make-keymap))
+    (suppress-keymap stgit-mode-map)
+    (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
+          `((" " .        stgit-mark)
+            ("m" .        stgit-mark)
+            ("\d" .       stgit-unmark-up)
+            ("u" .        stgit-unmark-down)
+            ("?" .        stgit-help)
+            ("h" .        stgit-help)
+            ("\C-p" .     stgit-previous-line)
+            ("\C-n" .     stgit-next-line)
+            ([up] .       stgit-previous-line)
+            ([down] .     stgit-next-line)
+            ("p" .        stgit-previous-patch)
+            ("n" .        stgit-next-patch)
+            ("\M-{" .     stgit-previous-patch)
+            ("\M-}" .     stgit-next-patch)
+            ("s" .        stgit-git-status)
+            ("g" .        stgit-reload)
+            ("r" .        stgit-refresh)
+            ("\C-c\C-r" . stgit-rename)
+            ("e" .        stgit-edit)
+            ("M" .        stgit-move-patches)
+            ("S" .        stgit-squash)
+            ("N" .        stgit-new)
+            ("R" .        stgit-repair)
+            ("\C-c\C-c" . stgit-commit)
+            ("\C-c\C-u" . stgit-uncommit)
+            ("U" .        stgit-revert-file)
+            ("\r" .       stgit-select)
+            ("o" .        stgit-find-file-other-window)
+            ("i" .        stgit-file-toggle-index)
+            (">" .        stgit-push-next)
+            ("<" .        stgit-pop-next)
+            ("P" .        stgit-push-or-pop)
+            ("G" .        stgit-goto)
+            ("=" .        stgit-show)
+            ("D" .        stgit-delete)
+            ([(control ?/)] . stgit-undo)
+            ("\C-_" .     stgit-undo)
+            ("B" .        stgit-branch)
+            ("t" .        ,toggle-map)
+            ("q" .        stgit-quit)))))
 
 (defun stgit-mode ()
   "Major mode for interacting with StGit.
@@ -578,9 +645,23 @@ Commands:
   (set (make-local-variable 'list-buffers-directory) default-directory)
   (set (make-local-variable 'stgit-marked-patches) nil)
   (set (make-local-variable 'stgit-expanded-patches) nil)
+  (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-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
+        (stgit-refresh-worktree)))))
+
 (defun stgit-add-mark (patchsym)
   "Mark the patch PATCHSYM."
   (setq stgit-marked-patches (cons patchsym stgit-marked-patches)))
@@ -605,29 +686,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."
@@ -733,6 +793,37 @@ Interactively, the prefix argument is used as COUNT."
   (stgit-capture-output nil (stgit-run "commit" "-n" count))
   (stgit-reload))
 
+(defun stgit-revert-file ()
+  "Revert the file at point, which must be in the index or the
+working tree."
+  (interactive)
+  (let* ((patched-file (or (stgit-patched-file-at-point)
+                           (error "No file on the current line")))
+         (patch-name   (stgit-patch-name-at-point))
+         (file-status  (stgit-file-status patched-file))
+         (rm-file      (cond ((stgit-file-copy-or-rename patched-file)
+                              (stgit-file-cr-to patched-file))
+                             ((eq file-status 'add)
+                              (stgit-file-file patched-file))))
+         (co-file      (cond ((eq file-status 'rename)
+                              (stgit-file-cr-from patched-file))
+                             ((not (memq file-status '(copy add)))
+                              (stgit-file-file patched-file)))))
+
+    (unless (memq patch-name '(:work :index))
+      (error "No index or working tree file on this line"))
+
+    (let ((nfiles (+ (if rm-file 1 0) (if co-file 1 0))))
+      (when (yes-or-no-p (format "Revert %d file%s? "
+                                 nfiles
+                                 (if (= nfiles 1) "" "s")))
+        (stgit-capture-output nil
+          (when rm-file
+            (stgit-run-git "rm" "-f" "-q" "--" rm-file))
+          (when co-file
+            (stgit-run-git "checkout" "HEAD" co-file)))
+        (stgit-reload)))))
+
 (defun stgit-uncommit (count)
   "Run stg uncommit on COUNT commits.
 Interactively, the prefix argument is used as COUNT."
@@ -796,16 +887,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)))
@@ -815,6 +915,34 @@ If PATCHSYM is a keyword, returns PATCHSYM unmodified."
       (goto-char (point-min))
       (diff-mode))))
 
+(defun stgit-move-change-to-index (file)
+  "Copies the workspace state of FILE to index, using git add or git rm"
+  (let ((op (if (or (file-exists-p file) (file-symlink-p file))
+                '("add") '("rm" "-q"))))
+    (stgit-capture-output "*git output*"
+      (apply 'stgit-run-git (append op '("--") (list file))))))
+
+(defun stgit-remove-change-from-index (file)
+  "Unstages the change in FILE from the index"
+  (stgit-capture-output "*git output*"
+    (stgit-run-git "reset" "-q" "--" file)))
+
+(defun stgit-file-toggle-index ()
+  "Move modified file in or out of the index."
+  (interactive)
+  (let ((patched-file (stgit-patched-file-at-point)))
+    (unless patched-file
+      (error "No file on the current line"))
+    (let ((patch-name (stgit-patch-name-at-point)))
+      (cond ((eq patch-name :work)
+             (stgit-move-change-to-index (stgit-file-file patched-file)))
+            ((eq patch-name :index)
+             (stgit-remove-change-from-index (stgit-file-file patched-file)))
+            (t
+             (error "Can only move files in the working tree to index")))))
+  (stgit-refresh-worktree)
+  (stgit-refresh-index))
+
 (defun stgit-edit ()
   "Edit the patch on the current line."
   (interactive)
@@ -1047,4 +1175,29 @@ With prefix argument, refresh the marked patch or the patch under point."
     (stgit-refresh-git-status))
   (stgit-reload))
 
+(defcustom stgit-default-show-worktree
+  nil
+  "Set to non-nil to by default show the working tree in a new stgit buffer.
+
+This value is used as the default value for `stgit-show-worktree'."
+  :type 'boolean
+  :group 'stgit)
+
+(defvar stgit-show-worktree nil
+  "Show work tree and index in the stgit buffer.
+
+See `stgit-default-show-worktree' for its default value.")
+
+(defun stgit-toggle-worktree (&optional arg)
+  "Toggle the visibility of the work tree.
+With arg, show the work tree if arg is positive.
+
+Its initial setting is controlled by `stgit-default-show-worktree'."
+  (interactive)
+  (setq stgit-show-worktree
+        (if (numberp arg)
+            (> arg 0)
+          (not stgit-show-worktree)))
+  (stgit-reload))
+
 (provide 'stgit)