(require 'git nil t)
(require 'cl)
+(require 'comint)
(require 'ewoc)
(require 'easymenu)
(require 'format-spec)
(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."
+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.
(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].
+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."
+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))
"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")))
(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 (if stgit-show-patch-names
- stgit-patch-line-format
- stgit-noname-patch-line-format))
+ (fmt (stgit-line-format))
(spec (format-spec-make
?s (case status
('applied "+")
(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.
(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 (.)
(defun stgit-run-series (ewoc)
(setq stgit-index-node nil
stgit-worktree-node nil)
- (let ((inserted-index (not stgit-show-worktree))
- index-node
- worktree-node
- all-patchsyms)
- (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))))
+ (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))))
+ (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."
shows the working tree\n")
'face 'stgit-description-face)))
(stgit-run-series stgit-ewoc)
- (if curpatch
- (stgit-goto-patch curpatch (and curfile (stgit-file->file curfile)))
+ (unless (and curpatch
+ (stgit-goto-patch curpatch
+ (and curfile (stgit-file->file curfile))))
(goto-line curline)))
(stgit-refresh-git-status))
'((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-insert-patch-files (patch)
"Expand (show modification of) the patch PATCH after the line
at point."
- (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)))
+ (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
(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"))
`("diff-tree" ,@args "-r" ,(stgit-id patchsym)))))
(when (and (eq patchsym :work))
- (when stgit-show-ignored
+ (when show-ignored
(stgit-insert-ls-files '("--ignored" "--others") "I"))
- (when stgit-show-unknown
+ (when show-unknown
(stgit-insert-ls-files '("--directory" "--no-empty-directory"
"--others")
"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))))
(unless stgit-mode-map
(let ((diff-map (make-sparse-keymap))
(toggle-map (make-sparse-keymap)))
- (suppress-keymap diff-map)
(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)))
- (suppress-keymap toggle-map)
(mapc (lambda (arg) (define-key toggle-map (car arg) (cdr arg)))
'(("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))
("\C-c\C-b" . stgit-rebase)
("t" . ,toggle-map)
("d" . ,diff-map)
- ("q" . stgit-quit))))
+ ("q" . stgit-quit)
+ ("!" . stgit-execute))))
(let ((at-unmerged-file '(let ((file (stgit-patched-file-at-point)))
(and file (eq (stgit-file->status file)
"-"
["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
: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"]
\\[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-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
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'
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) (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)
- (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ (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 only-patches)
+(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 ONLY-PATCHES is not nil, only allow real patches, and not
-index or work tree."
+
+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
- only-patches
- (memq (stgit-patch->status patch) '(work index))
+ (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))
(defun stgit-patched-file-at-point ()
(get-text-property (point) 'file-data))
-(defun stgit-patches-marked-or-at-point (&optional cause-error only-patches)
+(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.
-If ONLY-PATCHES is not nil, do not include index or work tree."
+
+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 nil only-patches)))
+ (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 &optional file)
- "Move point to the line containing patch PATCHSYM.
-If that patch cannot be found, do nothing.
+ "Move point to the line containing patch PATCHSYM and return non-nil.
+If that patch cannot be found, do nothing and return nil.
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
(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)))
+ (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)
(interactive)
(stgit-assert-mode)
(let* ((node (ewoc-locate stgit-ewoc))
- (patch (ewoc-data node))
- (name (stgit-patch->name patch)))
- (when (eq name :work)
- (error "Cannot mark the work tree"))
- (when (eq name :index)
- (error "Cannot mark the index"))
+ (patch (ewoc-data 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)
(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
((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))
+ (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)
nil nil
(stgit-parent-branch))))
(stgit-assert-mode)
- (stgit-capture-output nil (stgit-run "rebase" new-base))
+ (stgit-capture-output nil (stgit-run "rebase" "--" new-base))
(stgit-reload))
(defun stgit-commit (count)
'(applied top)
'(applied top index work)))
result)
- (ewoc-map (lambda (patch) (when (memq (stgit-patch->status patch) states)
- (setq result (cons patch result))))
+ (ewoc-map (lambda (patch)
+ (when (memq (stgit-patch->status patch) states)
+ (setq result (cons patch result)))
+ nil)
stgit-ewoc)
result))
(stgit-reload))
(defun stgit-goto-target ()
- "Return the goto target a point; either a patchsym, :top,
+ "Return the goto target at point: a patchsym, :top,
or :bottom."
- (let ((patchsym (stgit-patch-name-at-point)))
- (cond ((memq patchsym '(:work :index)) nil)
- (patchsym)
+ (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))
(: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-run "goto" "--" patchsym))
(stgit-reload)))))
(defun stgit-id (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))))
(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
"--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 &optional force)
"Copies the work tree state of FILE to index, using git add or git rm.
(setq default-directory dir)
(let ((standard-output edit-buf))
(save-excursion
- (stgit-run-silent "edit" "--save-template=-" patchsym)))))
+ (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))))
(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)))))
(t (setq result :bottom)))))
result)))
-(defun stgit-sort-patches (patchsyms)
+(defun stgit-sort-patches (patchsyms &optional allow-duplicates)
"Returns the list of patches in PATCHSYMS sorted according to
their position in the patch series, bottommost first.
-PATCHSYMS must not contain duplicate entries."
+PATCHSYMS must not contain duplicate entries, unless
+ALLOW-DUPLICATES is not nil."
(let (sorted-patchsyms
(series (with-output-to-string
(with-current-buffer standard-output
(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))
(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 "float" "--" sorted-patchsyms)
(apply 'stgit-run
"sink"
(append (unless (eq target-patch :bottom)
(let ((result (let ((standard-output edit-buf))
(save-excursion
(apply 'stgit-run-silent "squash"
- "--save-template=-" sorted-patchsyms)))))
+ "--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.
(defvar stgit-show-patch-names t
"If nil, inhibit showing patch names.")
+(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.
"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)
"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)
(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)
~mdw / stgit / blobdiff