(:work "Work Tree")
(t (symbol-name name)))))
+(defun stgit-insert-without-trailing-whitespace (text)
+ "Insert TEXT in buffer using `insert', without trailing whitespace.
+A newline is appended."
+ (unless (string-match "\\(.*?\\) *$" text)
+ (error))
+ (insert (match-string 1 text) ?\n))
+
(defun stgit-patch-pp (patch)
(let* ((status (stgit-patch->status patch))
(start (point))
?e (if (stgit-patch->empty patch) "(empty) " "")
?d (propertize (or (stgit-patch->desc patch) "")
'face 'stgit-description-face)
- ?D (propertize (or (stgit-patch->desc patch)
- (stgit-patch-display-name patch))
- 'face face))))
-
- (insert (format-spec fmt spec) "\n")
+ ?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))
(defvar stgit-index-node)
(defvar stgit-worktree-node)
+(defconst stgit-allowed-branch-name-re
+ ;; Disallow control characters, space, del, and "/:@^{}~" in
+ ;; "/"-separated parts; parts may not start with a period (.)
+ "^[^\0- ./:@^{}~\177][^\0- /:@^{}~\177]*\
+\\(/[^\0- ./:@^{}~\177][^\0- /:@^{}~\177]*\\)*$"
+ "Regular expression that (new) branch names must match.")
+
(defun stgit-refresh-index ()
(when stgit-index-node
(ewoc-invalidate (car stgit-index-node) (cdr stgit-index-node))))
stgit-marked-patches (intersection stgit-marked-patches
all-patchsyms))))
+(defun stgit-current-branch ()
+ "Return the name of the current branch."
+ (substring (with-output-to-string
+ (stgit-run-silent "branch"))
+ 0 -1))
+
(defun stgit-reload ()
"Update the contents of the StGit buffer."
(interactive)
(ewoc-filter stgit-ewoc #'(lambda (x) nil))
(ewoc-set-hf stgit-ewoc
(concat "Branch: "
- (propertize
- (substring (with-output-to-string
- (stgit-run-silent "branch"))
- 0 -1)
- 'face 'stgit-branch-name-face)
+ (propertize (stgit-current-branch)
+ 'face 'stgit-branch-name-face)
"\n\n")
(if stgit-show-worktree
"--"
(stgit-file->old-perm file)
(stgit-file->new-perm file))
'face 'stgit-description-face))))
- (insert (format-spec stgit-file-line-format spec) "\n")
+ (stgit-insert-without-trailing-whitespace
+ (format-spec stgit-file-line-format spec))
(add-text-properties start (point)
(list 'entry-type 'file
'file-data file))))
(insert ":0 0 0000000000000000000000000000000000000000 0000000000000000000000000000000000000000 " file-flag "\0")
(forward-char name-len)))))
+(defun stgit-process-files (callback)
+ (goto-char (point-min))
+ (when (looking-at "[0-9A-Fa-f]\\{40\\}\0")
+ (goto-char (match-end 0)))
+ (while (looking-at ":\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} ")
+ (let ((old-perm (string-to-number (match-string 1) 8))
+ (new-perm (string-to-number (match-string 2) 8)))
+ (goto-char (match-end 0))
+ (let ((file
+ (cond ((looking-at
+ "\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\0")
+ (let* ((patch-status (stgit-patch->status patch))
+ (file-subexp (if (eq patch-status 'unapplied)
+ 3
+ 4))
+ (file (match-string file-subexp)))
+ (make-stgit-file
+ :old-perm old-perm
+ :new-perm new-perm
+ :copy-or-rename t
+ :cr-score (string-to-number (match-string 2))
+ :cr-from (match-string 3)
+ :cr-to (match-string 4)
+ :status (stgit-file-status-code
+ (match-string 1))
+ :file file)))
+ ((looking-at "\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\0")
+ (make-stgit-file
+ :old-perm old-perm
+ :new-perm new-perm
+ :copy-or-rename nil
+ :cr-score nil
+ :cr-from nil
+ :cr-to nil
+ :status (stgit-file-status-code
+ (match-string 1))
+ :file (match-string 2))))))
+ (goto-char (match-end 0))
+ (funcall callback file)))))
+
+
(defun stgit-insert-patch-files (patch)
"Expand (show modification of) the patch PATCH after the line
at point."
(when stgit-show-ignored
(stgit-insert-ls-files '("--ignored" "--others") "I"))
(when stgit-show-unknown
- (stgit-insert-ls-files '("--others") "X"))
+ (stgit-insert-ls-files '("--directory" "--no-empty-directory"
+ "--others")
+ "X"))
(sort-regexp-fields nil ":[^\0]*\0\\([^\0]*\\)\0" "\\1"
(point-min) (point-max)))
- (goto-char (point-min))
- (unless (or (eobp) (memq patchsym '(:work :index)))
- (forward-char 41))
- (while (looking-at ":\\([0-7]+\\) \\([0-7]+\\) [0-9A-Fa-f]\\{40\\} [0-9A-Fa-f]\\{40\\} ")
- (let ((old-perm (string-to-number (match-string 1) 8))
- (new-perm (string-to-number (match-string 2) 8)))
- (goto-char (match-end 0))
- (let ((file
- (cond ((looking-at
- "\\([CR]\\)\\([0-9]*\\)\0\\([^\0]*\\)\0\\([^\0]*\\)\0")
- (let* ((patch-status (stgit-patch->status patch))
- (file-subexp (if (eq patch-status 'unapplied)
- 3
- 4))
- (file (match-string file-subexp)))
- (make-stgit-file
- :old-perm old-perm
- :new-perm new-perm
- :copy-or-rename t
- :cr-score (string-to-number (match-string 2))
- :cr-from (match-string 3)
- :cr-to (match-string 4)
- :status (stgit-file-status-code
- (match-string 1))
- :file file)))
- ((looking-at "\\([ABD-QS-Z]\\)\0\\([^\0]*\\)\0")
- (make-stgit-file
- :old-perm old-perm
- :new-perm new-perm
- :copy-or-rename nil
- :cr-score nil
- :cr-from nil
- :cr-to nil
- :status (stgit-file-status-code
- (match-string 1))
- :file (match-string 2))))))
- (goto-char (match-end 0))
- (ewoc-enter-last ewoc file))))
+ (stgit-process-files (lambda (file) (ewoc-enter-last ewoc file)))
(unless (ewoc-nth ewoc 0)
(ewoc-set-hf ewoc ""
(stgit-expand (list patchname)
(memq patchname stgit-expanded-patches))))
+(defun stgit-expand-directory (file)
+ (let* ((patch (stgit-patch-at-point))
+ (ewoc (stgit-patch->files-ewoc patch))
+ (node (ewoc-locate ewoc))
+ (filename (stgit-file->file file))
+ (start (make-marker))
+ (end (make-marker)))
+
+ (save-excursion
+ (forward-line 1)
+ (set-marker start (point))
+ (set-marker end (point))
+ (set-marker-insertion-type end t))
+
+ (assert (string-match "/$" filename))
+ ;; remove trailing "/"
+ (setf (stgit-file->file file) (substring filename 0 -1))
+ (ewoc-invalidate ewoc node)
+
+ (with-temp-buffer
+ (let ((standard-output (current-buffer)))
+ (stgit-insert-ls-files (list "--directory" "--others"
+ "--no-empty-directory" "--"
+ filename)
+ "X")
+ (stgit-process-files (lambda (f)
+ (setq node (ewoc-enter-after ewoc node f))))))
+
+ (let ((inhibit-read-only t))
+ (put-text-property start end 'patch-data patch))))
+
+(defun stgit-select-file ()
+ (let* ((file (or (stgit-patched-file-at-point)
+ (error "No file at point")))
+ (filename (stgit-file->file file)))
+ (if (string-match "/$" filename)
+ (stgit-expand-directory file)
+ (stgit-find-file))))
+
(defun stgit-select ()
"With point on a patch, toggle showing files in the patch.
('patch
(stgit-select-patch))
('file
- (stgit-find-file))
+ (stgit-select-file))
(t
(error "No patch or file on line"))))
("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)))
"-"
["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-patch-names]
"-"
["Switch branches" stgit-branch t
- :help "Switch to another branch"]
+ :help "Switch to or create another branch"]
["Rebase branch" stgit-rebase t
:help "Rebase the current branch"]
))))
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
\\[stgit-resolve-file] Mark unmerged file as resolved
Commands for branches:
-\\[stgit-branch] Switch to another branch
+\\[stgit-branch] Switch to or create another branch
\\[stgit-rebase] Rebase the current branch
Customization variables:
(stgit-run "repair"))
(stgit-reload))
-(defun stgit-available-branches ()
- "Returns a list of the available stg branches"
+(defun stgit-available-branches (&optional all)
+ "Returns a list of the names of the available stg branches as strings.
+
+If ALL is not nil, also return non-stgit branches."
(let ((output (with-output-to-string
(stgit-run "branch" "--list")))
+ (pattern (format "^>?\\s-+%c\\s-+\\(\\S-+\\)"
+ (if all ?. ?s)))
(start 0)
result)
- (while (string-match "^>?\\s-+s\\s-+\\(\\S-+\\)" output start)
+ (while (string-match pattern output start)
(setq result (cons (match-string 1 output) result))
(setq start (match-end 0)))
result))
(defun stgit-branch (branch)
- "Switch to branch BRANCH."
+ "Switch to or create branch BRANCH."
(interactive (list (completing-read "Switch to branch: "
(stgit-available-branches))))
(stgit-assert-mode)
- (stgit-capture-output nil (stgit-run "branch" "--" branch))
- (stgit-reload))
+ (when (cond ((equal branch (stgit-current-branch))
+ (error "Branch is already current"))
+ ((member branch (stgit-available-branches t))
+ (stgit-capture-output nil (stgit-run "branch" "--" branch))
+ t)
+ ((not (string-match stgit-allowed-branch-name-re branch))
+ (error "Invalid branch name"))
+ ((yes-or-no-p (format "Create branch \"%s\"? " branch))
+ (stgit-capture-output nil (stgit-run "branch" "--create" "--"
+ branch))
+ t))
+ (stgit-reload)))
(defun stgit-available-refs (&optional omit-stgit)
"Returns a list of the available git refs.
result)
result))))
+(defun stgit-parent-branch ()
+ "Return the parent branch of the current stg branch as per
+git-config setting branch.<branch>.stgit.parentbranch."
+ (let ((output (with-output-to-string
+ (stgit-run-git-silent "config"
+ (format "branch.%s.stgit.parentbranch"
+ (stgit-current-branch))))))
+ (when (string-match ".*" output)
+ (match-string 0 output))))
+
(defun stgit-rebase (new-base)
- "Rebase to NEW-BASE."
+ "Rebase the current branch to NEW-BASE.
+
+Interactively, first ask which branch to rebase to. Defaults to
+what git-config branch.<branch>.stgit.parentbranch is set to."
(interactive (list (completing-read "Rebase to: "
- (stgit-available-refs t))))
+ (stgit-available-refs t)
+ nil nil
+ (stgit-parent-branch))))
(stgit-assert-mode)
(stgit-capture-output nil (stgit-run "rebase" new-base))
(stgit-reload))
(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.
(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.
(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)
"--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.
(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))
(interactive)
(describe-function 'stgit-mode))
+(defun stgit-undo-or-redo (redo hard)
+ "Run stg undo or, if REDO is non-nil, stg redo.
+
+If HARD is non-nil, use the --hard flag."
+ (stgit-assert-mode)
+ (let ((cmd (if redo "redo" "undo")))
+ (stgit-capture-output nil
+ (if arg
+ (when (or (and (stgit-index-empty-p)
+ (stgit-work-tree-empty-p))
+ (y-or-n-p (format "Hard %s may overwrite index/work tree changes. Continue? "
+ cmd)))
+ (stgit-run cmd "--hard"))
+ (stgit-run cmd))))
+ (stgit-reload))
+
(defun stgit-undo (&optional arg)
"Run stg undo.
With prefix argument, run it with the --hard flag.
See also `stgit-redo'."
(interactive "P")
- (stgit-assert-mode)
- (stgit-capture-output nil
- (if arg
- (stgit-run "undo" "--hard")
- (stgit-run "undo")))
- (stgit-reload))
+ (stgit-undo-or-redo nil arg))
(defun stgit-redo (&optional arg)
"Run stg redo.
See also `stgit-undo'."
(interactive "P")
- (stgit-assert-mode)
- (stgit-capture-output nil
- (if arg
- (stgit-run "redo" "--hard")
- (stgit-run "redo")))
- (stgit-reload))
+ (stgit-undo-or-redo t arg))
(defun stgit-refresh (&optional arg)
"Run stg refresh.