;;
;; To start: `M-x stgit'
+(when (< emacs-major-version 22)
+ (error "Emacs older than 22 is not supported by stgit.el"))
+
(require 'git nil t)
(require 'cl)
+(require 'comint)
(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 this \
+setting in an already-started StGit buffer."
+ :type 'boolean
+ :group 'stgit
+ :link '(variable-link stgit-show-worktree))
+
+(defcustom stgit-default-show-unknown nil
+ "Set to non-nil to by default show unknown files a new stgit buffer.
+
+Use \\<stgit-mode-map>\\[stgit-toggle-unknown] to toggle this \
+setting in an already-started StGit buffer."
+ :type 'boolean
+ :group 'stgit
+ :link '(variable-link stgit-show-unknown))
+
+(defcustom stgit-default-show-ignored nil
+ "Set to non-nil to by default show ignored files a new stgit buffer.
+
+Use \\<stgit-mode-map>\\[stgit-toggle-ignored] to toggle this \
+setting in an already-started StGit buffer."
+ :type 'boolean
+ :group 'stgit
+ :link '(variable-link stgit-show-ignored))
+
+(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-committed nil
+ "Set to nil to inhibit showing of historical git commits by default.
+
+Use \\<stgit-mode-map>\\[stgit-toggle-committed] \
+to toggle this setting and to control how many commits are
+shown."
+ :type 'boolean
+ :group 'stgit
+ :link '(variable-link stgit-show-committed))
+
+(defcustom stgit-default-committed-count 5
+ "The number of historical commits to show when `stgit-show-committed'
+is enabled."
+ :type 'number
+ :link '(variable-link stgit-committed-count))
+
+(defcustom stgit-default-show-patch-names t
+ "If non-nil, default to showing patch names in a new stgit buffer.
+
+Use \\<stgit-mode-map>\\[stgit-toggle-patch-names] \
+to toggle the this setting in an already-started StGit buffer."
+ :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-committed-patch-face
+ '((((background dark)) (:foreground "gray50"))
+ (((background light)) (:foreground "gray50"))
+ (t ()))
+ "The face used for already committed patch names"
+ :group 'stgit)
+
+(defface stgit-description-face
+ '((((background dark)) (:foreground "tan"))
+ (((background light)) (:foreground "dark red")))
+ "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."
+ "Manage StGit patches for the tree in DIR.
+
+See `stgit-mode' for commands available."
(interactive "DDirectory: \n")
(switch-to-stgit-buffer (git-get-top-dir dir))
(stgit-reload))
+(defun stgit-assert-mode ()
+ "Signal an error if not in an StGit buffer."
+ (assert (derived-mode-p 'stgit-mode) nil "Not an StGit buffer"))
+
(unless (fboundp 'git-get-top-dir)
(defun git-get-top-dir (dir)
"Retrieve the top-level directory of a git tree."
(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-pp (patch)
- (let ((status (stgit-patch-status patch))
- (start (point))
- (name (stgit-patch-name patch)))
+(defun stgit-patch-display-name (patch)
+ (let ((name (stgit-patch->name patch)))
(case name
- (:index (insert (propertize " Index" 'face 'italic)))
- (:work (insert (propertize " Work tree" 'face 'italic)))
- (t (insert (case status
- ('applied "+")
- ('top ">")
- ('unapplied "-"))
- (if (memq name stgit-marked-patches)
- "*" " ")
- (propertize (format "%-30s"
- (symbol-name name))
- 'face (case status
- ('applied 'stgit-applied-patch-face)
- ('top 'stgit-top-patch-face)
- ('unapplied 'stgit-unapplied-patch-face)
- ('index nil)
- ('work nil)))
- " "
- (if (stgit-patch-empty patch) "(empty) " "")
- (propertize (or (stgit-patch-desc patch) "")
- 'face 'stgit-description-face))))
+ (: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-line-format ()
+ "Return the current line format; one of
+`stgit-patch-line-format' and `stgit-noname-patch-line-format'"
+ (if stgit-show-patch-names
+ stgit-patch-line-format
+ stgit-noname-patch-line-format))
+
+(defun stgit-patch-pp (patch)
+ (let* ((status (stgit-patch->status patch))
+ (start (point))
+ (name (stgit-patch->name patch))
+ (face (cdr (assq status stgit-patch-status-face-alist)))
+ (fmt (stgit-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))
(setq default-directory dir)
(stgit-mode)
(set (make-local-variable 'stgit-ewoc)
- (ewoc-create #'stgit-patch-pp "Branch:\n" "--"))
+ (ewoc-create #'stgit-patch-pp "Branch:\n\n" "--\n" t))
(setq buffer-read-only t))
buf))
+(def-edebug-spec stgit-capture-output
+ (form body))
(defmacro stgit-capture-output (name &rest body)
"Capture StGit output and, if there was any output, show it in a window
at the end.
(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))
"Returns non-nil if the index contains no changes from HEAD."
(zerop (stgit-run-git-silent "diff-index" "--cached" "--quiet" "HEAD")))
+(defun stgit-work-tree-empty-p ()
+ "Returns non-nil if the work tree contains no changes from index."
+ (zerop (stgit-run-git-silent "diff-files" "--quiet")))
+
(defvar stgit-index-node)
(defvar stgit-worktree-node)
+(defvar stgit-did-advise nil
+ "Set to non-nil if appropriate (non-stgit) git functions have
+been advised to update the stgit status when necessary.")
+
+(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))))
(when stgit-worktree-node
(ewoc-invalidate (car stgit-worktree-node) (cdr stgit-worktree-node))))
-(defun stgit-run-series (ewoc)
- (let ((first-line t))
- (with-temp-buffer
- (let ((exit-status (stgit-run-silent "series" "--description" "--empty")))
- (goto-char (point-min))
- (if (not (zerop exit-status))
- (cond ((looking-at "stg series: \\(.*\\)")
- (ewoc-set-hf ewoc (car (ewoc-get-hf ewoc))
- "-- not initialized (run M-x stgit-init)"))
- ((looking-at ".*")
- (error "Error running stg: %s"
- (match-string 0))))
- (while (not (eobp))
- (unless (looking-at
- "\\([0 ]\\)\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
- (error "Syntax error in output from stg series"))
- (let* ((state-str (match-string 2))
- (state (cond ((string= state-str ">") 'top)
- ((string= state-str "+") 'applied)
- ((string= state-str "-") 'unapplied))))
- (ewoc-enter-last ewoc
- (make-stgit-patch
- :status state
- :name (intern (match-string 4))
- :desc (match-string 5)
- :empty (string= (match-string 1) "0"))))
- (setq first-line nil)
- (forward-line 1)))))
- (if stgit-show-worktree
- (setq stgit-index-node (cons ewoc (ewoc-enter-last ewoc
- (make-stgit-patch
- :status 'index
- :name :index
- :desc nil
- :empty nil)))
- stgit-worktree-node (cons ewoc (ewoc-enter-last ewoc
- (make-stgit-patch
- :status 'work
- :name :work
- :desc nil
- :empty nil))))
- (setq stgit-worktree-node nil))))
+(defun stgit-run-series-insert-index (ewoc)
+ (setq index-node (cons ewoc (ewoc-enter-last ewoc
+ (make-stgit-patch
+ :status 'index
+ :name :index
+ :desc nil
+ :empty nil)))
+ worktree-node (cons ewoc (ewoc-enter-last ewoc
+ (make-stgit-patch
+ :status 'work
+ :name :work
+ :desc nil
+ :empty nil)))))
+(defun stgit-run-series (ewoc)
+ (setq stgit-index-node nil
+ stgit-worktree-node nil)
+ (let (all-patchsyms)
+ (when stgit-show-committed
+ (let* ((base (stgit-id "{base}"))
+ (range (format "%s~%d..%s" base stgit-committed-count base)))
+ (with-temp-buffer
+ (let* ((standard-output (current-buffer))
+ (fmt (stgit-line-format))
+ (commit-abbrev (when (string-match "%-\\([0-9]+\\)n" fmt)
+ (list (format "--abbrev=%s"
+ (match-string 1 fmt)))))
+ (exit-status (apply 'stgit-run-git-silent
+ "--no-pager"
+ "log" "--reverse" "--pretty=oneline"
+ "--abbrev-commit"
+ `(,@commit-abbrev
+ ,range))))
+ (goto-char (point-min))
+ (if (not (zerop exit-status))
+ (message "Failed to run git log")
+ (while (not (eobp))
+ (unless (looking-at
+ "\\([0-9a-f]+\\)\\(\\.\\.\\.\\)? \\(.*\\)")
+ (error "Syntax error in output from git log"))
+ (let* ((state 'committed)
+ (name (intern (match-string 1)))
+ (desc (match-string 3))
+ (empty nil))
+ (setq all-patchsyms (cons name all-patchsyms))
+ (ewoc-enter-last ewoc
+ (make-stgit-patch
+ :status state
+ :name name
+ :desc desc
+ :empty empty)))
+ (forward-line 1)))))))
+ (let ((inserted-index (not stgit-show-worktree))
+ index-node
+ worktree-node)
+ (with-temp-buffer
+ (let* ((standard-output (current-buffer))
+ (exit-status (stgit-run-silent "series"
+ "--description" "--empty")))
+ (goto-char (point-min))
+ (if (not (zerop exit-status))
+ (cond ((looking-at "stg series: \\(.*\\)")
+ (setq inserted-index t)
+ (ewoc-set-hf ewoc (car (ewoc-get-hf ewoc))
+ (substitute-command-keys
+ "-- not initialized; run \\[stgit-init]")))
+ ((looking-at ".*")
+ (error "Error running stg: %s"
+ (match-string 0))))
+ (while (not (eobp))
+ (unless (looking-at
+ "\\([0 ]\\)\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)")
+ (error "Syntax error in output from stg series"))
+ (let* ((state-str (match-string 2))
+ (state (cond ((string= state-str ">") 'top)
+ ((string= state-str "+") 'applied)
+ ((string= state-str "-") 'unapplied)))
+ (name (intern (match-string 4)))
+ (desc (match-string 5))
+ (empty (string= (match-string 1) "0")))
+ (unless inserted-index
+ (when (or (eq stgit-show-worktree-mode 'top)
+ (and (eq stgit-show-worktree-mode 'center)
+ (eq state 'unapplied)))
+ (setq inserted-index t)
+ (stgit-run-series-insert-index ewoc)))
+ (setq all-patchsyms (cons name all-patchsyms))
+ (ewoc-enter-last ewoc
+ (make-stgit-patch
+ :status state
+ :name name
+ :desc desc
+ :empty empty)))
+ (forward-line 1)))))
+ (unless inserted-index
+ (stgit-run-series-insert-index ewoc))
+ (setq stgit-index-node index-node
+ stgit-worktree-node worktree-node
+ stgit-marked-patches (intersection stgit-marked-patches
+ all-patchsyms)))))
+
+(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)
+ (stgit-assert-mode)
(let ((inhibit-read-only t)
(curline (line-number-at-pos))
- (curpatch (stgit-patch-name-at-point)))
+ (curpatch (stgit-patch-name-at-point))
+ (curfile (stgit-patched-file-at-point)))
(ewoc-filter stgit-ewoc #'(lambda (x) nil))
(ewoc-set-hf stgit-ewoc
(concat "Branch: "
- (propertize
- (with-temp-buffer
- (stgit-run-silent "branch")
- (buffer-substring (point-min) (1- (point-max))))
- 'face 'stgit-branch-name-face)
- "\n")
+ (propertize (stgit-current-branch)
+ 'face 'stgit-branch-name-face)
+ "\n\n")
(if stgit-show-worktree
"--"
(propertize
(substitute-command-keys "--\n\"\\[stgit-toggle-worktree]\"\
shows the working tree\n")
- 'face 'stgit-description-face)))
+ 'face 'stgit-description-face)))
(stgit-run-series stgit-ewoc)
(if curpatch
- (stgit-goto-patch curpatch)
+ (stgit-goto-patch curpatch (and curfile (stgit-file->file curfile)))
(goto-line curline)))
(stgit-refresh-git-status))
-(defgroup stgit nil
- "A user interface for the StGit patch maintenance tool."
- :group 'tools)
-
-(defface stgit-description-face
- '((((background dark)) (:foreground "tan"))
- (((background light)) (:foreground "dark red")))
- "The face used for StGit descriptions"
- :group 'stgit)
-
-(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-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)
-
-(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-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)
-
-(defcustom stgit-expand-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)
-
(defconst stgit-file-status-code-strings
(mapcar (lambda (arg)
(cons (car arg)
(rename "Renamed" stgit-modified-file-face)
(mode-change "Mode change" stgit-modified-file-face)
(unmerged "Unmerged" stgit-unmerged-file-face)
- (unknown "Unknown" stgit-unknown-file-face)))
+ (unknown "Unknown" stgit-unknown-file-face)
+ (ignore "Ignored" stgit-ignored-file-face)))
"Alist of code symbols to description strings")
+(defconst stgit-patch-status-face-alist
+ '((applied . stgit-applied-patch-face)
+ (top . stgit-top-patch-face)
+ (unapplied . stgit-unapplied-patch-face)
+ (committed . stgit-committed-patch-face)
+ (index . stgit-index-work-tree-title-face)
+ (work . stgit-index-work-tree-title-face))
+ "Alist of face to use for a given patch status")
+
(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"
(let ((code (assoc str '(("A" . add)
("C" . copy)
("D" . delete)
+ ("I" . ignore)
("M" . modify)
("R" . rename)
("T" . mode-change)
((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)
+ (let ((arrow (concat " " (propertize "->" 'face 'stgit-description-face) " "))
+ 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) "/"))
+
+ (while (and from to (cdr from) (cdr to)
+ (string-equal (car from) (car to)))
+ (setq common-head (cons (car from) common-head)
+ from (cdr from)
+ to (cdr to)))
+ (setq common-head (nreverse common-head)
+ from (nreverse from)
+ to (nreverse to))
+ (while (and from to (cdr from) (cdr to)
+ (string-equal (car from) (car to)))
+ (setq common-tail (cons (car from) common-tail)
+ from (cdr from)
+ to (cdr to)))
+ (setq from (nreverse from)
+ to (nreverse to)))
+
+ (if (or common-head common-tail)
+ (concat (if common-head
+ (mapconcat #'identity common-head "/")
+ "")
+ (if common-head "/" "")
+ (propertize "{" 'face 'stgit-description-face)
+ (mapconcat #'identity from "/")
+ arrow
+ (mapconcat #'identity to "/")
+ (propertize "}" 'face 'stgit-description-face)
+ (if common-tail "/" "")
+ (if common-tail
+ (mapconcat #'identity common-tail "/")
+ ""))
+ (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)
- (concat (stgit-file-cr-from file)
- (propertize " -> "
- 'face 'stgit-description-face)
- (stgit-file-cr-to 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%1s%s%s\n"
- (stgit-file-status-code-as-string file)
- 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))))
(defun stgit-find-copies-harder-diff-arg ()
"Return the flag to use with `git-diff' depending on the
-`stgit-expand-find-copies-harder' flag."
- (if stgit-expand-find-copies-harder
- "--find-copies-harder"
- "-C"))
+`stgit-find-copies-harder' flag."
+ (if stgit-find-copies-harder "--find-copies-harder" "-C"))
+
+(defun stgit-insert-ls-files (args file-flag)
+ (let ((start (point)))
+ (apply 'stgit-run-git
+ (append '("ls-files" "--exclude-standard" "-z") args))
+ (goto-char start)
+ (while (looking-at "\\([^\0]*\\)\0")
+ (let ((name-len (- (match-end 0) (match-beginning 0))))
+ (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))
- (end (progn (insert "#") (prog1 (point-marker) (forward-char -1))))
- (args (list "-z" (stgit-find-copies-harder-diff-arg)))
- (ewoc (ewoc-create #'stgit-file-pp nil nil t)))
- (setf (stgit-patch-files-ewoc patch) ewoc)
+ (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))
+ (show-ignored stgit-show-ignored)
+ (show-unknown stgit-show-unknown))
+ (set-marker-insertion-type end t)
+ (setf (stgit-patch->files-ewoc patch) ewoc)
(with-temp-buffer
- (apply 'stgit-run-git
- (cond ((eq patchsym :work)
- `("diff-files" ,@args))
- ((eq patchsym :index)
- `("diff-index" ,@args "--cached" "HEAD"))
- (t
- `("diff-tree" ,@args "-r" ,(stgit-id patchsym)))))
- (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")
- (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 (match-string 3)))
- ((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))))))
- (ewoc-enter-last ewoc file))
- (goto-char (match-end 0))))
- (unless (ewoc-nth ewoc 0)
- (ewoc-set-hf ewoc "" (propertize " <no files>\n"
- 'face 'stgit-description-face))))
- (goto-char end)
- (delete-char -2)))
-
-(defun stgit-select-file ()
- (let ((filename (expand-file-name
- (stgit-file-file (stgit-patched-file-at-point)))))
+ (let ((standard-output (current-buffer)))
+ (apply 'stgit-run-git
+ (cond ((eq patchsym :work)
+ (let (standard-output)
+ (stgit-run-git "update-index" "--refresh"))
+ `("diff-files" "-0" ,@args))
+ ((eq patchsym :index)
+ `("diff-index" ,@args "--cached" "HEAD"))
+ (t
+ `("diff-tree" ,@args "-r" ,(stgit-id patchsym)))))
+
+ (when (and (eq patchsym :work))
+ (when show-ignored
+ (stgit-insert-ls-files '("--ignored" "--others") "I"))
+ (when show-unknown
+ (stgit-insert-ls-files '("--directory" "--no-empty-directory"
+ "--others")
+ "X"))
+ (sort-regexp-fields nil ":[^\0]*\0\\([^\0]*\\)\0" "\\1"
+ (point-min) (point-max)))
+
+ (stgit-process-files (lambda (file) (ewoc-enter-last ewoc file)))
+
+ (unless (ewoc-nth ewoc 0)
+ (ewoc-set-hf ewoc ""
+ (concat " "
+ (propertize "<no files>"
+ 'face 'stgit-description-face)
+ "\n")))))
+ (goto-char end)))
+
+(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))))
(unless (file-exists-p filename)
(error "File does not exist"))
- (find-file filename)))
+ (funcall (if other-window 'find-file-other-window 'find-file)
+ filename)
+ (when (eq (stgit-file->status file) 'unmerged)
+ (smerge-mode 1))))
+
+(defun stgit-expand (&optional patches collapse)
+ "Show the contents of marked patches, or the patch at point.
+
+See also `stgit-collapse'.
+
+Non-interactively, operate on PATCHES, and collapse instead of
+expand if COLLAPSE is not nil."
+ (interactive (list (stgit-patches-marked-or-at-point t)))
+ (stgit-assert-mode)
+ (let ((patches-diff (funcall (if collapse #'intersection #'set-difference)
+ patches stgit-expanded-patches)))
+ (setq stgit-expanded-patches
+ (if 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))
+ stgit-ewoc))
+ (move-to-column (stgit-goal-column)))
+
+(defun stgit-collapse (&optional patches)
+ "Hide the contents of marked patches, or the patch at point.
+
+See also `stgit-expand'."
+ (interactive (list (stgit-patches-marked-or-at-point t)))
+ (stgit-assert-mode)
+ (stgit-expand patches t))
(defun stgit-select-patch ()
(let ((patchname (stgit-patch-name-at-point)))
- (if (memq patchname stgit-expanded-patches)
- (setq stgit-expanded-patches (delq patchname stgit-expanded-patches))
- (setq stgit-expanded-patches (cons patchname stgit-expanded-patches)))
- (ewoc-invalidate stgit-ewoc (ewoc-locate 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))))))
+
+ (move-to-column (stgit-goal-column))
+
+ (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 ()
- "Expand or collapse the current entry"
+ "With point on a patch, toggle showing files in the patch.
+
+With point on a file, open the associated file. Opens the target
+file for (applied) copies and renames."
(interactive)
+ (stgit-assert-mode)
(case (get-text-property (point) 'entry-type)
('patch
(stgit-select-patch))
(defun stgit-find-file-other-window ()
"Open file at point in other window"
(interactive)
- (let ((patched-file (stgit-patched-file-at-point)))
- (unless patched-file
- (error "No file on the current line"))
- (let ((filename (expand-file-name (stgit-file-file patched-file))))
- (unless (file-exists-p filename)
- (error "File does not exist"))
- (find-file-other-window filename))))
+ (stgit-assert-mode)
+ (stgit-find-file t))
+
+(defun stgit-find-file-merge ()
+ "Open file at point and merge it using `smerge-ediff'."
+ (interactive)
+ (stgit-assert-mode)
+ (stgit-find-file t)
+ (smerge-ediff))
(defun stgit-quit ()
"Hide the stgit buffer."
(interactive)
+ (stgit-assert-mode)
(bury-buffer))
(defun stgit-git-status ()
"Show status using `git-status'."
(interactive)
+ (stgit-assert-mode)
(unless (fboundp 'git-status)
(error "The stgit-git-status command requires git-status"))
(let ((dir default-directory))
(defun stgit-next-line (&optional arg)
"Move cursor vertically down ARG lines"
(interactive "p")
+ (stgit-assert-mode)
(next-line arg)
(move-to-column (stgit-goal-column)))
(defun stgit-previous-line (&optional arg)
"Move cursor vertically up ARG lines"
(interactive "p")
+ (stgit-assert-mode)
(previous-line arg)
(move-to-column (stgit-goal-column)))
(defun stgit-next-patch (&optional arg)
"Move cursor down ARG patches."
(interactive "p")
+ (stgit-assert-mode)
(ewoc-goto-next stgit-ewoc (or arg 1))
(move-to-column goal-column))
(defun stgit-previous-patch (&optional arg)
"Move cursor up ARG patches."
(interactive "p")
+ (stgit-assert-mode)
(ewoc-goto-prev stgit-ewoc (or arg 1))
(move-to-column goal-column))
"Keymap for StGit major mode.")
(unless stgit-mode-map
- (let ((toggle-map (make-keymap)))
- (suppress-keymap toggle-map)
+ (let ((diff-map (make-sparse-keymap))
+ (toggle-map (make-sparse-keymap)))
+ (mapc (lambda (arg) (define-key diff-map (car arg) (cdr arg)))
+ '(("b" . stgit-diff-base)
+ ("c" . stgit-diff-combined)
+ ("m" . stgit-find-file-merge)
+ ("o" . stgit-diff-ours)
+ ("r" . stgit-diff-range)
+ ("t" . stgit-diff-theirs)))
(mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg)))
- '(("t" . stgit-toggle-worktree)))
+ '(("n" . stgit-toggle-patch-names)
+ ("t" . stgit-toggle-worktree)
+ ("h" . stgit-toggle-committed)
+ ("i" . stgit-toggle-ignored)
+ ("u" . stgit-toggle-unknown)))
(setq stgit-mode-map (make-keymap))
(suppress-keymap stgit-mode-map)
(mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg)))
- `((" " . stgit-mark)
- ("m" . stgit-mark)
+ `((" " . stgit-mark-down)
+ ("m" . stgit-mark-down)
("\d" . stgit-unmark-up)
("u" . stgit-unmark-down)
("?" . stgit-help)
("M" . stgit-move-patches)
("S" . stgit-squash)
("N" . stgit-new)
+ ("c" . stgit-new-and-refresh)
("\C-c\C-c" . stgit-commit)
("\C-c\C-u" . stgit-uncommit)
- ("U" . stgit-revert-file)
+ ("U" . stgit-revert)
("R" . stgit-resolve-file)
("\r" . stgit-select)
+ ("+" . stgit-expand)
+ ("-" . stgit-collapse)
("o" . stgit-find-file-other-window)
- ("i" . stgit-file-toggle-index)
+ ("i" . stgit-toggle-index)
(">" . stgit-push-next)
("<" . stgit-pop-next)
("P" . stgit-push-or-pop)
("G" . stgit-goto)
- ("=" . stgit-show)
+ ("=" . stgit-diff)
("D" . stgit-delete)
- ([(control ?/)] . stgit-undo)
+ ([?\C-/] . stgit-undo)
("\C-_" . stgit-undo)
+ ([?\C-c ?\C-/] . stgit-redo)
+ ("\C-c\C-_" . stgit-redo)
("B" . stgit-branch)
+ ("\C-c\C-b" . stgit-rebase)
("t" . ,toggle-map)
- ("q" . stgit-quit)))))
+ ("d" . ,diff-map)
+ ("q" . stgit-quit)
+ ("!" . stgit-execute))))
+
+ (let ((at-unmerged-file '(let ((file (stgit-patched-file-at-point)))
+ (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
+ "StGit Menu"
+ `("StGit"
+ ["Reload" stgit-reload-or-repair
+ :help "Reload StGit status from disk"]
+ ["Repair" stgit-repair
+ :keys "\\[universal-argument] \\[stgit-reload-or-repair]"
+ :help "Repair StGit metadata"]
+ "-"
+ ["Undo" stgit-undo t]
+ ["Redo" stgit-redo t]
+ "-"
+ ["Git status" stgit-git-status :active (fboundp 'git-status)]
+ "-"
+ ["New patch" stgit-new-and-refresh
+ :help "Create a new patch from changes in index or work tree"
+ :active (not (and (stgit-index-empty-p) (stgit-work-tree-empty-p)))]
+ ["New empty patch" stgit-new
+ :help "Create a new, empty patch"]
+ ["(Un)mark patch" stgit-toggle-mark
+ :label (if (memq (stgit-patch-name-at-point nil t)
+ stgit-marked-patches)
+ "Unmark patch" "Mark patch")
+ :active (stgit-patch-name-at-point nil t)]
+ ["Expand/collapse patch"
+ (let ((patches (stgit-patches-marked-or-at-point)))
+ (if (member-if ,patch-collapsed-p patches)
+ (stgit-expand patches)
+ (stgit-collapse patches)))
+ :label (if (member-if ,patch-collapsed-p
+ (stgit-patches-marked-or-at-point))
+ "Expand patches"
+ "Collapse patches")
+ :active (stgit-patches-marked-or-at-point)]
+ ["Edit patch" stgit-edit
+ :help "Edit patch comment"
+ :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 (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)]
+ "-"
+ ["Move patches" stgit-move-patches
+ :active stgit-marked-patches
+ :help "Move marked patch(es) to point"]
+ ["Squash patches" stgit-squash
+ :active (> (length stgit-marked-patches) 1)
+ :help "Merge marked patches into one"]
+ "-"
+ ["Refresh top patch" stgit-refresh
+ :active (not (and (stgit-index-empty-p) (stgit-work-tree-empty-p)))
+ :help "Refresh the top patch with changes in index or work tree"]
+ ["Refresh this patch" (stgit-refresh t)
+ :keys "\\[universal-argument] \\[stgit-refresh]"
+ :help "Refresh marked patch with changes in index or work tree"
+ :active (and (not (and (stgit-index-empty-p)
+ (stgit-work-tree-empty-p)))
+ (stgit-patch-name-at-point nil t))]
+ "-"
+ ["Find file" stgit-select
+ :active (eq (get-text-property (point) 'entry-type) 'file)]
+ ["Open file" stgit-find-file-other-window
+ :active (eq (get-text-property (point) 'entry-type) 'file)]
+ ["Toggle file index" stgit-toggle-index
+ :active (and (eq (get-text-property (point) 'entry-type) 'file)
+ (memq (stgit-patch-name-at-point) '(:work :index)))
+ :label (if (eq (stgit-patch-name-at-point) :work)
+ "Move change to index"
+ "Move change to work tree")]
+ "-"
+ ["Show diff" stgit-diff
+ :active (get-text-property (point) 'entry-type)]
+ ["Show diff for range of applied patches" stgit-diff-range
+ :active (= (length stgit-marked-patches) 1)]
+ ("Merge"
+ :active (stgit-git-index-unmerged-p)
+ ["Combined diff" stgit-diff-combined
+ :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
+ ["Diff against base" stgit-diff-base
+ :help "Show diff against the common base"
+ :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
+ ["Diff against ours" stgit-diff-ours
+ :help "Show diff against our branch"
+ :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
+ ["Diff against theirs" stgit-diff-theirs
+ :help "Show diff against their branch"
+ :active (memq (stgit-patch-name-at-point nil nil) '(:work :index))]
+ "-"
+ ["Interactive merge" stgit-find-file-merge
+ :help "Interactively merge the file"
+ :active ,at-unmerged-file]
+ ["Resolve file" stgit-resolve-file
+ :help "Mark file conflict as resolved"
+ :active ,at-unmerged-file]
+ )
+ "-"
+ ["Show index & work tree" stgit-toggle-worktree :style toggle
+ :selected stgit-show-worktree]
+ ["Show unknown files" stgit-toggle-unknown :style toggle
+ :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]
+ ["Show recent commits" stgit-toggle-committed :style toggle
+ :selected stgit-show-committed]
+ "-"
+ ["Switch branches" stgit-branch t
+ :help "Switch to or create another branch"]
+ ["Rebase branch" stgit-rebase t
+ :help "Rebase the current branch"]
+ ))))
+
+;; disable tool bar editing buttons
+(put 'stgit-mode 'mode-class 'special)
(defun stgit-mode ()
"Major mode for interacting with StGit.
-Commands:
-\\{stgit-mode-map}"
+
+Start StGit using \\[stgit].
+
+Basic commands:
+\\<stgit-mode-map>\
+\\[stgit-help] Show this help text
+\\[stgit-quit] Hide the StGit buffer
+\\[describe-bindings] Show all key bindings
+
+\\[stgit-reload-or-repair] Reload the StGit buffer
+\\[universal-argument] \\[stgit-reload-or-repair] Repair StGit metadata
+
+\\[stgit-undo] Undo most recent StGit operation
+\\[stgit-redo] Undo recent undo
+
+\\[stgit-git-status] Run `git-status' (if available)
+
+\\[stgit-execute] Run an stg shell command
+
+Movement commands:
+\\[stgit-previous-line] Move to previous line
+\\[stgit-next-line] Move to next line
+\\[stgit-previous-patch] Move to previous patch
+\\[stgit-next-patch] Move to next patch
+
+\\[stgit-mark-down] Mark patch and move down
+\\[stgit-unmark-up] Unmark patch and move up
+\\[stgit-unmark-down] Unmark patch and move down
+
+Commands for patches:
+\\[stgit-select] Toggle showing changed files in patch
+\\[stgit-refresh] Refresh patch with changes in index or work tree
+\\[stgit-diff] Show the patch log and diff
+
+\\[stgit-expand] Show changes in marked patches
+\\[stgit-collapse] Hide changes in marked patches
+
+\\[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)
+
+\\[stgit-revert] Revert all changes in index or work tree
+\\[stgit-toggle-index] Toggle all changes between index and work tree
+
+\\[stgit-push-next] Push next patch onto stack
+\\[stgit-pop-next] Pop current patch from stack
+\\[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 marked patches to point
+
+\\[stgit-commit] Commit patch(es)
+\\[stgit-uncommit] Uncommit patch(es)
+
+Commands for files:
+\\[stgit-select] Open the file in this window
+\\[stgit-find-file-other-window] Open the file in another window
+\\[stgit-diff] Show the file's diff
+
+\\[stgit-toggle-index] Toggle change between index and work tree
+\\[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-toggle-committed] Toggle showing recent commits
+
+Commands for diffs:
+\\[stgit-diff] Show diff of patch or file
+\\[stgit-diff-range] Show diff for range of patches
+\\[stgit-diff-base] Show diff against the merge base
+\\[stgit-diff-ours] Show diff against our branch
+\\[stgit-diff-theirs] Show diff against their branch
+
+ With one prefix argument (e.g., \\[universal-argument] \\[stgit-diff]), \
+ignore space changes.
+ With two prefix arguments (e.g., \\[universal-argument] \
+\\[universal-argument] \\[stgit-diff]), ignore all space changes.
+
+Commands for merge conflicts:
+\\[stgit-find-file-merge] Resolve conflicts using `smerge-ediff'
+\\[stgit-resolve-file] Mark unmerged file as resolved
+
+Commands for branches:
+\\[stgit-branch] Switch to or create another branch
+\\[stgit-rebase] Rebase the current branch
+
+Customization variables:
+`stgit-abbreviate-copies-and-renames'
+`stgit-default-show-ignored'
+`stgit-default-show-patch-names'
+`stgit-default-show-unknown'
+`stgit-default-show-worktree'
+`stgit-default-show-committed'
+`stgit-default-committed-count'
+`stgit-find-copies-harder'
+`stgit-show-worktree-mode'
+
+See also \\[customize-group] for the \"stgit\" group."
(kill-all-local-variables)
(buffer-disable-undo)
(setq mode-name "StGit"
major-mode 'stgit-mode
goal-column 2)
(use-local-map stgit-mode-map)
- (set (make-local-variable 'list-buffers-directory) default-directory)
- (set (make-local-variable 'stgit-marked-patches) nil)
- (set (make-local-variable 'stgit-expanded-patches) nil)
- (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)
+ (mapc (lambda (x) (set (make-local-variable (car x)) (cdr x)))
+ `((list-buffers-directory . ,default-directory)
+ (parse-sexp-lookup-properties . t)
+ (stgit-expanded-patches . (:work :index))
+ (stgit-index-node . nil)
+ (stgit-worktree-node . nil)
+ (stgit-marked-patches . nil)
+ (stgit-committed-count . ,stgit-default-committed-count)
+ (stgit-show-committed . ,stgit-default-show-committed)
+ (stgit-show-ignored . ,stgit-default-show-ignored)
+ (stgit-show-patch-names . ,stgit-default-show-patch-names)
+ (stgit-show-unknown . ,stgit-default-show-unknown)
+ (stgit-show-worktree . ,stgit-default-show-worktree)))
(set-variable 'truncate-lines 't)
- (add-hook 'after-save-hook 'stgit-update-saved-file)
+ (add-hook 'after-save-hook 'stgit-update-stgit-for-buffer)
+ (unless stgit-did-advise
+ (stgit-advise)
+ (setq stgit-did-advise t))
(run-hooks 'stgit-mode-hook))
-(defun stgit-update-saved-file ()
- (let* ((file (expand-file-name buffer-file-name))
- (dir (file-name-directory file))
- (gitdir (condition-case nil (git-get-top-dir dir)
- (error nil)))
+(defun stgit-advise-funlist (funlist)
+ "Add advice to the functions in FUNLIST so we can refresh the
+stgit buffers as the git status of files change."
+ (mapc (lambda (sym)
+ (when (fboundp sym)
+ (eval `(defadvice ,sym (after stgit-update-stgit-for-buffer)
+ (stgit-update-stgit-for-buffer t)))
+ (ad-activate sym)))
+ funlist))
+
+(defun stgit-advise ()
+ "Add advice to appropriate (non-stgit) git functions so we can
+refresh the stgit buffers as the git status of files change."
+ (mapc (lambda (arg)
+ (let ((feature (car arg))
+ (funlist (cdr arg)))
+ (if (featurep feature)
+ (stgit-advise-funlist funlist)
+ (add-to-list 'after-load-alist
+ `(,feature (stgit-advise-funlist
+ (quote ,funlist)))))))
+ ;; lists of (<feature> <function> <function> ...) to be advised
+ '((vc-git vc-git-rename-file vc-git-revert vc-git-register)
+ (git git-add-file git-checkout git-revert-file git-remove-file)
+ (dired dired-delete-file))))
+
+(defvar stgit-pending-refresh-buffers nil
+ "Alist of (cons `buffer' `refresh-index') of buffers that need
+to be refreshed. `refresh-index' is non-nil if both work tree
+and index need to be refreshed.")
+
+(defun stgit-run-pending-refreshs ()
+ "Run all pending stgit buffer updates as posted by `stgit-post-refresh'."
+ (let ((buffers stgit-pending-refresh-buffers)
+ (stgit-inhibit-messages t))
+ (setq stgit-pending-refresh-buffers nil)
+ (while buffers
+ (let* ((elem (car buffers))
+ (buffer (car elem))
+ (refresh-index (cdr elem)))
+ (when (buffer-name buffer)
+ (with-current-buffer buffer
+ (stgit-refresh-worktree)
+ (when refresh-index (stgit-refresh-index)))))
+ (setq buffers (cdr buffers)))))
+
+(defun stgit-post-refresh (buffer refresh-index)
+ "Update worktree status in BUFFER when Emacs becomes idle. If
+REFRESH-INDEX is non-nil, also update the index."
+ (unless stgit-pending-refresh-buffers
+ (run-with-idle-timer 0.1 nil 'stgit-run-pending-refreshs))
+ (let ((elem (assq buffer stgit-pending-refresh-buffers)))
+ (if elem
+ ;; if buffer is already present, set its refresh-index flag if
+ ;; necessary
+ (when refresh-index
+ (setcdr elem t))
+ ;; new entry
+ (setq stgit-pending-refresh-buffers
+ (cons (cons buffer refresh-index)
+ stgit-pending-refresh-buffers)))))
+
+(defun stgit-update-stgit-for-buffer (&optional refresh-index)
+ "When Emacs becomes idle, refresh worktree status in any
+`stgit-mode' buffer that shows the status of the current buffer.
+
+If REFRESH-INDEX is non-nil, also update the index."
+ (let* ((dir (cond ((derived-mode-p 'stgit-status-mode 'dired-mode)
+ default-directory)
+ (buffer-file-name
+ (file-name-directory
+ (expand-file-name buffer-file-name)))))
+ (gitdir (and dir (condition-case nil (git-get-top-dir dir)
+ (error nil))))
(buffer (and gitdir (stgit-find-buffer gitdir))))
(when buffer
- (with-current-buffer buffer
- (stgit-refresh-worktree)))))
+ (stgit-post-refresh buffer refresh-index))))
(defun stgit-add-mark (patchsym)
"Mark the patch PATCHSYM."
(defun stgit-patch-at-point (&optional cause-error)
(get-text-property (point) 'patch-data))
-(defun stgit-patch-name-at-point (&optional cause-error)
+(defun stgit-patch-name-at-point (&optional cause-error types)
"Return the patch name on the current line as a symbol.
-If CAUSE-ERROR is not nil, signal an error if none found."
+If CAUSE-ERROR is not nil, signal an error if none found.
+
+TYPES controls which types of commits and patches can be returned.
+If it is t, only allow stgit patches; if 'allow-committed, also
+allow historical commits; if nil, also allow work tree and index."
(let ((patch (stgit-patch-at-point)))
+ (and patch
+ (memq (stgit-patch->status patch)
+ (case types
+ ((nil) nil)
+ ((allow-committed) '(work index))
+ ((t) '(work index committed))
+ (t (error "Bad value"))))
+ (setq patch nil))
(cond (patch
- (stgit-patch-name patch))
+ (stgit-patch->name patch))
(cause-error
(error "No patch on this line")))))
(defun stgit-patched-file-at-point ()
(get-text-property (point) 'file-data))
-(defun stgit-patches-marked-or-at-point ()
- "Return the symbols of the marked patches, or the patch on the current line."
+(defun stgit-patches-marked-or-at-point (&optional cause-error types)
+ "Return the symbols of the marked patches, or the patch on the current line.
+If CAUSE-ERRROR is not nil, signal an error if none found.
+
+TYPES controls which types of commits and patches can be returned.
+If it is t, only allow stgit patches; if 'allow-committed, also
+allow historical commits; if nil, also allow work tree and index."
(if stgit-marked-patches
stgit-marked-patches
- (let ((patch (stgit-patch-name-at-point)))
- (if patch
- (list patch)
- '()))))
+ (let ((patch (stgit-patch-name-at-point nil types)))
+ (cond (patch (list patch))
+ (cause-error (error "No patches marked or at this line"))
+ (t nil)))))
-(defun stgit-goto-patch (patchsym)
+(defun stgit-goto-patch (patchsym &optional file)
"Move point to the line containing patch PATCHSYM.
-If that patch cannot be found, do nothing."
+If that patch cannot be found, do nothing.
+
+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)))
+ (file-node (ewoc-nth file-ewoc 0)))
+ (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)
+ (move-to-column (stgit-goal-column))
+ (setq node nil))))
(when node
(ewoc-goto-node stgit-ewoc node)
(move-to-column goal-column))))
(defun stgit-init ()
"Run stg init."
(interactive)
+ (stgit-assert-mode)
(stgit-capture-output nil
(stgit-run "init"))
(stgit-reload))
+(defun stgit-toggle-mark ()
+ "Toggle mark on the patch under point."
+ (interactive)
+ (stgit-assert-mode)
+ (if (memq (stgit-patch-name-at-point t t) stgit-marked-patches)
+ (stgit-unmark)
+ (stgit-mark)))
+
(defun stgit-mark ()
"Mark the patch under point."
(interactive)
+ (stgit-assert-mode)
(let* ((node (ewoc-locate stgit-ewoc))
(patch (ewoc-data node)))
- (stgit-add-mark (stgit-patch-name patch))
- (ewoc-invalidate stgit-ewoc node))
+ (case (stgit-patch->status patch)
+ (work (error "Cannot mark the work tree"))
+ (index (error "Cannot mark the index"))
+ (committed (error "Cannot mark a committed patch")))
+ (stgit-add-mark (stgit-patch->name patch))
+ (let ((column (current-column)))
+ (ewoc-invalidate stgit-ewoc node)
+ (move-to-column column))))
+
+(defun stgit-mark-down ()
+ "Mark the patch under point and move to the next patch."
+ (interactive)
+ (stgit-mark)
(stgit-next-patch))
+(defun stgit-unmark ()
+ "Remove mark from the patch on the current line."
+ (interactive)
+ (stgit-assert-mode)
+ (let* ((node (ewoc-locate stgit-ewoc))
+ (patch (ewoc-data node)))
+ (stgit-remove-mark (stgit-patch->name patch))
+ (let ((column (current-column)))
+ (ewoc-invalidate stgit-ewoc node)
+ (move-to-column column))))
+
(defun stgit-unmark-up ()
"Remove mark from the patch on the previous line."
(interactive)
+ (stgit-assert-mode)
(stgit-previous-patch)
- (let* ((node (ewoc-locate stgit-ewoc))
- (patch (ewoc-data node)))
- (stgit-remove-mark (stgit-patch-name patch))
- (ewoc-invalidate stgit-ewoc node))
- (move-to-column (stgit-goal-column)))
+ (stgit-unmark))
(defun stgit-unmark-down ()
"Remove mark from the patch on the current line."
(interactive)
- (let* ((node (ewoc-locate stgit-ewoc))
- (patch (ewoc-data node)))
- (stgit-remove-mark (stgit-patch-name patch))
- (ewoc-invalidate stgit-ewoc node))
+ (stgit-assert-mode)
+ (stgit-unmark)
(stgit-next-patch))
(defun stgit-rename (name)
"Rename the patch under point to NAME."
- (interactive (list (read-string "Patch name: "
- (symbol-name (stgit-patch-name-at-point t)))))
- (let ((old-patchsym (stgit-patch-name-at-point t)))
+ (interactive (list
+ (read-string "Patch name: "
+ (symbol-name (stgit-patch-name-at-point t t)))))
+ (stgit-assert-mode)
+ (let ((old-patchsym (stgit-patch-name-at-point t t)))
(stgit-capture-output nil
- (stgit-run "rename" old-patchsym name))
+ (stgit-run "rename" "--" old-patchsym name))
(let ((name-sym (intern name)))
(when (memq old-patchsym stgit-expanded-patches)
(setq stgit-expanded-patches
- (cons name-sym (delq old-patchsym stgit-expanded-patches))))
+ (cons name-sym (delq old-patchsym stgit-expanded-patches))))
(when (memq old-patchsym stgit-marked-patches)
(setq stgit-marked-patches
- (cons name-sym (delq old-patchsym stgit-marked-patches))))
+ (cons name-sym (delq old-patchsym stgit-marked-patches))))
(stgit-reload)
(stgit-goto-patch name-sym))))
With a prefix argument, repair the StGit metadata if the branch
was modified with git commands (`stgit-repair')."
(interactive "P")
+ (stgit-assert-mode)
(if repair
(stgit-repair)
(stgit-reload)))
(defun stgit-repair ()
"Run stg repair."
(interactive)
+ (stgit-assert-mode)
(stgit-capture-output nil
(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-capture-output nil (stgit-run "branch" "--" branch))
+ (stgit-assert-mode)
+ (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))
+ (let ((branch-point (completing-read
+ "Branch from (default current branch): "
+ (stgit-available-branches))))
+ (stgit-capture-output nil
+ (apply 'stgit-run
+ `("branch" "--create" "--"
+ ,branch
+ ,@(unless (zerop (length branch-point))
+ (list branch-point)))))
+ t)))
+ (stgit-reload)))
+
+(defun stgit-available-refs (&optional omit-stgit)
+ "Returns a list of the available git refs.
+If OMIT-STGIT is not nil, filter out \"resf/heads/*.stgit\"."
+ (let* ((output (with-output-to-string
+ (stgit-run-git-silent "for-each-ref" "--format=%(refname)"
+ "refs/tags" "refs/heads"
+ "refs/remotes")))
+ (result (split-string output "\n" t)))
+ (mapcar (lambda (s)
+ (if (string-match "^refs/\\(heads\\|tags\\|remotes\\)/" s)
+ (substring s (match-end 0))
+ s))
+ (if omit-stgit
+ (delete-if (lambda (s)
+ (string-match "^refs/heads/.*\\.stgit$" s))
+ 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 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)
+ nil nil
+ (stgit-parent-branch))))
+ (stgit-assert-mode)
+ (stgit-capture-output nil (stgit-run "rebase" "--" new-base))
(stgit-reload))
(defun stgit-commit (count)
"Run stg commit on COUNT commits.
-Interactively, the prefix argument is used as COUNT."
+Interactively, the prefix argument is used as COUNT.
+A negative COUNT will uncommit instead."
(interactive "p")
- (stgit-capture-output nil (stgit-run "commit" "-n" count))
- (stgit-reload))
+ (stgit-assert-mode)
+ (if (< count 0)
+ (stgit-uncommit (- count))
+ (stgit-capture-output nil (stgit-run "commit" "-n" count))
+ (stgit-reload)))
+
+(defun stgit-uncommit (count)
+ "Run stg uncommit on COUNT commits.
+Interactively, the prefix argument is used as COUNT.
+A negative COUNT will commit instead."
+ (interactive "p")
+ (stgit-assert-mode)
+ (if (< count 0)
+ (stgit-commit (- count))
+ (stgit-capture-output nil (stgit-run "uncommit" "-n" count))
+ (stgit-reload)))
+
+(defun stgit-neighbour-file ()
+ "Return the file name of the next file after point, or the
+previous file if point is at the last file within a patch."
+ (let ((old-point (point))
+ neighbour-file)
+ (and (zerop (forward-line 1))
+ (let ((f (stgit-patched-file-at-point)))
+ (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)))))
+ (goto-char old-point))
+ neighbour-file))
(defun stgit-revert-file ()
"Revert the file at point, which must be in the index or the
working tree."
(interactive)
+ (stgit-assert-mode)
(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))
(error "No index or working tree file on this line"))
+ (when (eq file-status 'ignore)
+ (error "Cannot revert ignored files"))
+
+ (when (eq file-status 'unknown)
+ (error "Cannot revert unknown files"))
+
(let ((nfiles (+ (if rm-file 1 0) (if co-file 1 0))))
(when (yes-or-no-p (format "Revert %d file%s? "
nfiles
(stgit-run-git "rm" "-f" "-q" "--" rm-file))
(when co-file
(stgit-run-git "checkout" "HEAD" co-file)))
- (stgit-reload)))))
+ (stgit-reload)
+ (stgit-goto-patch patch-name next-file)))))
+
+(defun stgit-revert ()
+ "Revert the change at point, which must be the index, the work
+tree, or a single change in either."
+ (interactive)
+ (stgit-assert-mode)
+ (let ((patched-file (stgit-patched-file-at-point)))
+ (if patched-file
+ (stgit-revert-file)
+ (let* ((patch-name (or (stgit-patch-name-at-point)
+ (error "No patch or file at point")))
+ (patch-desc (case patch-name
+ (:index "index")
+ (:work "work tree")
+ (t (error (substitute-command-keys
+ "Use \\[stgit-delete] to delete a patch"))))))
+ (when (if (eq patch-name :work)
+ (stgit-work-tree-empty-p)
+ (stgit-index-empty-p))
+ (error (format "There are no changes in the %s to revert"
+ patch-desc)))
+ (and (eq patch-name :index)
+ (not (stgit-work-tree-empty-p))
+ (error "Cannot revert index as work tree contains unstaged changes"))
+
+ (when (yes-or-no-p (format "Revert all changes in the %s? "
+ patch-desc))
+ (if (eq patch-name :index)
+ (stgit-run-git-silent "reset" "--hard" "-q")
+ (stgit-run-git-silent "checkout" "--" "."))
+ (stgit-refresh-index)
+ (stgit-refresh-worktree)
+ (stgit-goto-patch patch-name))))))
(defun stgit-resolve-file ()
"Resolve conflict in the file at point."
(interactive)
+ (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)))
-(defun stgit-uncommit (count)
- "Run stg uncommit on COUNT commits.
-Interactively, the prefix argument is used as COUNT."
- (interactive "p")
- (stgit-capture-output nil (stgit-run "uncommit" "-n" count))
- (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-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-capture-output nil (stgit-run "pop" "-n" npatches))
- (stgit-reload)
- (stgit-refresh-git-status))
+ (stgit-push-or-pop-patches nil npatches))
-(defun stgit-applied-at-point ()
- "Is the patch on the current line applied?"
- (save-excursion
- (beginning-of-line)
- (looking-at "[>+]")))
+(defun stgit-applied-patches (&optional only-patches)
+ "Return a list of the applied patches.
+
+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)))
+ nil)
+ 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)
- (let ((patchsym (stgit-patch-name-at-point t))
- (applied (stgit-applied-at-point)))
+ (stgit-assert-mode)
+ (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 at point: a patchsym, :top,
+or :bottom."
+ (let ((patch (stgit-patch-at-point)))
+ (cond (patch
+ (case (stgit-patch->status patch)
+ ((work index) nil)
+ ((committed) :bottom)
+ (t (stgit-patch->name patch))))
+ ((not (next-single-property-change (point) 'patch-data))
+ :top)
+ ((not (previous-single-property-change (point) 'patch-data))
+ :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)
- (let ((patchsym (stgit-patch-name-at-point t)))
- (stgit-capture-output nil
- (stgit-run "goto" patchsym))
- (stgit-reload)))
+ (stgit-assert-mode)
+ (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.
(if (keywordp patchsym)
patchsym
(let ((result (with-output-to-string
- (stgit-run-silent "id" patchsym))))
+ (stgit-run-silent "id" "--" patchsym))))
(unless (string-match "^\\([0-9A-Fa-f]\\{40\\}\\)$" result)
(error "Cannot find commit id for %s" patchsym))
(match-string 1 result))))
-(defun stgit-show ()
- "Show the patch on the current line."
- (interactive)
- (stgit-capture-output "*StGit patch*"
- (case (get-text-property (point) 'entry-type)
- ('file
- (let* ((patched-file (stgit-patched-file-at-point))
- (patch-name (stgit-patch-name-at-point))
- (patch-id (stgit-id patch-name))
- (args (append (and (stgit-file-cr-from patched-file)
- (list (stgit-find-copies-harder-diff-arg)))
- (cond ((eq patch-id :index)
- '("--cached"))
- ((eq patch-id :work)
- nil)
- (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))))))
- (apply 'stgit-run-git "diff" args)))
- ('patch
- (let* ((patch-name (stgit-patch-name-at-point))
- (patch-id (stgit-id patch-name)))
- (if (or (eq patch-id :index) (eq patch-id :work))
- (apply 'stgit-run-git "diff"
- (stgit-find-copies-harder-diff-arg)
- (and (eq patch-id :index)
- '("--cached")))
- (stgit-run "show" "-O" "--patch-with-stat" "-O" "-M"
- (stgit-patch-name-at-point)))))
- (t
- (error "No patch or file at point")))
- (with-current-buffer standard-output
- (goto-char (point-min))
- (diff-mode))))
+(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 (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)
+ ('file
+ (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)
+ 'unmerged))
+ :work
+ id)))
+ (args (append (and space-arg (list space-arg))
+ (and (stgit-file->cr-from patched-file)
+ (list (stgit-find-copies-harder-diff-arg)))
+ (cond ((eq patch-id :index)
+ '("--cached"))
+ ((eq patch-id :work)
+ (list unmerged-stage))
+ (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))))))
+ (apply 'stgit-run-git "diff" args)))
+ ('patch
+ (let* ((patch-id (stgit-id patch-name)))
+ (if (or (eq patch-id :index) (eq patch-id :work))
+ (apply 'stgit-run-git "diff"
+ (stgit-find-copies-harder-diff-arg)
+ (append (and space-arg (list space-arg))
+ (if (eq patch-id :index)
+ '("--cached")
+ (list unmerged-stage))))
+ (let ((args (append '("show" "-O" "--patch-with-stat" "-O" "-M")
+ (and space-arg (list "-O" space-arg))
+ '("--")
+ (list (stgit-patch-name-at-point)))))
+ (apply 'stgit-run args)))))
+ (t
+ (error "No patch or file at point")))
+ (with-current-buffer standard-output
+ (goto-char (point-min))
+ (diff-mode)))))
+
+(defmacro stgit-define-diff (name diff-arg &optional unmerged-action)
+ `(defun ,name (&optional ignore-whitespace)
+ ,(format "Show the patch on the current line.
+
+%sWith a prefix argument, ignore whitespace. With a prefix argument
+greater than four (e.g., \\[universal-argument] \
+\\[universal-argument] \\[%s]), ignore all whitespace."
+ (if unmerged-action
+ (format "For unmerged files, %s.\n\n" unmerged-action)
+ "")
+ name)
+ (interactive "p")
+ (stgit-assert-mode)
+ (stgit-show-patch ,diff-arg ignore-whitespace)))
+
+(stgit-define-diff stgit-diff
+ "--ours" nil)
+(stgit-define-diff stgit-diff-ours
+ "--ours"
+ "diff against our branch")
+(stgit-define-diff stgit-diff-theirs
+ "--theirs"
+ "diff against their branch")
+(stgit-define-diff stgit-diff-base
+ "--base"
+ "diff against the merge base")
+(stgit-define-diff stgit-diff-combined
+ "--cc"
+ "show a combined diff")
+
+(defun stgit-diff-range (&optional ignore-whitespace)
+ "Show diff for the range of patches between point and the marked patch.
+
+With a prefix argument, ignore whitespace. With a prefix argument
+greater than four (e.g., \\[universal-argument] \
+\\[universal-argument] \\[stgit-diff-range]), ignore all whitespace."
+ (interactive "p")
+ (stgit-assert-mode)
+ (unless (= (length stgit-marked-patches) 1)
+ (error "Need exactly one patch marked"))
+ (let* ((patches (stgit-sort-patches
+ (cons (stgit-patch-name-at-point t 'allow-committed)
+ stgit-marked-patches)
+ t))
+ (first-patch (car patches))
+ (second-patch (if (cdr patches) (cadr patches) first-patch))
+ (whitespace-arg (stgit-whitespace-diff-arg ignore-whitespace))
+ (applied (stgit-applied-patchsyms t)))
+ (unless (and (memq first-patch applied) (memq second-patch applied))
+ (error "Can only show diff range for applied patches"))
+ (stgit-capture-output (format "*StGit diff %s..%s*"
+ first-patch second-patch)
+ (apply 'stgit-run-git (append '("diff" "--patch-with-stat")
+ (and whitespace-arg (list whitespace-arg))
+ (list (format "%s^" (stgit-id first-patch))
+ (stgit-id second-patch))))
+ (with-current-buffer standard-output
+ (goto-char (point-min))
+ (diff-mode)))))
-(defun stgit-move-change-to-index (file)
- "Copies the workspace state of FILE to index, using git add or git rm"
+(defun stgit-move-change-to-index (file &optional force)
+ "Copies the work tree state of FILE to index, using git add or git rm.
+
+If FORCE is not nil, use --force."
(let ((op (if (or (file-exists-p file) (file-symlink-p file))
'("add") '("rm" "-q"))))
(stgit-capture-output "*git output*"
- (apply 'stgit-run-git (append op '("--") (list file))))))
+ (apply 'stgit-run-git (append op (and force '("--force"))
+ '("--") (list file))))))
(defun stgit-remove-change-from-index (file)
"Unstages the change in FILE from the index"
(stgit-capture-output "*git output*"
(stgit-run-git "reset" "-q" "--" file)))
+(defun stgit-git-index-unmerged-p ()
+ (let (result)
+ (with-output-to-string
+ (setq result (not (zerop (stgit-run-git-silent "diff-index" "--cached"
+ "--diff-filter=U"
+ "--quiet" "HEAD")))))
+ result))
+
(defun stgit-file-toggle-index ()
- "Move modified file in or out of the index."
+ "Move modified file in or out of the index.
+
+Leaves the point where it is, but moves the mark to where the
+file ended up. You can then jump to the file with \
+\\[exchange-point-and-mark]."
(interactive)
- (let ((patched-file (stgit-patched-file-at-point)))
- (unless patched-file
- (error "No file on the current line"))
- (when (eq (stgit-file-status patched-file) 'unmerged)
+ (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)))
+ (when (eq patched-status 'unmerged)
(error (substitute-command-keys "Use \\[stgit-resolve-file] to move an unmerged file to the index")))
- (let ((patch-name (stgit-patch-name-at-point)))
+ (let* ((patch (stgit-patch-at-point))
+ (patch-name (stgit-patch->name patch))
+ (mark-file (if (eq patched-status 'rename)
+ (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-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 in the working tree to index")))))
- (stgit-refresh-worktree)
- (stgit-refresh-index))
+ (error "Can only move files between working tree and index")))
+ (stgit-refresh-worktree)
+ (stgit-refresh-index)
+ (stgit-goto-patch (if (eq patch-name :index) :work :index) mark-file)
+ (push-mark nil t t)
+ (stgit-goto-patch patch-name point-file))))
+
+(defun stgit-toggle-index ()
+ "Move change in or out of the index.
+
+Works on index and work tree, as well as files in either.
+
+Leaves the point where it is, but moves the mark to where the
+file ended up. You can then jump to the file with \
+\\[exchange-point-and-mark]."
+ (interactive)
+ (stgit-assert-mode)
+ (if (stgit-patched-file-at-point)
+ (stgit-file-toggle-index)
+ (let ((patch-name (stgit-patch-name-at-point)))
+ (unless (memq patch-name '(:index :work))
+ (error "Can only move changes between working tree and index"))
+ (when (stgit-git-index-unmerged-p)
+ (error "Resolve unmerged changes with \\[stgit-resolve-file] first"))
+ (if (if (eq patch-name :index)
+ (stgit-index-empty-p)
+ (stgit-work-tree-empty-p))
+ (message "No changes to be moved")
+ (stgit-capture-output nil
+ (if (eq patch-name :work)
+ (stgit-run-git "add" "--update")
+ (stgit-run-git "reset" "--mixed" "-q")))
+ (stgit-refresh-worktree)
+ (stgit-refresh-index))
+ (stgit-goto-patch (if (eq patch-name :index) :work :index)))))
(defun stgit-edit ()
"Edit the patch on the current line."
(interactive)
- (let ((patchsym (stgit-patch-name-at-point t))
+ (stgit-assert-mode)
+ (let ((patchsym (stgit-patch-name-at-point t t))
(edit-buf (get-buffer-create "*StGit edit*"))
(dir default-directory))
(log-edit 'stgit-confirm-edit t nil edit-buf)
(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)
(let ((file (make-temp-file "stgit-edit-")))
(write-region (point-min) (point-max) file)
(stgit-capture-output nil
- (stgit-run "edit" "-f" file stgit-edit-patchsym))
+ (stgit-run "edit" "-f" file "--" stgit-edit-patchsym))
(with-current-buffer log-edit-parent-buffer
(stgit-reload))))
-(defun stgit-new (add-sign)
+(defun stgit-new (add-sign &optional refresh)
"Create a new patch.
With a prefix argument, include a \"Signed-off-by:\" line at the
end of the patch."
(interactive "P")
+ (stgit-assert-mode)
(let ((edit-buf (get-buffer-create "*StGit edit*"))
(dir default-directory))
(log-edit 'stgit-confirm-new t nil edit-buf)
(setq default-directory dir)
+ (set (make-local-variable 'stgit-refresh-after-new) refresh)
(when add-sign
(save-excursion
(let ((standard-output (current-buffer)))
(defun stgit-confirm-new ()
(interactive)
- (let ((file (make-temp-file "stgit-edit-")))
+ (let ((file (make-temp-file "stgit-edit-"))
+ (refresh stgit-refresh-after-new))
(write-region (point-min) (point-max) file)
(stgit-capture-output nil
(stgit-run "new" "-f" file))
(with-current-buffer log-edit-parent-buffer
- (stgit-reload))))
+ (if refresh
+ (stgit-refresh)
+ (stgit-reload)))))
+
+(defun stgit-new-and-refresh (add-sign)
+ "Create a new patch and refresh it with the current changes.
+
+With a prefix argument, include a \"Signed-off-by:\" line at the
+end of the patch.
+
+This works just like running `stgit-new' followed by `stgit-refresh'."
+ (interactive "P")
+ (stgit-assert-mode)
+ (stgit-new add-sign t))
(defun stgit-create-patch-name (description)
"Create a patch name from a long description"
With a prefix argument, or SPILL-P, spill the patch contents to
the work tree and index."
- (interactive (list (stgit-patches-marked-or-at-point)
+ (interactive (list (stgit-patches-marked-or-at-point t t)
current-prefix-arg))
+ (stgit-assert-mode)
(unless patchsyms
(error "No patches to delete"))
+ (when (memq :index patchsyms)
+ (error "Cannot delete the index"))
+ (when (memq :work patchsyms)
+ (error "Cannot delete the work tree"))
+
(let ((npatches (length patchsyms)))
(when (yes-or-no-p (format "Really delete %d patch%s%s? "
npatches
(if spill-p
" (spilling contents to index)"
"")))
- (let ((args (if spill-p
- (cons "--spill" patchsyms)
- patchsyms)))
+ (let ((args (append (when spill-p '("--spill"))
+ '("--")
+ patchsyms)))
(stgit-capture-output nil
(apply 'stgit-run "delete" args))
(stgit-reload)))))
"Return the patchsym indicating a target patch for
`stgit-move-patches'.
-This is either the patch at point, or one of :top and :bottom, if
-the point is after or before the applied patches."
-
- (let ((patchsym (stgit-patch-name-at-point)))
- (cond (patchsym patchsym)
- ((save-excursion (re-search-backward "^>" nil t)) :top)
- (t :bottom))))
+This is either the first unmarked patch at or after point, or one
+of :top and :bottom if the point is after or before the applied
+patches."
-(defun stgit-sort-patches (patchsyms)
+ (save-excursion
+ (let (result)
+ (while (not result)
+ (let ((patchsym (stgit-patch-name-at-point)))
+ (cond ((memq patchsym '(:work :index)) (setq result :top))
+ (patchsym (if (memq patchsym stgit-marked-patches)
+ (stgit-next-patch)
+ (setq result patchsym)))
+ ((re-search-backward "^>" nil t) (setq result :top))
+ (t (setq result :bottom)))))
+ result)))
+
+(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 may 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
(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))
Interactively, move the marked patches to where the point is."
(interactive (list stgit-marked-patches
(stgit-move-patches-target)))
+ (stgit-assert-mode)
(unless patchsyms
(error "Need at least one patch to move"))
(unless target-patch
(error "Point not at a patch"))
- (if (eq target-patch :top)
- (stgit-capture-output nil
- (apply 'stgit-run "float" patchsyms))
-
- ;; need to have patchsyms sorted by position in the stack
- (let ((sorted-patchsyms (stgit-sort-patches patchsyms)))
- (while sorted-patchsyms
- (setq sorted-patchsyms
- (and (stgit-capture-output nil
- (if (eq target-patch :bottom)
- (stgit-run "sink" "--" (car sorted-patchsyms))
- (stgit-run "sink" "--to" target-patch "--"
- (car sorted-patchsyms))))
- (cdr sorted-patchsyms))))))
+ ;; need to have patchsyms sorted by position in the stack
+ (let ((sorted-patchsyms (stgit-sort-patches patchsyms)))
+ (stgit-capture-output nil
+ (if (eq target-patch :top)
+ (apply 'stgit-run "float" "--" sorted-patchsyms)
+ (apply 'stgit-run
+ "sink"
+ (append (unless (eq target-patch :bottom)
+ (list "--to" target-patch))
+ '("--")
+ sorted-patchsyms)))))
(stgit-reload))
(defun stgit-squash (patchsyms)
one patch, which will occupy the same spot in the series as the
deepest patch had before the squash."
(interactive (list stgit-marked-patches))
+ (stgit-assert-mode)
(when (< (length patchsyms) 2)
(error "Need at least two patches to squash"))
(let ((stgit-buffer (current-buffer))
(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
(let ((file (make-temp-file "stgit-edit-")))
(write-region (point-min) (point-max) file)
(stgit-capture-output nil
- (apply 'stgit-run "squash" "-f" file stgit-patchsyms))
+ (apply 'stgit-run "squash" "-f" file "--" stgit-patchsyms))
(with-current-buffer log-edit-parent-buffer
(stgit-clear-marks)
;; Go to first marked patch and stay there
(interactive)
(describe-function 'stgit-mode))
+(defun stgit-execute-process-sentinel (process sentinel)
+ (let (old-sentinel stgit-buf)
+ (with-current-buffer (process-buffer process)
+ (setq old-sentinel old-process-sentinel
+ stgit-buf stgit-buffer))
+ (and (memq (process-status process) '(exit signal))
+ (buffer-live-p stgit-buf)
+ (with-current-buffer stgit-buf
+ (stgit-reload)))
+ (funcall old-sentinel process sentinel)))
+
+(defun stgit-execute-process-filter (process output)
+ (with-current-buffer (process-buffer process)
+ (let* ((old-point (point))
+ (pmark (process-mark process))
+ (insert-at (marker-position pmark))
+ (at-pmark (= insert-at old-point)))
+ (goto-char insert-at)
+ (insert-before-markers output)
+ (comint-carriage-motion insert-at (point))
+ (set-marker pmark (point))
+ (unless at-pmark
+ (goto-char old-point)))))
+
+(defun stgit-execute ()
+ "Prompt for an stg command to execute in a shell.
+
+The names of any marked patches or the patch at point are
+inserted in the command to be executed.
+
+If the command ends in an ampersand, run it asynchronously.
+
+When the command has finished, reload the stgit buffer."
+ (interactive)
+ (stgit-assert-mode)
+ (let* ((patches (stgit-patches-marked-or-at-point nil 'allow-committed))
+ (patch-names (mapcar 'symbol-name patches))
+ (hyphens (find-if (lambda (s) (string-match "^-" s)) patch-names))
+ (defaultcmd (if patches
+ (concat "stg "
+ (and hyphens "-- ")
+ (mapconcat 'identity patch-names " "))
+ "stg "))
+ (cmd (read-from-minibuffer "Shell command: " (cons defaultcmd 5)
+ nil nil 'shell-command-history))
+ (async (string-match "&[ \t]*\\'" cmd))
+ (buffer (get-buffer-create
+ (if async
+ "*Async Shell Command*"
+ "*Shell Command Output*"))))
+ ;; cannot use minibuffer as stgit-reload would overwrite it; if we
+ ;; show the buffer, shell-command will not use the minibuffer
+ (display-buffer buffer)
+ (shell-command cmd)
+ (if async
+ (let ((old-buffer (current-buffer)))
+ (with-current-buffer buffer
+ (let ((process (get-buffer-process buffer)))
+ (set (make-local-variable 'old-process-sentinel)
+ (process-sentinel process))
+ (set (make-local-variable 'stgit-buffer)
+ old-buffer)
+ (set-process-filter process 'stgit-execute-process-filter)
+ (set-process-sentinel process 'stgit-execute-process-sentinel))))
+ (with-current-buffer buffer
+ (comint-carriage-motion (point-min) (point-max)))
+ (shrink-window-if-larger-than-buffer (get-buffer-window buffer))
+ (stgit-reload))))
+
+(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."
+With prefix argument, run it with the --hard flag.
+
+See also `stgit-redo'."
(interactive "P")
- (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.
+With prefix argument, run it with the --hard flag.
+
+See also `stgit-undo'."
+ (interactive "P")
+ (stgit-undo-or-redo t arg))
(defun stgit-refresh (&optional arg)
"Run stg refresh.
With prefix argument, refresh the marked patch or the patch under point."
(interactive "P")
+ (stgit-assert-mode)
(let ((patchargs (if arg
- (let ((patches (stgit-patches-marked-or-at-point)))
- (cond ((null patches)
- (error "No patch to update"))
- ((> (length patches) 1)
- (error "Too many patches selected"))
- (t
- (cons "-p" patches))))
+ (let ((patches (stgit-patches-marked-or-at-point nil t)))
+ (when (> (length patches) 1)
+ (error "Too many patches marked"))
+ (cons "-p" patches))
nil)))
(unless (stgit-index-empty-p)
(setq patchargs (cons "--index" patchargs)))
(stgit-refresh-git-status))
(stgit-reload))
-(defcustom stgit-default-show-worktree
- nil
- "Set to non-nil to by default show the working tree in a new stgit buffer.
+(defvar stgit-show-worktree nil
+ "If nil, inhibit showing work tree and index in the stgit buffer.
-This value is used as the default value for `stgit-show-worktree'."
- :type 'boolean
- :group 'stgit)
+See also `stgit-show-worktree-mode'.")
-(defvar stgit-show-worktree nil
- "Show work tree and index in the stgit buffer.
+(defvar stgit-show-ignored nil
+ "If nil, inhibit showing files ignored by git.")
+
+(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.")
-See `stgit-default-show-worktree' for its default value.")
+(defvar stgit-show-committed nil
+ "If nil, inhibit showing recent commits.")
+
+(defvar stgit-committed-count nil
+ "The number of recent commits to show.")
(defun stgit-toggle-worktree (&optional arg)
"Toggle the visibility of the work tree.
-With arg, show the work tree if arg is positive.
+With ARG, show the work tree if ARG is positive.
+
+Its initial setting is controlled by `stgit-default-show-worktree'.
-Its initial setting is controlled by `stgit-default-show-worktree'."
+`stgit-show-worktree-mode' controls where on screen the index and
+work tree will show up."
(interactive)
+ (stgit-assert-mode)
(setq stgit-show-worktree
(if (numberp arg)
(> arg 0)
(not stgit-show-worktree)))
(stgit-reload))
+(defun stgit-toggle-ignored (&optional arg)
+ "Toggle the visibility of files ignored by git in the work
+tree. With ARG, show these files if ARG is positive.
+
+Its initial setting is controlled by `stgit-default-show-ignored'.
+
+Use \\[stgit-toggle-worktree] to show the work tree."
+ (interactive)
+ (stgit-assert-mode)
+ (setq stgit-show-ignored
+ (if (numberp arg)
+ (> arg 0)
+ (not stgit-show-ignored)))
+ (stgit-reload))
+
+(defun stgit-toggle-unknown (&optional arg)
+ "Toggle the visibility of files not registered with git in the
+work tree. With ARG, show these files if ARG is positive.
+
+Its initial setting is controlled by `stgit-default-show-unknown'.
+
+Use \\[stgit-toggle-worktree] to show the work tree."
+ (interactive)
+ (stgit-assert-mode)
+ (setq stgit-show-unknown
+ (if (numberp arg)
+ (> arg 0)
+ (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))
+
+(defun stgit-toggle-committed (&optional arg)
+ "Toggle the visibility of historical git commits.
+With ARG, set the number of commits to show to ARG, and disable
+them if ARG is zero.
+
+The initial setting is controlled by `stgit-default-show-committed'."
+ (interactive "P")
+ (stgit-assert-mode)
+ (if (null arg)
+ (setq stgit-show-committed (not stgit-show-committed))
+ (let ((n (prefix-numeric-value arg)))
+ (setq stgit-show-committed (> n 0))
+ (setq stgit-committed-count n)))
+ (stgit-reload))
+
(provide 'stgit)