(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.
(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 (or (stgit-patch->desc patch)
+ (stgit-patch-display-name patch))
+ '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))
(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))
(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))))
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)
(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
"--"
'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-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)
(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"
((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))))))
(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)
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)))
(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))))
(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
(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 ""
(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)
(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)))
(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.
('patch
(stgit-select-patch))
('file
- (stgit-find-file))
+ (stgit-select-file))
(t
(error "No patch or file on line"))))
("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))
("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
: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"]
))))
\\[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
\\[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'
(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)
(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")))))
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)
(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))))
(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))))
(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.
result)
result))))
+(defun stgit-parent-branch ()
+ "Return the parent branch of the current stg branch as per
+git-config setting branch.<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.<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))
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))
(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))
(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"))
(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)))
'(applied top)
'(applied top index work)))
result)
- (ewoc-map (lambda (patch) (when (memq (stgit-patch-status patch) states)
+ (ewoc-map (lambda (patch) (when (memq (stgit-patch->status patch) states)
(setq result (cons patch result))))
stgit-ewoc)
result))
"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)))
+ (mapcar #'stgit-patch->name (stgit-applied-patches only-patches)))
(defun stgit-push-or-pop ()
"Push or pop the marked patches."
(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"))
(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)))
(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)
(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)
(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
(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.
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.
(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.
(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)
~mdw / stgit / commitdiff