(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 the
+this setting in an already-started StGit buffer."
:type 'boolean
:group 'stgit
:link '(variable-link stgit-show-worktree))
?e (if (stgit-patch->empty patch) "(empty) " "")
?d (propertize (or (stgit-patch->desc patch) "")
'face 'stgit-description-face)
- ?D (propertize (or (stgit-patch->desc patch)
- (stgit-patch-display-name patch))
+ ?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)))
(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 (.)
(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"))
(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)
("\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
\\[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
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
(set (make-local-variable 'stgit-worktree-node) nil)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
(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)))))))
+ '((vc-git vc-git-rename-file vc-git-revert vc-git-register)
+ (git git-add-file git-checkout git-revert-file git-remove-file))))
+
+(defun stgit-update-stgit-for-buffer (&optional refresh-index)
+ "Refresh worktree status in any `stgit-mode' buffer that shows
+the status of the current buffer.
+
+If REFRESH-INDEX is not-nil, also update the index."
+ (let* ((dir (cond ((eq major-mode 'git-status-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-refresh-worktree)
+ (when refresh-index (stgit-refresh-index))))))
(defun stgit-add-mark (patchsym)
"Mark the patch PATCHSYM."
(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)
(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
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)
(stgit-reload)))
+(defun stgit-push-or-pop-patches (do-push npatches)
+ "Push (if DO-PUSH is not nil) or pop (if DO-PUSH is nil)
+NPATCHES patches, or all patches if NPATCHES is t."
+ (stgit-assert-mode)
+ (stgit-capture-output nil
+ (apply 'stgit-run
+ (if do-push "push" "pop")
+ (if (eq npatches t)
+ '("--all")
+ (list "-n" npatches))))
+ (stgit-reload)
+ (stgit-refresh-git-status))
+
(defun stgit-push-next (npatches)
"Push the first unapplied patch.
With numeric prefix argument, push that many patches."
(interactive "p")
- (stgit-assert-mode)
- (stgit-capture-output nil (stgit-run "push" "-n" npatches))
- (stgit-reload)
- (stgit-refresh-git-status))
+ (stgit-push-or-pop-patches t npatches))
(defun stgit-pop-next (npatches)
"Pop the topmost applied patch.
-With numeric prefix argument, pop that many patches."
+With numeric prefix argument, pop that many patches.
+
+If NPATCHES is t, pop all patches."
(interactive "p")
- (stgit-assert-mode)
- (stgit-capture-output nil (stgit-run "pop" "-n" npatches))
- (stgit-reload)
- (stgit-refresh-git-status))
+ (stgit-push-or-pop-patches nil npatches))
(defun stgit-applied-patches (&optional only-patches)
"Return a list of the applied patches.
'(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-sort-patches (if unapplied unapplied patchsyms)))))
(stgit-reload))
+(defun stgit-goto-target ()
+ "Return the goto target a point; either a patchsym, :top,
+or :bottom."
+ (let ((patchsym (stgit-patch-name-at-point)))
+ (cond ((memq patchsym '(:work :index)) nil)
+ (patchsym)
+ ((not (next-single-property-change (point) 'patch-data))
+ :top)
+ ((not (previous-single-property-change (point) 'patch-data))
+ :bottom))))
+
(defun stgit-goto ()
"Go to the patch on the current line.
-Pops or pushes patches to make this patch topmost."
+Push or pop patches to make this patch topmost. Push or pop all
+patches if used on a line after or before all patches."
(interactive)
(stgit-assert-mode)
- (let ((patchsym (stgit-patch-name-at-point t)))
- (stgit-capture-output nil
- (stgit-run "goto" patchsym))
- (stgit-reload)))
+ (let ((patchsym (stgit-goto-target)))
+ (unless patchsym
+ (error "No patch to go to on this line"))
+ (case patchsym
+ (:top (stgit-push-or-pop-patches t t))
+ (:bottom (stgit-push-or-pop-patches nil t))
+ (t (stgit-capture-output nil
+ (stgit-run "goto" "--" patchsym))
+ (stgit-reload)))))
(defun stgit-id (patchsym)
"Return the git commit id for PATCHSYM.
(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-whitespace-diff-arg (arg)
+ (when (numberp arg)
+ (cond ((> arg 4) "--ignore-all-space")
+ ((> arg 1) "--ignore-space-change"))))
+
(defun stgit-show-patch (unmerged-stage ignore-whitespace)
"Show the patch on the current line.
UNMERGED-STAGE is the argument to `git-diff' that that selects
which stage to diff against in the case of unmerged files."
- (let ((space-arg (when (numberp ignore-whitespace)
- (cond ((> ignore-whitespace 4)
- "--ignore-all-space")
- ((> ignore-whitespace 1)
- "--ignore-space-change"))))
+ (let ((space-arg (stgit-whitespace-diff-arg ignore-whitespace))
(patch-name (stgit-patch-name-at-point t)))
(stgit-capture-output "*StGit patch*"
(case (get-text-property (point) 'entry-type)
(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 t)
+ 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 ()
+ "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 t))
+ (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-sentinel process 'stgit-execute-process-sentinel))))
+ (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.