Re: [PATCH] Allow hiding stashes from vc-dir

[Robert Pluim]

>>>>> On Wed, 16 Oct 2019 10:57:18 +0200, Robert Pluim <address@hidden> said:

>>>>> On Wed, 16 Oct 2019 03:28:07 +0200, Lars Ingebrigtsen <address@hidden> 
>>>>> said:

    Lars> Yes, that'd be great.  I periodically have a whole bunch of stashes in
    Lars> my Emacs repo, and toggling the list interactively would be the best
    Lars> solution, I think.

    Robert> OK, Iʼll rework the patch a bit. Iʼve also discovered that vc-dir 
has
    Robert> commands for manipulating stashes, so limiting it to eg 5 would help
    Robert> me (those commands are only bound when youʼre in the stash list, 
which
    Robert> is why I never noticed them).

Toggling with a configurable limit implemented in attached. I did feel
like I was reinventing the wheel a bit, is there no "create a bunch of
strings/regions and apply properties to them" library?

>From 3197794363e16a617db86de32912e7a1085364e7 Mon Sep 17 00:00:00 2001
From: Robert Pluim <address@hidden>
Date: Thu, 17 Oct 2019 15:55:06 +0200
Subject: [PATCH] Add button to vc-dir to toggle visibility of stash list
To: address@hidden

* lisp/vc/vc-git.el (vc-git-show-stash): New user option.
(vc-git-make-stash-button): Create button that allows hiding the stash
list.
(vc-git-dir-extra-headers): Split stash list into hideable and
non-hideable parts depending on value of vc-git-show-stash.  Add
button to toggle visibility of hideable part.

* etc/NEWS: Announce it.
---
 etc/NEWS          |   5 +++
 lisp/vc/vc-git.el | 102 ++++++++++++++++++++++++++++++++++++++--------
 2 files changed, 90 insertions(+), 17 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index e1eb74f86e..9126b007ea 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -810,6 +810,11 @@ The default value is 'find-dired-sort-by-filename'.
 *** New command 'log-edit-generate-changelog-from-diff', bound to 'C-c C-w'.
 This generates ChangeLog entries from the VC fileset diff.
 
+*** 'vc-dir' now shows a button allowing you to hide the stash list.
+Controlled by user option 'vc-git-show-stash'.  Default t means show
+the entire list as before.  An integer value limits the list length
+(but still allows you to show the entire list via the button).
+
 *** Recording ChangeLog entries doesn't require an actual file.
 If a ChangeLog file doesn't exist, and if the new user option
 'add-log-dont-create-changelog-file' is non-nil (which is the
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 9715aea1fd..1976aca1c9 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -108,6 +108,8 @@
   (require 'vc)
   (require 'vc-dir))
 
+(declare-function cl-subseq "cl-extra" (seq start &optional end))
+
 (defgroup vc-git nil
   "VC Git backend."
   :version "24.1"
@@ -192,6 +194,21 @@ vc-git-grep-template
   :type 'string
   :version "27.1")
 
+(defcustom vc-git-show-stash t
+  "How much of the git stash list to show by default.
+Default t means all, otherwise an integer specifying the maximum
+number to show.  A text button is always shown allowing you to
+toggle display of the entire list."
+  :type '(choice (const :tag "All" t)
+                 (integer :tag "Limit"
+                          :validate
+                          (lambda (widget)
+                            (unless (>= (widget-value widget) 0)
+                              (widget-put widget :error
+                                          "Invalid value: must be a 
non-negative integer")
+                              widget))))
+  :version "27.1")
+
 ;; History of Git commands.
 (defvar vc-git-history nil)
 
@@ -635,6 +652,18 @@ vc-git-stash-map
     (define-key map "S" 'vc-git-stash-snapshot)
     map))
 
+(defun vc-git-make-stash-button ()
+    (make-text-button "Show/hide stashes" nil
+                      'action
+                      (lambda (&rest _ignore)
+                          (let* ((inhibit-read-only t)
+                                 (start (next-single-property-change 
(point-min) 'vc-git-hideable))
+                                 (end (next-single-property-change start 
'vc-git-hideable)))
+                            (add-text-properties
+                             start end
+                             `(invisible ,(not (get-text-property start 
'invisible))))))
+                      'help-echo "mouse-2, RET: Show/hide stashes"))
+
 (defvar vc-git-stash-menu-map
   (let ((map (make-sparse-keymap "Git Stash")))
     (define-key map [de]
@@ -655,9 +684,11 @@ vc-git-dir-extra-headers
   (let ((str (with-output-to-string
                (with-current-buffer standard-output
                  (vc-git--out-ok "symbolic-ref" "HEAD"))))
-       (stash (vc-git-stash-list))
+       (stash-list (vc-git-stash-list))
        (stash-help-echo "Use M-x vc-git-stash to create stashes.")
-       branch remote remote-url)
+        (stash-list-help-echo "mouse-3: Show stash menu\nRET: Show stash\nA: 
Apply stash\nP: Apply and remove stash (pop)\nC-k: Delete stash")
+
+       branch remote remote-url stash-button stash-string)
     (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
        (progn
          (setq branch (match-string 2 str))
@@ -677,6 +708,50 @@ vc-git-dir-extra-headers
          (when (string-match "\\([^\n]+\\)" remote-url)
            (setq remote-url (match-string 1 remote-url))))
       (setq branch "not (detached HEAD)"))
+    (when stash-list
+      (let* ((limit
+              (if (integerp vc-git-show-stash)
+                  (min vc-git-show-stash (length stash-list))
+                (length stash-list)))
+             (shown-stashes (cl-subseq stash-list 0 limit))
+             (hidden-stashes (cl-subseq stash-list limit))
+             (all-hideable (eq vc-git-show-stash t)))
+        (setq stash-button (vc-git-make-stash-button)
+              stash-string
+              (concat
+               (when shown-stashes
+                 (concat
+                  (propertize "\n"
+                              'vc-git-hideable all-hideable)
+                  (mapconcat
+                   (lambda (x)
+                     (propertize x
+                                 'face 'font-lock-variable-name-face
+                                 'mouse-face 'highlight
+                                 'vc-git-hideable all-hideable
+                                 'help-echo stash-list-help-echo
+                                 'keymap vc-git-stash-map))
+                   shown-stashes
+                   (propertize "\n"
+                               'vc-git-hideable all-hideable))))
+               (when hidden-stashes
+                 (concat
+                  (propertize "\n"
+                              'invisible t
+                              'vc-git-hideable t)
+                  (mapconcat
+                   (lambda (x)
+                     (propertize x
+                                 'face 'font-lock-variable-name-face
+                                 'mouse-face 'highlight
+                                 'invisible t
+                                 'vc-git-hideable t
+                                 'help-echo stash-list-help-echo
+                                 'keymap vc-git-stash-map))
+                   hidden-stashes
+                   (propertize "\n"
+                               'invisible t
+                               'vc-git-hideable t))))))))
     ;; FIXME: maybe use a different face when nothing is stashed.
     (concat
      (propertize "Branch     : " 'face 'font-lock-type-face)
@@ -688,26 +763,19 @@ vc-git-dir-extra-headers
        (propertize "Remote     : " 'face 'font-lock-type-face)
        (propertize remote-url
                    'face 'font-lock-variable-name-face)))
-     "\n"
      ;; For now just a heading, key bindings can be added later for various 
bisect actions
      (when (file-exists-p (expand-file-name ".git/BISECT_START" (vc-git-root 
dir)))
-       (propertize  "Bisect     : in progress\n" 'face 
'font-lock-warning-face))
+       (propertize  "\nBisect     : in progress" 'face 
'font-lock-warning-face))
      (when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root 
dir)))
-       (propertize  "Rebase     : in progress\n" 'face 
'font-lock-warning-face))
-     (if stash
+       (propertize  "\nRebase     : in progress" 'face 
'font-lock-warning-face))
+     (if stash-list
        (concat
-       (propertize "Stash      :\n" 'face 'font-lock-type-face
-                   'help-echo stash-help-echo)
-       (mapconcat
-        (lambda (x)
-          (propertize x
-                      'face 'font-lock-variable-name-face
-                      'mouse-face 'highlight
-                      'help-echo "mouse-3: Show stash menu\nRET: Show 
stash\nA: Apply stash\nP: Apply and remove stash (pop)\nC-k: Delete stash"
-                      'keymap vc-git-stash-map))
-        stash "\n"))
+        (propertize "\nStash      : " 'face 'font-lock-type-face
+                    'help-echo stash-help-echo)
+        stash-button
+        stash-string)
        (concat
-       (propertize "Stash      : " 'face 'font-lock-type-face
+       (propertize "\nStash      : " 'face 'font-lock-type-face
                    'help-echo stash-help-echo)
        (propertize "Nothing stashed"
                    'help-echo stash-help-echo
-- 
2.23.0