X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/bbd0c1f47a633740ce467e11113c1edf5df52829..aab226cf146c80f8d5acf6dc6284e89834258be1:/contrib/stgit.el

diff --git a/contrib/stgit.el b/contrib/stgit.el
index 4482e67..cb8ae70 100644
--- a/contrib/stgit.el
+++ b/contrib/stgit.el
@@ -16,6 +16,187 @@
 (require 'cl)
 (require 'ewoc)
 (require 'easymenu)
+(require 'format-spec)
+
+(defun stgit-set-default (symbol value)
+  "Set default value of SYMBOL to VALUE using `set-default' and
+reload all StGit buffers."
+  (set-default symbol value)
+  (dolist (buf (buffer-list))
+    (with-current-buffer buf
+      (when (eq major-mode 'stgit-mode)
+        (stgit-reload)))))
+
+(defgroup stgit nil
+  "A user interface for the StGit patch maintenance tool."
+  :group 'tools
+  :link '(function-link stgit)
+  :link '(url-link "http://www.procode.org/stgit/"))
+
+(defcustom stgit-abbreviate-copies-and-renames t
+  "If non-nil, abbreviate copies and renames as \"dir/{old -> new}/file\"
+instead of \"dir/old/file -> dir/new/file\"."
+  :type 'boolean
+  :group 'stgit
+  :set 'stgit-set-default)
+
+(defcustom stgit-default-show-worktree t
+  "Set to non-nil to by default show the working tree in a new stgit buffer.
+
+Use \\<stgit-mode-map>\\[stgit-toggle-worktree] to toggle the this setting in an already-started StGit buffer."
+  :type 'boolean
+  :group 'stgit
+  :link '(variable-link stgit-show-worktree))
+
+(defcustom stgit-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
+  :set 'stgit-set-default)
+
+(defcustom stgit-show-worktree-mode 'center
+  "This variable controls where the \"Index\" and \"Work tree\"
+will be shown on in the buffer.
+
+It can be set to 'top (above all patches), 'center (show between
+applied and unapplied patches), and 'bottom (below all patches)."
+  :type '(radio (const :tag "above all patches (top)" top)
+                (const :tag "between applied and unapplied patches (center)"
+                       center)
+                (const :tag "below all patches (bottom)" bottom))
+  :group 'stgit
+  :link '(variable-link stgit-show-worktree)
+  :set 'stgit-set-default)
+
+(defcustom stgit-patch-line-format "%s%m%-30n %e%d"
+  "The format string used to format patch lines.
+The format string is passed to `format-spec' and the following
+format characters are recognized:
+
+  %s - A '+', '-', '>' or space, depending on whether the patch is
+       applied, unapplied, top, or something else.
+
+  %m - An asterisk if the patch is marked, and a space otherwise.
+
+  %n - The patch name.
+
+  %e - The string \"(empty) \" if the patch is empty.
+
+  %d - The short patch description.
+
+  %D - The short patch description, or the patch name.
+
+When `stgit-show-patch-names' is non-nil, the `stgit-noname-patch-line-format'
+variable is used instead."
+  :type 'string
+  :group 'stgit
+  :set 'stgit-set-default)
+
+(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].
+
+The alternate form is used when the patch name is hidden."
+  :type 'string
+  :group 'stgit
+  :set 'stgit-set-default)
+
+(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."
+  :type 'boolean
+  :group 'stgit
+  :link '(variable-link stgit-show-patch-names))
+
+(defcustom stgit-file-line-format "    %-11s %-2m %n   %c"
+  "The format string used to format file lines.
+The format string is passed to `format-spec' and the following
+format characters are recognized:
+
+  %s - A string describing the status of the file.
+
+  %m - Mode change information
+
+  %n - The file name.
+
+  %c - A description of file changes."
+  :type 'string
+  :group 'stgit
+  :set 'stgit-set-default)
+
+(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"))
+    (t (:weight bold)))
+  "The face used for the top patch names"
+  :group 'stgit)
+
+(defface stgit-applied-patch-face
+  '((((background dark)) (:foreground "light yellow"))
+    (((background light)) (:foreground "purple"))
+    (t ()))
+  "The face used for applied patch names"
+  :group 'stgit)
+
+(defface stgit-unapplied-patch-face
+  '((((background dark)) (:foreground "gray80"))
+    (((background light)) (:foreground "orchid"))
+    (t ()))
+  "The face used for unapplied patch names"
+  :group 'stgit)
+
+(defface stgit-description-face
+  '((((background dark)) (:foreground "tan"))
+    (((background light)) (:foreground "dark red")))
+  "The face used for StGit descriptions"
+  :group 'stgit)
+
+(defface stgit-index-work-tree-title-face
+  '((((supports :slant italic)) :slant italic)
+    (t :inherit bold))
+  "StGit mode face used for the \"Index\" and \"Work tree\" titles"
+  :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-ignored-file-face
+  '((((class color) (background light)) (:foreground "grey60"))
+    (((class color) (background dark)) (:foreground "grey40")))
+  "StGit mode face used for ignored files")
+
+(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)
+
+(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)
 
 (defun stgit (dir)
   "Manage StGit patches for the tree in DIR.
@@ -73,30 +254,40 @@ directory DIR or `default-directory'"
 (defstruct (stgit-patch)
   status name desc empty files-ewoc)
 
+(defun stgit-patch-display-name (patch)
+  (let ((name (stgit-patch-name patch)))
+    (case name
+      (:index "Index")
+      (:work "Work Tree")
+      (t (symbol-name name)))))
+
 (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))))
-    (insert (case status
-              ('applied "+")
-              ('top ">")
-              ('unapplied "-")
-              (t " "))
-            (if (memq name stgit-marked-patches)
-                "*" " "))
-    (if (memq status '(index work))
-        (insert (propertize (if (eq status 'index) "Index" "Work tree")
-                            'face face))
-      (insert (format "%-30s"
-                      (propertize (symbol-name name)
-                                  'face face
-                                  'syntax-table (string-to-syntax "w")))
-              "  "
-              (if (stgit-patch-empty patch) "(empty) " "")
-              (propertize (or (stgit-patch-desc patch) "")
-                          'face 'stgit-description-face)))
-    (insert "\n")
+         (face (cdr (assq status stgit-patch-status-face-alist)))
+         (fmt (if stgit-show-patch-names
+                  stgit-patch-line-format
+                stgit-noname-patch-line-format))
+         (spec (format-spec-make
+                ?s (case status
+                     ('applied "+")
+                     ('top ">")
+                     ('unapplied "-")
+                     (t " "))
+                ?m (if (memq name stgit-marked-patches)
+                       "*" " ")
+                ?n (propertize (stgit-patch-display-name patch)
+                               'face face
+                               'syntax-table (string-to-syntax "w"))
+                ?e (if (stgit-patch-empty patch) "(empty) " "")
+                ?d (propertize (or (stgit-patch-desc patch) "")
+                               'face 'stgit-description-face)
+                ?D (propertize (or (stgit-patch-desc patch)
+                                   (stgit-patch-display-name patch))
+                               'face face))))
+
+    (insert (format-spec fmt spec) "\n")
     (put-text-property start (point) 'entry-type 'patch)
     (when (memq name stgit-expanded-patches)
       (stgit-insert-patch-files patch))
@@ -284,126 +475,6 @@ Returns nil if there was no output."
       (goto-line curline)))
   (stgit-refresh-git-status))
 
-(defun stgit-set-default (symbol value)
-  "Set default value of SYMBOL to VALUE using `set-default' and
-reload all StGit buffers."
-  (set-default symbol value)
-  (dolist (buf (buffer-list))
-    (with-current-buffer buf
-      (when (eq major-mode 'stgit-mode)
-        (stgit-reload)))))
-
-(defgroup stgit nil
-  "A user interface for the StGit patch maintenance tool."
-  :group 'tools
-  :link '(function-link stgit)
-  :link '(url-link "http://www.procode.org/stgit/"))
-
-(defcustom stgit-abbreviate-copies-and-renames t
-  "If non-nil, abbreviate copies and renames as \"dir/{old -> new}/file\"
-instead of \"dir/old/file -> dir/new/file\"."
-  :type 'boolean
-  :group 'stgit
-  :set 'stgit-set-default)
-
-(defcustom stgit-default-show-worktree t
-  "Set to non-nil to by default show the working tree in a new stgit buffer.
-
-Use \\<stgit-mode-map>\\[stgit-toggle-worktree] to toggle the this setting in an already-started StGit buffer."
-  :type 'boolean
-  :group 'stgit
-  :link '(variable-link stgit-show-worktree))
-
-(defcustom stgit-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
-  :set 'stgit-set-default)
-
-(defcustom stgit-show-worktree-mode 'center
-  "This variable controls where the \"Index\" and \"Work tree\"
-will be shown on in the buffer.
-
-It can be set to 'top (above all patches), 'center (show between
-applied and unapplied patches), and 'bottom (below all patches)."
-  :type '(radio (const :tag "above all patches (top)" top)
-                (const :tag "between applied and unapplied patches (center)"
-                       center)
-                (const :tag "below all patches (bottom)" bottom))
-  :group 'stgit
-  :link '(variable-link stgit-show-worktree)
-  :set 'stgit-set-default)
-
-(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"))
-    (t (:weight bold)))
-  "The face used for the top patch names"
-  :group 'stgit)
-
-(defface stgit-applied-patch-face
-  '((((background dark)) (:foreground "light yellow"))
-    (((background light)) (:foreground "purple"))
-    (t ()))
-  "The face used for applied patch names"
-  :group 'stgit)
-
-(defface stgit-unapplied-patch-face
-  '((((background dark)) (:foreground "gray80"))
-    (((background light)) (:foreground "orchid"))
-    (t ()))
-  "The face used for unapplied patch names"
-  :group 'stgit)
-
-(defface stgit-description-face
-  '((((background dark)) (:foreground "tan"))
-    (((background light)) (:foreground "dark red")))
-  "The face used for StGit descriptions"
-  :group 'stgit)
-
-(defface stgit-index-work-tree-title-face
-  '((((supports :slant italic)) :slant italic)
-    (t :inherit bold))
-  "StGit mode face used for the \"Index\" and \"Work tree\" titles"
-  :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-ignored-file-face
-  '((((class color) (background light)) (:foreground "grey60"))
-    (((class color) (background dark)) (:foreground "grey40")))
-  "StGit mode face used for ignored files")
-
-(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)
-
-(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)
-
 (defconst stgit-file-status-code-strings
   (mapcar (lambda (arg)
             (cons (car arg)
@@ -433,12 +504,11 @@ applied and unapplied patches), and 'bottom (below all patches)."
                      stgit-file-status-code-strings))
          (score (stgit-file-cr-score file)))
     (when code
-      (format "%-11s  "
-              (if (and score (/= score 100))
-                  (format "%s %s" (cdr code)
-                          (propertize (format "%d%%" score)
-                                      'face 'stgit-description-face))
-                (cdr code))))))
+      (if (and score (/= score 100))
+          (format "%s %s" (cdr code)
+                  (propertize (format "%d%%" score)
+                              'face 'stgit-description-face))
+        (cdr code)))))
 
 (defun stgit-file-status-code (str &optional score)
   "Return stgit status code from git status string"
@@ -481,8 +551,8 @@ Cf. `stgit-file-type-string'."
           ((zerop old-type)
            (if (= new-type #o100)
                ""
-             (format "   (%s)" (stgit-file-type-string new-type))))
-          (t (format "   (%s -> %s)"
+             (format "(%s)" (stgit-file-type-string new-type))))
+          (t (format "(%s -> %s)"
                      (stgit-file-type-string old-type)
                      (stgit-file-type-string new-type))))))
 
@@ -555,23 +625,20 @@ Cf. `stgit-file-type-change-string'."
       (concat (stgit-file-cr-from file) arrow (stgit-file-cr-to file)))))
 
 (defun stgit-file-pp (file)
-  (let ((status (stgit-file-status file))
-        (name (if (stgit-file-copy-or-rename file)
-                  (stgit-describe-copy-or-rename 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%s%s%s%s\n"
-                    (stgit-file-status-code-as-string file)
-                    mode-change
-                    (if (zerop (length mode-change)) "" " ")
-                    name
-                    (propertize (stgit-file-type-change-string
-                                 (stgit-file-old-perm file)
-                                 (stgit-file-new-perm file))
-                                'face 'stgit-description-face)))
+  (let ((start (point))
+        (spec (format-spec-make
+               ?s (stgit-file-status-code-as-string file)
+               ?m (stgit-file-mode-change-string
+                   (stgit-file-old-perm file)
+                   (stgit-file-new-perm file))
+               ?n (if (stgit-file-copy-or-rename file)
+                      (stgit-describe-copy-or-rename file)
+                    (stgit-file-file file))
+               ?c (propertize (stgit-file-type-change-string
+                               (stgit-file-old-perm file)
+                               (stgit-file-new-perm file))
+                              'face 'stgit-description-face))))
+    (insert (format-spec stgit-file-line-format spec) "\n")
     (add-text-properties start (point)
                          (list 'entry-type 'file
                                'file-data file))))
@@ -807,7 +874,8 @@ file for (applied) copies and renames."
             ("t" .        stgit-diff-theirs)))
     (suppress-keymap toggle-map)
     (mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg)))
-          '(("t" .        stgit-toggle-worktree)
+          '(("n" .        stgit-toggle-patch-names)
+            ("t" .        stgit-toggle-worktree)
             ("i" .        stgit-toggle-ignored)
             ("u" .        stgit-toggle-unknown)))
     (setq stgit-mode-map (make-keymap))
@@ -968,6 +1036,8 @@ file for (applied) copies and renames."
          :selected stgit-show-unknown :active stgit-show-worktree]
         ["Show ignored files" stgit-toggle-ignored :style toggle
          :selected stgit-show-ignored :active stgit-show-worktree]
+        ["Show patch names" stgit-toggle-patch-names :style toggle
+         :selected stgit-show-patch-names]
         "-"
         ["Switch branches" stgit-branch t
          :help "Switch to another branch"]
@@ -1045,6 +1115,7 @@ Commands for files:
 \\[stgit-revert]	Revert changes to file
 
 Display commands:
+\\[stgit-toggle-patch-names]	Toggle showing patch names
 \\[stgit-toggle-worktree]	Toggle showing index and work tree
 \\[stgit-toggle-unknown]	Toggle showing unknown files
 \\[stgit-toggle-ignored]	Toggle showing ignored files
@@ -1070,6 +1141,7 @@ Commands for branches:
 
 Customization variables:
 `stgit-abbreviate-copies-and-renames'
+`stgit-default-show-patch-names'
 `stgit-default-show-worktree'
 `stgit-find-copies-harder'
 `stgit-show-worktree-mode'
@@ -1084,6 +1156,8 @@ See also \\[customize-group] for the \"stgit\" group."
   (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-index-node) nil)
   (set (make-local-variable 'stgit-worktree-node) nil)
@@ -1985,6 +2059,9 @@ See also `stgit-show-worktree-mode'.")
 (defvar stgit-show-unknown nil
   "If nil, inhibit showing files not registered with git.")
 
+(defvar stgit-show-patch-names t
+  "If nil, inhibit showing patch names.")
+
 (defun stgit-toggle-worktree (&optional arg)
   "Toggle the visibility of the work tree.
 With ARG, show the work tree if ARG is positive.
@@ -2027,4 +2104,17 @@ Use \\[stgit-toggle-worktree] to show the work tree."
           (not stgit-show-unknown)))
   (stgit-reload))
 
+(defun stgit-toggle-patch-names (&optional arg)
+  "Toggle the visibility of patch names. With ARG, show patch names
+if ARG is positive.
+
+The initial setting is controlled by `stgit-default-show-patch-names'."
+  (interactive)
+  (stgit-assert-mode)
+  (setq stgit-show-patch-names
+        (if (numberp arg)
+            (> arg 0)
+          (not stgit-show-patch-names)))
+  (stgit-reload))
+
 (provide 'stgit)