X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/2547179e7fe72ce7ac9a7641fd61ab00aaa205a8..c141283257195c58448688b8c22b20c988ae8acb:/contrib/stgit.el diff --git a/contrib/stgit.el b/contrib/stgit.el index b3be770..61fca79 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-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-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-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. @@ -70,33 +251,54 @@ directory DIR or `default-directory'" (switch-to-buffer (or buffer (create-stgit-buffer dir))))) -(defstruct (stgit-patch) +(defstruct (stgit-patch + (:conc-name 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-insert-without-trailing-whitespace (text) + "Insert TEXT in buffer using `insert', without trailing whitespace. +A newline is appended." + (unless (string-match "\\(.*?\\) *$" text) + (error)) + (insert (match-string 1 text) ?\n)) + (defun stgit-patch-pp (patch) - (let* ((status (stgit-patch-status 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") + (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)) + (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 (let ((desc (stgit-patch->desc patch))) + (if (zerop (length desc)) + (stgit-patch-display-name patch) + desc)) + 'face face))) + (text (format-spec fmt spec))) + + (stgit-insert-without-trailing-whitespace text) (put-text-property start (point) 'entry-type 'patch) (when (memq name stgit-expanded-patches) (stgit-insert-patch-files patch)) @@ -125,6 +327,7 @@ Returns nil if there was no output." (stgit-dir default-directory) (inhibit-read-only t)) (with-current-buffer output-buf + (buffer-disable-undo) (erase-buffer) (setq default-directory stgit-dir) (setq buffer-read-only t)) @@ -180,6 +383,13 @@ Returns nil if there was no output." (defvar stgit-index-node) (defvar stgit-worktree-node) +(defconst stgit-allowed-branch-name-re + ;; Disallow control characters, space, del, and "/:@^{}~" in + ;; "/"-separated parts; parts may not start with a period (.) + "^[^\0- ./:@^{}~\177][^\0- /:@^{}~\177]*\ +\\(/[^\0- ./:@^{}~\177][^\0- /:@^{}~\177]*\\)*$" + "Regular expression that (new) branch names must match.") + (defun stgit-refresh-index () (when stgit-index-node (ewoc-invalidate (car stgit-index-node) (cdr stgit-index-node)))) @@ -255,6 +465,12 @@ Returns nil if there was no output." stgit-marked-patches (intersection stgit-marked-patches all-patchsyms)))) +(defun stgit-current-branch () + "Return the name of the current branch." + (substring (with-output-to-string + (stgit-run-silent "branch")) + 0 -1)) + (defun stgit-reload () "Update the contents of the StGit buffer." (interactive) @@ -266,11 +482,8 @@ Returns nil if there was no output." (ewoc-filter stgit-ewoc #'(lambda (x) nil)) (ewoc-set-hf stgit-ewoc (concat "Branch: " - (propertize - (substring (with-output-to-string - (stgit-run-silent "branch")) - 0 -1) - 'face 'stgit-branch-name-face) + (propertize (stgit-current-branch) + 'face 'stgit-branch-name-face) "\n\n") (if stgit-show-worktree "--" @@ -280,130 +493,10 @@ Returns nil if there was no output." 'face 'stgit-description-face))) (stgit-run-series stgit-ewoc) (if curpatch - (stgit-goto-patch curpatch (and curfile (stgit-file-file curfile))) + (stgit-goto-patch curpatch (and curfile (stgit-file->file curfile))) (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-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) @@ -429,16 +522,15 @@ applied and unapplied patches), and 'bottom (below all patches)." (defun stgit-file-status-code-as-string (file) "Return stgit status code for FILE as a string" - (let* ((code (assq (stgit-file-status file) + (let* ((code (assq (stgit-file->status file) stgit-file-status-code-strings)) - (score (stgit-file-cr-score file))) + (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 +573,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)))))) @@ -511,7 +603,8 @@ Cf. `stgit-file-type-change-string'." (propertize (format "%o" new-perm) 'face 'stgit-file-permission-face))))))) -(defstruct (stgit-file) +(defstruct (stgit-file + (:conc-name stgit-file->)) old-perm new-perm copy-or-rename cr-score cr-from cr-to status file) (defun stgit-describe-copy-or-rename (file) @@ -519,8 +612,8 @@ Cf. `stgit-file-type-change-string'." from to common-head common-tail) (when stgit-abbreviate-copies-and-renames - (setq from (split-string (stgit-file-cr-from file) "/") - to (split-string (stgit-file-cr-to file) "/")) + (setq from (split-string (stgit-file->cr-from file) "/") + to (split-string (stgit-file->cr-to file) "/")) (while (and from to (cdr from) (cdr to) (string-equal (car from) (car to))) @@ -552,26 +645,24 @@ Cf. `stgit-file-type-change-string'." (if common-tail (mapconcat #'identity common-tail "/") "")) - (concat (stgit-file-cr-from file) arrow (stgit-file-cr-to file))))) + (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)))) + (stgit-insert-without-trailing-whitespace + (format-spec stgit-file-line-format spec)) (add-text-properties start (point) (list 'entry-type 'file 'file-data file)))) @@ -591,15 +682,56 @@ Cf. `stgit-file-type-change-string'." (insert ":0 0 0000000000000000000000000000000000000000 0000000000000000000000000000000000000000 " file-flag "\0") (forward-char name-len))))) +(defun stgit-process-files (callback) + (goto-char (point-min)) + (when (looking-at "[0-9A-Fa-f]\\{40\\}\0") + (goto-char (match-end 0))) + (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") + (let* ((patch-status (stgit-patch->status patch)) + (file-subexp (if (eq patch-status 'unapplied) + 3 + 4)) + (file (match-string file-subexp))) + (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 file))) + ((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)))))) + (goto-char (match-end 0)) + (funcall callback file))))) + + (defun stgit-insert-patch-files (patch) "Expand (show modification of) the patch PATCH after the line at point." - (let* ((patchsym (stgit-patch-name patch)) + (let* ((patchsym (stgit-patch->name patch)) (end (point-marker)) (args (list "-z" (stgit-find-copies-harder-diff-arg))) (ewoc (ewoc-create #'stgit-file-pp nil nil t))) (set-marker-insertion-type end t) - (setf (stgit-patch-files-ewoc patch) ewoc) + (setf (stgit-patch->files-ewoc patch) ewoc) (with-temp-buffer (let ((standard-output (current-buffer))) (apply 'stgit-run-git @@ -614,48 +746,13 @@ at point." (when stgit-show-ignored (stgit-insert-ls-files '("--ignored" "--others") "I")) (when stgit-show-unknown - (stgit-insert-ls-files '("--others") "X")) + (stgit-insert-ls-files '("--directory" "--no-empty-directory" + "--others") + "X")) (sort-regexp-fields nil ":[^\0]*\0\\([^\0]*\\)\0" "\\1" (point-min) (point-max))) - (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") - (let* ((patch-status (stgit-patch-status patch)) - (file-subexp (if (eq patch-status 'unapplied) - 3 - 4)) - (file (match-string file-subexp))) - (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 file))) - ((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)))))) - (goto-char (match-end 0)) - (ewoc-enter-last ewoc file)))) + (stgit-process-files (lambda (file) (ewoc-enter-last ewoc file))) (unless (ewoc-nth ewoc 0) (ewoc-set-hf ewoc "" @@ -668,12 +765,12 @@ at point." (defun stgit-find-file (&optional other-window) (let* ((file (or (stgit-patched-file-at-point) (error "No file at point"))) - (filename (expand-file-name (stgit-file-file file)))) + (filename (expand-file-name (stgit-file->file file)))) (unless (file-exists-p filename) (error "File does not exist")) (funcall (if other-window 'find-file-other-window 'find-file) filename) - (when (eq (stgit-file-status file) 'unmerged) + (when (eq (stgit-file->status file) 'unmerged) (smerge-mode 1)))) (defun stgit-expand (&optional patches collapse) @@ -692,7 +789,7 @@ expand if COLLAPSE is not nil." (set-difference stgit-expanded-patches patches-diff) (append stgit-expanded-patches patches-diff))) (ewoc-map #'(lambda (patch) - (memq (stgit-patch-name patch) patches-diff)) + (memq (stgit-patch->name patch) patches-diff)) stgit-ewoc)) (move-to-column (stgit-goal-column))) @@ -709,6 +806,45 @@ See also `stgit-expand'." (stgit-expand (list patchname) (memq patchname stgit-expanded-patches)))) +(defun stgit-expand-directory (file) + (let* ((patch (stgit-patch-at-point)) + (ewoc (stgit-patch->files-ewoc patch)) + (node (ewoc-locate ewoc)) + (filename (stgit-file->file file)) + (start (make-marker)) + (end (make-marker))) + + (save-excursion + (forward-line 1) + (set-marker start (point)) + (set-marker end (point)) + (set-marker-insertion-type end t)) + + (assert (string-match "/$" filename)) + ;; remove trailing "/" + (setf (stgit-file->file file) (substring filename 0 -1)) + (ewoc-invalidate ewoc node) + + (with-temp-buffer + (let ((standard-output (current-buffer))) + (stgit-insert-ls-files (list "--directory" "--others" + "--no-empty-directory" "--" + filename) + "X") + (stgit-process-files (lambda (f) + (setq node (ewoc-enter-after ewoc node f)))))) + + (let ((inhibit-read-only t)) + (put-text-property start end 'patch-data patch)))) + +(defun stgit-select-file () + (let* ((file (or (stgit-patched-file-at-point) + (error "No file at point"))) + (filename (stgit-file->file file))) + (if (string-match "/$" filename) + (stgit-expand-directory file) + (stgit-find-file)))) + (defun stgit-select () "With point on a patch, toggle showing files in the patch. @@ -720,7 +856,7 @@ file for (applied) copies and renames." ('patch (stgit-select-patch)) ('file - (stgit-find-file)) + (stgit-select-file)) (t (error "No patch or file on line")))) @@ -807,7 +943,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)) @@ -862,7 +999,7 @@ file for (applied) copies and renames." ("q" . stgit-quit)))) (let ((at-unmerged-file '(let ((file (stgit-patched-file-at-point))) - (and file (eq (stgit-file-status file) + (and file (eq (stgit-file->status file) 'unmerged)))) (patch-collapsed-p '(lambda (p) (not (memq p stgit-expanded-patches))))) (easy-menu-define stgit-menu stgit-mode-map @@ -904,8 +1041,9 @@ file for (applied) copies and renames." :active (stgit-patch-name-at-point nil t)] ["Rename patch" stgit-rename :active (stgit-patch-name-at-point nil t)] ["Push/pop patch" stgit-push-or-pop - :label (if (stgit-applied-at-point-p) "Pop patch" "Push patch") - :active (stgit-patch-name-at-point nil t)] + :label (if (subsetp (stgit-patches-marked-or-at-point nil t) + (stgit-applied-patchsyms t)) + "Pop patches" "Push patches")] ["Delete patches" stgit-delete :active (stgit-patches-marked-or-at-point nil t)] "-" @@ -967,9 +1105,11 @@ 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"] + :help "Switch to or create another branch"] ["Rebase branch" stgit-rebase t :help "Rebase the current branch"] )))) @@ -1014,8 +1154,9 @@ Commands for patches: \\[stgit-expand] Show changes in marked patches \\[stgit-collapse] Hide changes in marked patches -\\[stgit-new] Create a new, empty patch \\[stgit-new-and-refresh] Create a new patch from index or work tree +\\[stgit-new] Create a new, empty patch + \\[stgit-rename] Rename patch \\[stgit-edit] Edit patch description \\[stgit-delete] Delete patch(es) @@ -1025,11 +1166,11 @@ Commands for patches: \\[stgit-push-next] Push next patch onto stack \\[stgit-pop-next] Pop current patch from stack -\\[stgit-push-or-pop] Push or pop patch at point -\\[stgit-goto] Make current patch current by popping or pushing +\\[stgit-push-or-pop] Push or pop marked patches +\\[stgit-goto] Make patch at point current by popping or pushing \\[stgit-squash] Squash (meld together) patches -\\[stgit-move-patches] Move patch(es) to point +\\[stgit-move-patches] Move marked patches to point \\[stgit-commit] Commit patch(es) \\[stgit-uncommit] Uncommit patch(es) @@ -1043,6 +1184,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 @@ -1063,11 +1205,12 @@ Commands for merge conflicts: \\[stgit-resolve-file] Mark unmerged file as resolved Commands for branches: -\\[stgit-branch] Switch to another branch +\\[stgit-branch] Switch to or create another branch \\[stgit-rebase] Rebase the current branch Customization variables: `stgit-abbreviate-copies-and-renames' +`stgit-default-show-patch-names' `stgit-default-show-worktree' `stgit-find-copies-harder' `stgit-show-worktree-mode' @@ -1082,6 +1225,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) @@ -1123,10 +1268,10 @@ index or work tree." (let ((patch (stgit-patch-at-point))) (and patch only-patches - (memq (stgit-patch-status patch) '(work index)) + (memq (stgit-patch->status patch) '(work index)) (setq patch nil)) (cond (patch - (stgit-patch-name patch)) + (stgit-patch->name patch)) (cause-error (error "No patch on this line"))))) @@ -1152,13 +1297,13 @@ 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 PATCHSYM." (let ((node (ewoc-nth stgit-ewoc 0))) - (while (and node (not (eq (stgit-patch-name (ewoc-data node)) + (while (and node (not (eq (stgit-patch->name (ewoc-data node)) patchsym))) (setq node (ewoc-next stgit-ewoc node))) (when (and node file) - (let* ((file-ewoc (stgit-patch-files-ewoc (ewoc-data node))) + (let* ((file-ewoc (stgit-patch->files-ewoc (ewoc-data node))) (file-node (ewoc-nth file-ewoc 0))) - (while (and file-node (not (equal (stgit-file-file (ewoc-data file-node)) file))) + (while (and file-node (not (equal (stgit-file->file (ewoc-data file-node)) file))) (setq file-node (ewoc-next file-ewoc file-node))) (when file-node (ewoc-goto-node file-ewoc file-node) @@ -1190,12 +1335,12 @@ PATCHSYM." (stgit-assert-mode) (let* ((node (ewoc-locate stgit-ewoc)) (patch (ewoc-data node)) - (name (stgit-patch-name patch))) + (name (stgit-patch->name patch))) (when (eq name :work) (error "Cannot mark the work tree")) (when (eq name :index) (error "Cannot mark the index")) - (stgit-add-mark (stgit-patch-name patch)) + (stgit-add-mark (stgit-patch->name patch)) (let ((column (current-column))) (ewoc-invalidate stgit-ewoc node) (move-to-column column)))) @@ -1212,7 +1357,7 @@ PATCHSYM." (stgit-assert-mode) (let* ((node (ewoc-locate stgit-ewoc)) (patch (ewoc-data node))) - (stgit-remove-mark (stgit-patch-name patch)) + (stgit-remove-mark (stgit-patch->name patch)) (let ((column (current-column))) (ewoc-invalidate stgit-ewoc node) (move-to-column column)))) @@ -1269,24 +1414,38 @@ was modified with git commands (`stgit-repair')." (stgit-run "repair")) (stgit-reload)) -(defun stgit-available-branches () - "Returns a list of the available stg branches" +(defun stgit-available-branches (&optional all) + "Returns a list of the names of the available stg branches as strings. + +If ALL is not nil, also return non-stgit branches." (let ((output (with-output-to-string (stgit-run "branch" "--list"))) + (pattern (format "^>?\\s-+%c\\s-+\\(\\S-+\\)" + (if all ?. ?s))) (start 0) result) - (while (string-match "^>?\\s-+s\\s-+\\(\\S-+\\)" output start) + (while (string-match pattern output start) (setq result (cons (match-string 1 output) result)) (setq start (match-end 0))) result)) (defun stgit-branch (branch) - "Switch to branch BRANCH." + "Switch to or create branch BRANCH." (interactive (list (completing-read "Switch to branch: " (stgit-available-branches)))) (stgit-assert-mode) - (stgit-capture-output nil (stgit-run "branch" "--" branch)) - (stgit-reload)) + (when (cond ((equal branch (stgit-current-branch)) + (error "Branch is already current")) + ((member branch (stgit-available-branches t)) + (stgit-capture-output nil (stgit-run "branch" "--" branch)) + t) + ((not (string-match stgit-allowed-branch-name-re branch)) + (error "Invalid branch name")) + ((yes-or-no-p (format "Create branch \"%s\"? " branch)) + (stgit-capture-output nil (stgit-run "branch" "--create" "--" + branch)) + t)) + (stgit-reload))) (defun stgit-available-refs (&optional omit-stgit) "Returns a list of the available git refs. @@ -1306,10 +1465,25 @@ If OMIT-STGIT is not nil, filter out \"resf/heads/*.stgit\"." result) result)))) +(defun stgit-parent-branch () + "Return the parent branch of the current stg branch as per +git-config setting branch..stgit.parentbranch." + (let ((output (with-output-to-string + (stgit-run-git-silent "config" + (format "branch.%s.stgit.parentbranch" + (stgit-current-branch)))))) + (when (string-match ".*" output) + (match-string 0 output)))) + (defun stgit-rebase (new-base) - "Rebase to NEW-BASE." + "Rebase the current branch to NEW-BASE. + +Interactively, first ask which branch to rebase to. Defaults to +what git-config branch..stgit.parentbranch is set to." (interactive (list (completing-read "Rebase to: " - (stgit-available-refs t)))) + (stgit-available-refs t) + nil nil + (stgit-parent-branch)))) (stgit-assert-mode) (stgit-capture-output nil (stgit-run "rebase" new-base)) (stgit-reload)) @@ -1343,12 +1517,12 @@ previous file if point is at the last file within a patch." neighbour-file) (and (zerop (forward-line 1)) (let ((f (stgit-patched-file-at-point))) - (and f (setq neighbour-file (stgit-file-file f))))) + (and f (setq neighbour-file (stgit-file->file f))))) (goto-char old-point) (unless neighbour-file (and (zerop (forward-line -1)) (let ((f (stgit-patched-file-at-point))) - (and f (setq neighbour-file (stgit-file-file f))))) + (and f (setq neighbour-file (stgit-file->file f))))) (goto-char old-point)) neighbour-file)) @@ -1360,15 +1534,15 @@ working tree." (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)) + (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)))) + (stgit-file->file patched-file)))) (co-file (cond ((eq file-status 'rename) - (stgit-file-cr-from patched-file)) + (stgit-file->cr-from patched-file)) ((not (memq file-status '(copy add))) - (stgit-file-file patched-file)))) + (stgit-file->file patched-file)))) (next-file (stgit-neighbour-file))) (unless (memq patch-name '(:work :index)) @@ -1431,8 +1605,8 @@ tree, or a single change in either." (stgit-assert-mode) (let* ((patched-file (stgit-patched-file-at-point)) (patch (stgit-patch-at-point)) - (patch-name (and patch (stgit-patch-name patch))) - (status (and patched-file (stgit-file-status patched-file)))) + (patch-name (and patch (stgit-patch->name patch))) + (status (and patched-file (stgit-file->status patched-file)))) (unless (memq patch-name '(:work :index)) (error "No index or working tree file on this line")) @@ -1441,51 +1615,97 @@ tree, or a single change in either." (error "No conflict to resolve at the current line")) (stgit-capture-output nil - (stgit-move-change-to-index (stgit-file-file patched-file))) + (stgit-move-change-to-index (stgit-file->file patched-file))) (stgit-reload))) +(defun stgit-push-or-pop-patches (do-push npatches) + "Push (if DO-PUSH is not nil) or pop (if DO-PUSH is nil) +NPATCHES patches, or all patches if NPATCHES is t." + (stgit-assert-mode) + (stgit-capture-output nil + (apply 'stgit-run + (if do-push "push" "pop") + (if (eq npatches t) + '("--all") + (list "-n" npatches)))) + (stgit-reload) + (stgit-refresh-git-status)) + (defun stgit-push-next (npatches) "Push the first unapplied patch. With numeric prefix argument, push that many patches." (interactive "p") - (stgit-assert-mode) - (stgit-capture-output nil (stgit-run "push" "-n" npatches)) - (stgit-reload) - (stgit-refresh-git-status)) + (stgit-push-or-pop-patches t npatches)) (defun stgit-pop-next (npatches) "Pop the topmost applied patch. -With numeric prefix argument, pop that many patches." +With numeric prefix argument, pop that many patches. + +If NPATCHES is t, pop all patches." (interactive "p") - (stgit-assert-mode) - (stgit-capture-output nil (stgit-run "pop" "-n" npatches)) - (stgit-reload) - (stgit-refresh-git-status)) + (stgit-push-or-pop-patches nil npatches)) + +(defun stgit-applied-patches (&optional only-patches) + "Return a list of the applied patches. -(defun stgit-applied-at-point-p () - "Return non-nil if the patch at point is applied." - (let ((patch (stgit-patch-at-point t))) - (not (eq (stgit-patch-status patch) 'unapplied)))) +If ONLY-PATCHES is not nil, exclude index and work tree." + (let ((states (if only-patches + '(applied top) + '(applied top index work))) + result) + (ewoc-map (lambda (patch) (when (memq (stgit-patch->status patch) states) + (setq result (cons patch result)))) + stgit-ewoc) + result)) + +(defun stgit-applied-patchsyms (&optional only-patches) + "Return a list of the symbols of the applied patches. + +If ONLY-PATCHES is not nil, exclude index and work tree." + (mapcar #'stgit-patch->name (stgit-applied-patches only-patches))) (defun stgit-push-or-pop () - "Push or pop the patch on the current line." + "Push or pop the marked patches." (interactive) (stgit-assert-mode) - (let ((patchsym (stgit-patch-name-at-point t t)) - (applied (stgit-applied-at-point-p))) + (let* ((patchsyms (stgit-patches-marked-or-at-point t t)) + (applied-syms (stgit-applied-patchsyms t)) + (unapplied (set-difference patchsyms applied-syms))) (stgit-capture-output nil - (stgit-run (if applied "pop" "push") patchsym)) - (stgit-reload))) + (apply 'stgit-run + (if unapplied "push" "pop") + "--" + (stgit-sort-patches (if unapplied unapplied patchsyms))))) + (stgit-reload)) + +(defun stgit-goto-target () + "Return the goto target a point; either a patchsym, :top, +or :bottom." + (let ((patchsym (stgit-patch-name-at-point))) + (cond ((memq patchsym '(:work :index)) nil) + (patchsym) + ((not (next-single-property-change (point) 'patch-data)) + :top) + ((not (previous-single-property-change (point) 'patch-data)) + :bottom)))) (defun stgit-goto () - "Go to the patch on the current line." + "Go to the patch on the current line. + +Push or pop patches to make this patch topmost. Push or pop all +patches if used on a line after or before all patches." (interactive) (stgit-assert-mode) - (let ((patchsym (stgit-patch-name-at-point t))) - (stgit-capture-output nil - (stgit-run "goto" patchsym)) - (stgit-reload))) + (let ((patchsym (stgit-goto-target))) + (unless patchsym + (error "No patch to go to on this line")) + (case patchsym + (:top (stgit-push-or-pop-patches t t)) + (:bottom (stgit-push-or-pop-patches nil t)) + (t (stgit-capture-output nil + (stgit-run "goto" patchsym)) + (stgit-reload))))) (defun stgit-id (patchsym) "Return the git commit id for PATCHSYM. @@ -1498,16 +1718,17 @@ If PATCHSYM is a keyword, returns PATCHSYM unmodified." (error "Cannot find commit id for %s" patchsym)) (match-string 1 result)))) +(defun stgit-whitespace-diff-arg (arg) + (when (numberp arg) + (cond ((> arg 4) "--ignore-all-space") + ((> arg 1) "--ignore-space-change")))) + (defun stgit-show-patch (unmerged-stage ignore-whitespace) "Show the patch on the current line. UNMERGED-STAGE is the argument to `git-diff' that that selects which stage to diff against in the case of unmerged files." - (let ((space-arg (when (numberp ignore-whitespace) - (cond ((> ignore-whitespace 4) - "--ignore-all-space") - ((> ignore-whitespace 1) - "--ignore-space-change")))) + (let ((space-arg (stgit-whitespace-diff-arg ignore-whitespace)) (patch-name (stgit-patch-name-at-point t))) (stgit-capture-output "*StGit patch*" (case (get-text-property (point) 'entry-type) @@ -1515,12 +1736,12 @@ which stage to diff against in the case of unmerged files." (let* ((patched-file (stgit-patched-file-at-point)) (patch-id (let ((id (stgit-id patch-name))) (if (and (eq id :index) - (eq (stgit-file-status patched-file) + (eq (stgit-file->status patched-file) 'unmerged)) :work id))) (args (append (and space-arg (list space-arg)) - (and (stgit-file-cr-from patched-file) + (and (stgit-file->cr-from patched-file) (list (stgit-find-copies-harder-diff-arg))) (cond ((eq patch-id :index) '("--cached")) @@ -1529,10 +1750,10 @@ which stage to diff against in the case of unmerged files." (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)))))) + (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 (let* ((patch-id (stgit-id patch-name))) @@ -1616,23 +1837,23 @@ file ended up. You can then jump to the file with \ (stgit-assert-mode) (let* ((patched-file (or (stgit-patched-file-at-point) (error "No file on the current line"))) - (patched-status (stgit-file-status patched-file))) + (patched-status (stgit-file->status patched-file))) (when (eq patched-status 'unmerged) (error (substitute-command-keys "Use \\[stgit-resolve-file] to move an unmerged file to the index"))) (let* ((patch (stgit-patch-at-point)) - (patch-name (stgit-patch-name patch)) + (patch-name (stgit-patch->name patch)) (mark-file (if (eq patched-status 'rename) - (stgit-file-cr-to patched-file) - (stgit-file-file patched-file))) + (stgit-file->cr-to patched-file) + (stgit-file->file patched-file))) (point-file (if (eq patched-status 'rename) - (stgit-file-cr-from patched-file) + (stgit-file->cr-from patched-file) (stgit-neighbour-file)))) (cond ((eq patch-name :work) - (stgit-move-change-to-index (stgit-file-file patched-file) + (stgit-move-change-to-index (stgit-file->file patched-file) (eq patched-status 'ignore))) ((eq patch-name :index) - (stgit-remove-change-from-index (stgit-file-file patched-file))) + (stgit-remove-change-from-index (stgit-file->file patched-file))) (t (error "Can only move files between working tree and index"))) (stgit-refresh-worktree) @@ -1681,7 +1902,8 @@ file ended up. You can then jump to the file with \ (set (make-local-variable 'stgit-edit-patchsym) patchsym) (setq default-directory dir) (let ((standard-output edit-buf)) - (stgit-run-silent "edit" "--save-template=-" patchsym)))) + (save-excursion + (stgit-run-silent "edit" "--save-template=-" patchsym))))) (defun stgit-confirm-edit () (interactive) @@ -1800,11 +2022,12 @@ patches." (t (setq result :bottom))))) result))) -(defun stgit-sort-patches (patchsyms) +(defun stgit-sort-patches (patchsyms &optional allow-duplicates) "Returns the list of patches in PATCHSYMS sorted according to their position in the patch series, bottommost first. -PATCHSYMS must not contain duplicate entries." +PATCHSYMS must not contain duplicate entries, unless +ALLOW-DUPLICATES is not nil." (let (sorted-patchsyms (series (with-output-to-string (with-current-buffer standard-output @@ -1817,8 +2040,9 @@ PATCHSYMS must not contain duplicate entries." (setq start (match-end 0))) (setq sorted-patchsyms (nreverse sorted-patchsyms)) - (unless (= (length patchsyms) (length sorted-patchsyms)) - (error "Internal error")) + (unless allow-duplicates + (unless (= (length patchsyms) (length sorted-patchsyms)) + (error "Internal error"))) sorted-patchsyms)) @@ -1869,8 +2093,9 @@ deepest patch had before the squash." (set (make-local-variable 'stgit-patchsyms) sorted-patchsyms) (setq default-directory dir) (let ((result (let ((standard-output edit-buf)) - (apply 'stgit-run-silent "squash" - "--save-template=-" sorted-patchsyms)))) + (save-excursion + (apply 'stgit-run-silent "squash" + "--save-template=-" sorted-patchsyms))))) ;; stg squash may have reordered the patches or caused conflicts (with-current-buffer stgit-buffer @@ -1904,18 +2129,29 @@ deepest patch had before the squash." (interactive) (describe-function 'stgit-mode)) +(defun stgit-undo-or-redo (redo hard) + "Run stg undo or, if REDO is non-nil, stg redo. + +If HARD is non-nil, use the --hard flag." + (stgit-assert-mode) + (let ((cmd (if redo "redo" "undo"))) + (stgit-capture-output nil + (if arg + (when (or (and (stgit-index-empty-p) + (stgit-work-tree-empty-p)) + (y-or-n-p (format "Hard %s may overwrite index/work tree changes. Continue? " + cmd))) + (stgit-run cmd "--hard")) + (stgit-run cmd)))) + (stgit-reload)) + (defun stgit-undo (&optional arg) "Run stg undo. With prefix argument, run it with the --hard flag. See also `stgit-redo'." (interactive "P") - (stgit-assert-mode) - (stgit-capture-output nil - (if arg - (stgit-run "undo" "--hard") - (stgit-run "undo"))) - (stgit-reload)) + (stgit-undo-or-redo nil arg)) (defun stgit-redo (&optional arg) "Run stg redo. @@ -1923,12 +2159,7 @@ With prefix argument, run it with the --hard flag. See also `stgit-undo'." (interactive "P") - (stgit-assert-mode) - (stgit-capture-output nil - (if arg - (stgit-run "redo" "--hard") - (stgit-run "redo"))) - (stgit-reload)) + (stgit-undo-or-redo t arg)) (defun stgit-refresh (&optional arg) "Run stg refresh. @@ -1961,6 +2192,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. @@ -2003,4 +2237,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)