X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/7f972e9b1e84a63547d97386ec3f1d0f89110e87..e02b46e5ea0322466681fab18f62caf5515dbabd:/contrib/stgit.el diff --git a/contrib/stgit.el b/contrib/stgit.el index 1352af2..73c8e4b 100644 --- a/contrib/stgit.el +++ b/contrib/stgit.el @@ -262,6 +262,13 @@ directory DIR or `default-directory'" (: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)) @@ -284,11 +291,14 @@ directory DIR or `default-directory'" ?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)) @@ -373,6 +383,13 @@ Returns nil if there was no output." (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)))) @@ -448,6 +465,12 @@ Returns nil if there was no output." 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) @@ -459,11 +482,8 @@ Returns nil if there was no output." (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 "--" @@ -641,7 +661,8 @@ Cf. `stgit-file-type-change-string'." (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)))) @@ -919,6 +940,7 @@ file for (applied) copies and renames." ("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))) @@ -1056,6 +1078,8 @@ file for (applied) copies and renames." "-" ["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 @@ -1088,7 +1112,7 @@ file for (applied) copies and renames." :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"] )))) @@ -1170,6 +1194,7 @@ Display commands: 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 @@ -1184,7 +1209,7 @@ Commands for merge conflicts: \\[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: @@ -1393,24 +1418,38 @@ was modified with git commands (`stgit-repair')." (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. @@ -1430,10 +1469,25 @@ If OMIT-STGIT is not nil, filter out \"resf/heads/*.stgit\"." result) result)))) +(defun stgit-parent-branch () + "Return the parent branch of the current stg branch as per +git-config setting 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..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)) @@ -1569,23 +1623,32 @@ tree, or a single change in either." (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. @@ -1620,16 +1683,33 @@ If ONLY-PATCHES is not nil, exclude index and work tree." (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. @@ -1642,16 +1722,17 @@ If PATCHSYM is a keyword, returns PATCHSYM unmodified." (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) @@ -1727,6 +1808,35 @@ greater than four (e.g., \\[universal-argument] \ "--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. @@ -1945,11 +2055,12 @@ patches." (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 @@ -1962,8 +2073,9 @@ PATCHSYMS must not contain duplicate entries." (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)) @@ -2050,18 +2162,29 @@ deepest patch had before the squash." (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. @@ -2069,12 +2192,7 @@ With prefix argument, run it with the --hard flag. 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.