stgit.el: Make stgit-reload move point more intuitively when a patch disappears
[stgit] / contrib / stgit.el
index dd3c92b..3e60c92 100644 (file)
@@ -118,19 +118,35 @@ variable is used instead."
 (defcustom stgit-noname-patch-line-format "%s%m%e%D"
   "The alternate format string used to format patch lines.
 It has the same semantics as `stgit-patch-line-format', and the
-display can be toggled between the two formats using
-\\<stgit-mode-map>>\\[stgit-toggle-patch-names].
+display can be toggled between the two formats using \
+\\<stgit-mode-map>\\[stgit-toggle-patch-names].
 
 The alternate form is used when the patch name is hidden."
   :type 'string
   :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-mode-map>\\[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-mode-map>\\[stgit-toggle-patch-names] to toggle the
-this setting in an already-started StGit buffer."
+Use \\<stgit-mode-map>\\[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))
@@ -177,6 +193,13 @@ format characters are recognized:
   "The face used for unapplied patch names"
   :group 'stgit)
 
+(defface stgit-committed-patch-face
+  '((((background dark)) (:foreground "gray50"))
+    (((background light)) (:foreground "gray50"))
+    (t ()))
+  "The face used for already committed patch names"
+  :group 'stgit)
+
 (defface stgit-description-face
   '((((background dark)) (:foreground "tan"))
     (((background light)) (:foreground "dark red")))
@@ -289,14 +312,19 @@ A newline is appended."
     (error))
   (insert (match-string 1 text) ?\n))
 
+(defun stgit-line-format ()
+  "Return the current line format; one of
+`stgit-patch-line-format' and `stgit-noname-patch-line-format'"
+  (if stgit-show-patch-names
+      stgit-patch-line-format
+    stgit-noname-patch-line-format))
+
 (defun stgit-patch-pp (patch)
   (let* ((status (stgit-patch->status patch))
          (start (point))
          (name (stgit-patch->name patch))
          (face (cdr (assq status stgit-patch-status-face-alist)))
-         (fmt (if stgit-show-patch-names
-                  stgit-patch-line-format
-                stgit-noname-patch-line-format))
+         (fmt (stgit-line-format))
          (spec (format-spec-make
                 ?s (case status
                      ('applied "+")
@@ -441,55 +469,89 @@ been advised to update the stgit status when necessary.")
 (defun stgit-run-series (ewoc)
   (setq stgit-index-node nil
         stgit-worktree-node nil)
-  (let ((inserted-index (not stgit-show-worktree))
-        index-node
-        worktree-node
-        all-patchsyms)
-    (with-temp-buffer
-      (let* ((standard-output (current-buffer))
-             (exit-status (stgit-run-silent "series"
-                                            "--description" "--empty")))
-        (goto-char (point-min))
-        (if (not (zerop exit-status))
-            (cond ((looking-at "stg series: \\(.*\\)")
-                   (setq inserted-index t)
-                   (ewoc-set-hf ewoc (car (ewoc-get-hf ewoc))
-                                (substitute-command-keys
-                                 "-- not initialized; run \\[stgit-init]")))
-                  ((looking-at ".*")
-                   (error "Error running stg: %s"
-                          (match-string 0))))
-          (while (not (eobp))
-            (unless (looking-at
-                     "\\([0 ]\\)\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
-              (error "Syntax error in output from stg series"))
-            (let* ((state-str (match-string 2))
-                   (state (cond ((string= state-str ">") 'top)
-                                ((string= state-str "+") 'applied)
-                                ((string= state-str "-") 'unapplied)))
-                   (name (intern (match-string 4)))
-                   (desc (match-string 5))
-                   (empty (string= (match-string 1) "0")))
-              (unless inserted-index
-                (when (or (eq stgit-show-worktree-mode 'top)
-                          (and (eq stgit-show-worktree-mode 'center)
-                               (eq state 'unapplied)))
-                  (setq inserted-index t)
-                  (stgit-run-series-insert-index ewoc)))
-              (setq all-patchsyms (cons name all-patchsyms))
-              (ewoc-enter-last ewoc
-                               (make-stgit-patch
-                                :status state
-                                :name   name
-                                :desc   desc
-                                :empty  empty)))
-            (forward-line 1))))
+  (let (all-patchsyms)
+    (when stgit-show-committed
+      (let* ((base (stgit-id "{base}"))
+             (range (format "%s~%d..%s" base stgit-committed-count base)))
+        (with-temp-buffer
+          (let* ((standard-output (current-buffer))
+                 (fmt (stgit-line-format))
+                 (commit-abbrev (when (string-match "%-\\([0-9]+\\)n" fmt)
+                                  (list (format "--abbrev=%s"
+                                                (match-string 1 fmt)))))
+                 (exit-status (apply 'stgit-run-git-silent
+                                     "--no-pager"
+                                     "log" "--reverse" "--pretty=oneline"
+                                     "--abbrev-commit"
+                                     `(,@commit-abbrev
+                                       ,range))))
+            (goto-char (point-min))
+            (if (not (zerop exit-status))
+                (message "Failed to run git log")
+              (while (not (eobp))
+                (unless (looking-at
+                         "\\([0-9a-f]+\\)\\(\\.\\.\\.\\)? \\(.*\\)")
+                  (error "Syntax error in output from git log"))
+                (let* ((state 'committed)
+                       (name (intern (match-string 1)))
+                       (desc (match-string 3))
+                       (empty nil))
+                  (setq all-patchsyms (cons name all-patchsyms))
+                  (ewoc-enter-last ewoc
+                                   (make-stgit-patch
+                                    :status state
+                                    :name   name
+                                    :desc   desc
+                                    :empty  empty)))
+                (forward-line 1)))))))
+    (let ((inserted-index (not stgit-show-worktree))
+          index-node
+          worktree-node)
+      (with-temp-buffer
+        (let* ((standard-output (current-buffer))
+               (exit-status (stgit-run-silent "series"
+                                              "--description" "--empty")))
+          (goto-char (point-min))
+          (if (not (zerop exit-status))
+              (cond ((looking-at "stg series: \\(.*\\)")
+                     (setq inserted-index t)
+                     (ewoc-set-hf ewoc (car (ewoc-get-hf ewoc))
+                                  (substitute-command-keys
+                                   "-- not initialized; run \\[stgit-init]")))
+                    ((looking-at ".*")
+                     (error "Error running stg: %s"
+                            (match-string 0))))
+            (while (not (eobp))
+              (unless (looking-at
+                       "\\([0 ]\\)\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
+                (error "Syntax error in output from stg series"))
+              (let* ((state-str (match-string 2))
+                     (state (cond ((string= state-str ">") 'top)
+                                  ((string= state-str "+") 'applied)
+                                  ((string= state-str "-") 'unapplied)))
+                     (name (intern (match-string 4)))
+                     (desc (match-string 5))
+                     (empty (string= (match-string 1) "0")))
+                (unless inserted-index
+                  (when (or (eq stgit-show-worktree-mode 'top)
+                            (and (eq stgit-show-worktree-mode 'center)
+                                 (eq state 'unapplied)))
+                    (setq inserted-index t)
+                    (stgit-run-series-insert-index ewoc)))
+                (setq all-patchsyms (cons name all-patchsyms))
+                (ewoc-enter-last ewoc
+                                 (make-stgit-patch
+                                  :status state
+                                  :name   name
+                                  :desc   desc
+                                  :empty  empty)))
+              (forward-line 1)))))
       (unless inserted-index
-        (stgit-run-series-insert-index ewoc)))
-    (setq stgit-index-node    index-node
-          stgit-worktree-node worktree-node
-          stgit-marked-patches (intersection stgit-marked-patches
-                                             all-patchsyms))))
+        (stgit-run-series-insert-index ewoc))
+      (setq stgit-index-node     index-node
+            stgit-worktree-node  worktree-node
+            stgit-marked-patches (intersection stgit-marked-patches
+                                               all-patchsyms)))))
 
 (defun stgit-current-branch ()
   "Return the name of the current branch."
@@ -518,8 +580,9 @@ been advised to update the stgit status when necessary.")
  shows the working tree\n")
                     'face 'stgit-description-face)))
     (stgit-run-series stgit-ewoc)
-    (if curpatch
-        (stgit-goto-patch curpatch (and curfile (stgit-file->file curfile)))
+    (unless (and curpatch
+                 (stgit-goto-patch curpatch
+                                   (and curfile (stgit-file->file curfile))))
       (goto-line curline)))
   (stgit-refresh-git-status))
 
@@ -542,6 +605,7 @@ been advised to update the stgit status when necessary.")
   '((applied   . stgit-applied-patch-face)
     (top       . stgit-top-patch-face)
     (unapplied . stgit-unapplied-patch-face)
+    (committed . stgit-committed-patch-face)
     (index     . stgit-index-work-tree-title-face)
     (work      . stgit-index-work-tree-title-face))
   "Alist of face to use for a given patch status")
@@ -976,6 +1040,7 @@ file for (applied) copies and renames."
     (mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg)))
           '(("n" .        stgit-toggle-patch-names)
             ("t" .        stgit-toggle-worktree)
+            ("h" .        stgit-toggle-committed)
             ("i" .        stgit-toggle-ignored)
             ("u" .        stgit-toggle-unknown)))
     (setq stgit-mode-map (make-keymap))
@@ -1141,6 +1206,8 @@ file for (applied) copies and renames."
          :selected stgit-show-ignored :active stgit-show-worktree]
         ["Show patch names" stgit-toggle-patch-names :style toggle
          :selected stgit-show-patch-names]
+        ["Show recent commits" stgit-toggle-committed :style toggle
+         :selected stgit-show-committed]
         "-"
         ["Switch branches" stgit-branch t
          :help "Switch to or create another branch"]
@@ -1224,6 +1291,7 @@ Display commands:
 \\[stgit-toggle-worktree]      Toggle showing index and work tree
 \\[stgit-toggle-unknown]       Toggle showing unknown files
 \\[stgit-toggle-ignored]       Toggle showing ignored files
+\\[stgit-toggle-committed]     Toggle showing recent commits
 
 Commands for diffs:
 \\[stgit-diff] Show diff of patch or file
@@ -1251,6 +1319,8 @@ Customization variables:
 `stgit-default-show-patch-names'
 `stgit-default-show-unknown'
 `stgit-default-show-worktree'
+`stgit-default-show-committed'
+`stgit-default-committed-count'
 `stgit-find-copies-harder'
 `stgit-show-worktree-mode'
 
@@ -1261,17 +1331,19 @@ See also \\[customize-group] for the \"stgit\" group."
         major-mode 'stgit-mode
         goal-column 2)
   (use-local-map stgit-mode-map)
-  (set (make-local-variable 'list-buffers-directory) default-directory)
-  (set (make-local-variable 'stgit-marked-patches) nil)
-  (set (make-local-variable 'stgit-expanded-patches) (list :work :index))
-  (set (make-local-variable 'stgit-show-patch-names)
-       stgit-default-show-patch-names)
-  (set (make-local-variable 'stgit-show-worktree) stgit-default-show-worktree)
-  (set (make-local-variable 'stgit-show-ignored) stgit-default-show-ignored)
-  (set (make-local-variable 'stgit-show-unknown) stgit-default-show-unknown)
-  (set (make-local-variable 'stgit-index-node) nil)
-  (set (make-local-variable 'stgit-worktree-node) nil)
-  (set (make-local-variable 'parse-sexp-lookup-properties) t)
+  (mapc (lambda (x) (set (make-local-variable (car x)) (cdr x)))
+        `((list-buffers-directory       . ,default-directory)
+          (parse-sexp-lookup-properties . t)
+          (stgit-expanded-patches       . (:work :index))
+          (stgit-index-node             . nil)
+          (stgit-worktree-node          . nil)
+          (stgit-marked-patches         . nil)
+          (stgit-committed-count        . ,stgit-default-committed-count)
+          (stgit-show-committed         . ,stgit-default-show-committed)
+          (stgit-show-ignored           . ,stgit-default-show-ignored)
+          (stgit-show-patch-names       . ,stgit-default-show-patch-names)
+          (stgit-show-unknown           . ,stgit-default-show-unknown)
+          (stgit-show-worktree          . ,stgit-default-show-worktree)))
   (set-variable 'truncate-lines 't)
   (add-hook 'after-save-hook 'stgit-update-stgit-for-buffer)
   (unless stgit-did-advise
@@ -1300,15 +1372,53 @@ refresh the stgit buffers as the git status of files change."
               (add-to-list 'after-load-alist
                            `(,feature (stgit-advise-funlist
                                        (quote ,funlist)))))))
+        ;; lists of (<feature> <function> <function> ...) to be advised
         '((vc-git vc-git-rename-file vc-git-revert vc-git-register)
-          (git    git-add-file git-checkout git-revert-file git-remove-file))))
+          (git    git-add-file git-checkout git-revert-file git-remove-file)
+          (dired  dired-delete-file))))
+
+(defvar stgit-pending-refresh-buffers nil
+  "Alist of (cons `buffer' `refresh-index') of buffers that need
+to be refreshed. `refresh-index' is non-nil if both work tree
+and index need to be refreshed.")
+
+(defun stgit-run-pending-refreshs ()
+  "Run all pending stgit buffer updates as posted by `stgit-post-refresh'."
+  (let ((buffers stgit-pending-refresh-buffers)
+        (stgit-inhibit-messages t))
+    (setq stgit-pending-refresh-buffers nil)
+    (while buffers
+      (let* ((elem (car buffers))
+             (buffer (car elem))
+             (refresh-index (cdr elem)))
+        (when (buffer-name buffer)
+          (with-current-buffer buffer
+            (stgit-refresh-worktree)
+            (when refresh-index (stgit-refresh-index)))))
+      (setq buffers (cdr buffers)))))
+
+(defun stgit-post-refresh (buffer refresh-index)
+  "Update worktree status in BUFFER when Emacs becomes idle. If
+REFRESH-INDEX is non-nil, also update the index."
+  (unless stgit-pending-refresh-buffers
+    (run-with-idle-timer 0.1 nil 'stgit-run-pending-refreshs))
+  (let ((elem (assq buffer stgit-pending-refresh-buffers)))
+    (if elem
+        ;; if buffer is already present, set its refresh-index flag if
+        ;; necessary
+        (when refresh-index
+          (setcdr elem t))
+      ;; new entry
+      (setq stgit-pending-refresh-buffers
+            (cons (cons buffer refresh-index)
+                  stgit-pending-refresh-buffers)))))
 
 (defun stgit-update-stgit-for-buffer (&optional refresh-index)
-  "Refresh worktree status in any `stgit-mode' buffer that shows
-the status of the current buffer.
+  "When Emacs becomes idle, refresh worktree status in any
+`stgit-mode' buffer that shows the status of the current buffer.
 
-If REFRESH-INDEX is not-nil, also update the index."
-  (let* ((dir (cond ((eq major-mode 'git-status-mode)
+If REFRESH-INDEX is non-nil, also update the index."
+  (let* ((dir (cond ((derived-mode-p 'stgit-status-mode 'dired-mode)
                      default-directory)
                     (buffer-file-name
                      (file-name-directory
@@ -1317,9 +1427,7 @@ If REFRESH-INDEX is not-nil, also update the index."
                             (error nil))))
         (buffer (and gitdir (stgit-find-buffer gitdir))))
     (when buffer
-      (with-current-buffer buffer
-        (stgit-refresh-worktree)
-        (when refresh-index (stgit-refresh-index))))))
+      (stgit-post-refresh buffer refresh-index))))
 
 (defun stgit-add-mark (patchsym)
   "Mark the patch PATCHSYM."
@@ -1336,15 +1444,21 @@ If REFRESH-INDEX is not-nil, also update the index."
 (defun stgit-patch-at-point (&optional cause-error)
   (get-text-property (point) 'patch-data))
 
-(defun stgit-patch-name-at-point (&optional cause-error only-patches)
+(defun stgit-patch-name-at-point (&optional cause-error types)
   "Return the patch name on the current line as a symbol.
 If CAUSE-ERROR is not nil, signal an error if none found.
-If ONLY-PATCHES is not nil, only allow real patches, and not
-index or work tree."
+
+TYPES controls which types of commits and patches can be returned.
+If it is t, only allow stgit patches; if 'allow-committed, also
+allow historical commits; if nil, also allow work tree and index."
   (let ((patch (stgit-patch-at-point)))
     (and patch
-         only-patches
-         (memq (stgit-patch->status patch) '(work index))
+         (memq (stgit-patch->status patch)
+               (case types
+                 ((nil) nil)
+                 ((allow-committed) '(work index))
+                 ((t) '(work index committed))
+                 (t (error "Bad value"))))
          (setq patch nil))
     (cond (patch
            (stgit-patch->name patch))
@@ -1354,20 +1468,23 @@ index or work tree."
 (defun stgit-patched-file-at-point ()
   (get-text-property (point) 'file-data))
 
-(defun stgit-patches-marked-or-at-point (&optional cause-error only-patches)
+(defun stgit-patches-marked-or-at-point (&optional cause-error types)
   "Return the symbols of the marked patches, or the patch on the current line.
 If CAUSE-ERRROR is not nil, signal an error if none found.
-If ONLY-PATCHES is not nil, do not include index or work tree."
+
+TYPES controls which types of commits and patches can be returned.
+If it is t, only allow stgit patches; if 'allow-committed, also
+allow historical commits; if nil, also allow work tree and index."
   (if stgit-marked-patches
       stgit-marked-patches
-    (let ((patch (stgit-patch-name-at-point nil only-patches)))
+    (let ((patch (stgit-patch-name-at-point nil types)))
       (cond (patch (list patch))
             (cause-error (error "No patches marked or at this line"))
             (t nil)))))
 
 (defun stgit-goto-patch (patchsym &optional file)
-  "Move point to the line containing patch PATCHSYM.
-If that patch cannot be found, do nothing.
+  "Move point to the line containing patch PATCHSYM and return non-nil.
+If that patch cannot be found, do nothing and return nil.
 
 If the patch was found and FILE is not nil, instead move to that
 file's line. If FILE cannot be found, stay on the line of
@@ -1412,12 +1529,11 @@ PATCHSYM."
   (interactive)
   (stgit-assert-mode)
   (let* ((node (ewoc-locate stgit-ewoc))
-         (patch (ewoc-data node))
-         (name (stgit-patch->name patch)))
-    (when (eq name :work)
-      (error "Cannot mark the work tree"))
-    (when (eq name :index)
-      (error "Cannot mark the index"))
+         (patch (ewoc-data node)))
+    (case (stgit-patch->status patch)
+      (work      (error "Cannot mark the work tree"))
+      (index     (error "Cannot mark the index"))
+      (committed (error "Cannot mark a committed patch")))
     (stgit-add-mark (stgit-patch->name patch))
     (let ((column (current-column)))
       (ewoc-invalidate stgit-ewoc node)
@@ -1767,11 +1883,14 @@ If ONLY-PATCHES is not nil, exclude index and work tree."
   (stgit-reload))
 
 (defun stgit-goto-target ()
-  "Return the goto target a point; either a patchsym, :top,
+  "Return the goto target at point: a patchsym, :top,
 or :bottom."
-  (let ((patchsym (stgit-patch-name-at-point)))
-    (cond ((memq patchsym '(:work :index)) nil)
-          (patchsym)
+  (let ((patch (stgit-patch-at-point)))
+    (cond (patch
+           (case (stgit-patch->status patch)
+             ((work index) nil)
+             ((committed) :bottom)
+             (t (stgit-patch->name patch))))
           ((not (next-single-property-change (point) 'patch-data))
            :top)
           ((not (previous-single-property-change (point) 'patch-data))
@@ -1902,9 +2021,10 @@ greater than four (e.g., \\[universal-argument] \
   (stgit-assert-mode)
   (unless (= (length stgit-marked-patches) 1)
     (error "Need exactly one patch marked"))
-  (let* ((patches (stgit-sort-patches (cons (stgit-patch-name-at-point t t)
-                                            stgit-marked-patches)
-                                      t))
+  (let* ((patches (stgit-sort-patches
+                   (cons (stgit-patch-name-at-point t 'allow-committed)
+                         stgit-marked-patches)
+                   t))
          (first-patch (car patches))
          (second-patch (if (cdr patches) (cadr patches) first-patch))
          (whitespace-arg (stgit-whitespace-diff-arg ignore-whitespace))
@@ -2281,7 +2401,7 @@ If the command ends in an ampersand, run it asynchronously.
 When the command has finished, reload the stgit buffer."
   (interactive)
   (stgit-assert-mode)
-  (let* ((patches (stgit-patches-marked-or-at-point nil t))
+  (let* ((patches (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))
          (defaultcmd (if patches
@@ -2381,6 +2501,12 @@ See also `stgit-show-worktree-mode'.")
 (defvar stgit-show-patch-names t
   "If nil, inhibit showing patch names.")
 
+(defvar stgit-show-committed nil
+  "If nil, inhibit showing recent commits.")
+
+(defvar stgit-committed-count nil
+  "The number of recent commits to show.")
+
 (defun stgit-toggle-worktree (&optional arg)
   "Toggle the visibility of the work tree.
 With ARG, show the work tree if ARG is positive.
@@ -2440,4 +2566,19 @@ The initial setting is controlled by `stgit-default-show-patch-names'."
           (not stgit-show-patch-names)))
   (stgit-reload))
 
+(defun stgit-toggle-committed (&optional arg)
+  "Toggle the visibility of historical git commits.
+With ARG, set the number of commits to show to ARG, and disable
+them if ARG is zero.
+
+The initial setting is controlled by `stgit-default-show-committed'."
+  (interactive "P")
+  (stgit-assert-mode)
+  (if (null arg)
+      (setq stgit-show-committed (not stgit-show-committed))
+    (let ((n (prefix-numeric-value arg)))
+      (setq stgit-show-committed (> n 0))
+      (setq stgit-committed-count n)))
+  (stgit-reload))
+
 (provide 'stgit)