X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/9d04c6572d9cc04761859acbef060d7c9300ff83..5ab0897e67b0203470690a11885b61ca1cb4ab8a:/contrib/stgit.el diff --git a/contrib/stgit.el b/contrib/stgit.el index 27b1744..7ab17a9 100644 --- a/contrib/stgit.el +++ b/contrib/stgit.el @@ -15,6 +15,7 @@ (require 'git nil t) (require 'cl) (require 'ewoc) +(require 'easymenu) (defun stgit (dir) "Manage StGit patches for the tree in DIR. @@ -676,13 +677,13 @@ at point." (smerge-mode 1)))) (defun stgit-expand (&optional patches collapse) - "Show the contents selected patches, or the patch at point. + "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))) + (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))) @@ -696,10 +697,10 @@ expand if COLLAPSE is not nil." (move-to-column (stgit-goal-column))) (defun stgit-collapse (&optional patches) - "Hide the contents selected patches, or the patch at point. + "Hide the contents of marked patches, or the patch at point. See also `stgit-expand'." - (interactive (list (stgit-patches-marked-or-at-point))) + (interactive (list (stgit-patches-marked-or-at-point t))) (stgit-assert-mode) (stgit-expand patches t)) @@ -795,8 +796,8 @@ file for (applied) copies and renames." "Keymap for StGit major mode.") (unless stgit-mode-map - (let ((diff-map (make-keymap)) - (toggle-map (make-keymap))) + (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) @@ -812,8 +813,8 @@ file for (applied) copies and renames." (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) @@ -858,7 +859,124 @@ file for (applied) copies and renames." ("\C-c\C-b" . stgit-rebase) ("t" . ,toggle-map) ("d" . ,diff-map) - ("q" . stgit-quit))))) + ("q" . stgit-quit)))) + + (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)] + ("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] + "-" + ["Switch branches" stgit-branch t + :help "Switch to 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. @@ -885,7 +1003,7 @@ Movement commands: \\[stgit-previous-patch] Move to previous patch \\[stgit-next-patch] Move to next patch -\\[stgit-mark] Mark 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 @@ -894,11 +1012,12 @@ Commands for patches: \\[stgit-refresh] Refresh patch with changes in index or work tree \\[stgit-diff] Show the patch log and diff -\\[stgit-expand] Show changes in selected patches -\\[stgit-collapse] Hide changes in selected patches +\\[stgit-expand] Show changes in marked patches +\\[stgit-collapse] Hide changes in marked patches -\\[stgit-new] Create a new, empty patch \\[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) @@ -908,11 +1027,11 @@ Commands for patches: \\[stgit-push-next] Push next patch onto stack \\[stgit-pop-next] Pop current patch from stack -\\[stgit-push-or-pop] Push or pop patch at point -\\[stgit-goto] Make current patch current by popping or pushing +\\[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 patch(es) to point +\\[stgit-move-patches] Move marked patches to point \\[stgit-commit] Commit patch(es) \\[stgit-uncommit] Uncommit patch(es) @@ -1016,14 +1135,16 @@ index or work tree." (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 only-patches) + "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." (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 only-patches))) + (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. @@ -1057,6 +1178,14 @@ PATCHSYM." (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) @@ -1069,28 +1198,39 @@ PATCHSYM." (when (eq name :index) (error "Cannot mark the index")) (stgit-add-mark (stgit-patch-name patch)) - (ewoc-invalidate stgit-ewoc node)) + (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-up () - "Remove mark from the patch on the previous line." +(defun stgit-unmark () + "Remove mark from the patch on the current 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))) + (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) + (stgit-unmark)) (defun stgit-unmark-down () "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)) - (ewoc-invalidate stgit-ewoc node)) + (stgit-unmark) (stgit-next-patch)) (defun stgit-rename (name) @@ -1325,20 +1465,38 @@ With numeric prefix argument, pop that many patches." (stgit-reload) (stgit-refresh-git-status)) -(defun stgit-applied-at-point-p () - "Return non-nil if the patch at point is applied." - (let ((patch (stgit-patch-at-point t))) - (not (eq (stgit-patch-status patch) 'unapplied)))) +(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)))) + 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) (stgit-assert-mode) - (let ((patchsym (stgit-patch-name-at-point t t)) - (applied (stgit-applied-at-point-p))) + (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 () "Go to the patch on the current line." @@ -1618,7 +1776,7 @@ Interactively, delete the marked patches, or the patch at point. 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 @@ -1646,13 +1804,21 @@ the work tree and index." "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 nil t))) - (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." + + (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) "Returns the list of patches in PATCHSYMS sorted according to @@ -1691,20 +1857,17 @@ Interactively, move the marked patches to where the point is." (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) @@ -1795,13 +1958,10 @@ 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)))