X-Git-Url: https://git.distorted.org.uk/~mdw/stgit/blobdiff_plain/64c097a03aa2494c0d7b6c24eceb05d28dc3b02f..cf8be1c862204655aa1ae2520fec32ef9b05d740:/contrib/stgit.el diff --git a/contrib/stgit.el b/contrib/stgit.el index 1cb4dd2..5aaf311 100644 --- a/contrib/stgit.el +++ b/contrib/stgit.el @@ -12,9 +12,20 @@ (defun stgit (dir) "Manage stgit patches" (interactive "DDirectory: \n") - (switch-to-stgit-buffer dir) + (switch-to-stgit-buffer (git-get-top-dir dir)) (stgit-refresh)) +(defun git-get-top-dir (dir) + "Retrieve the top-level directory of a git tree." + (let ((cdup (with-output-to-string + (with-current-buffer standard-output + (cd dir) + (unless (eq 0 (call-process "git" nil t nil + "rev-parse" "--show-cdup")) + (error "cannot find top-level git tree for %s." dir)))))) + (expand-file-name (concat (file-name-as-directory dir) + (car (split-string cdup "\n")))))) + (defun switch-to-stgit-buffer (dir) "Switch to a (possibly new) buffer displaying StGit patches for DIR" (setq dir (file-name-as-directory dir)) @@ -70,7 +81,7 @@ Argument DIR is the repository path." (insert "Branch: ") (stgit-run "branch") (stgit-run "series" "--description") - (stgit-rehighlight (point-min) (point-max)) + (stgit-rescan) (if curpatch (stgit-goto-patch curpatch) (goto-line curline)))) @@ -98,23 +109,30 @@ Argument DIR is the repository path." (t ())) "The face used for unapplied patch names") -(defun stgit-rehighlight (start end) - "Refresh fontification of region between START and END." +(defun stgit-rescan () + "Rescan the status buffer." (save-excursion - (goto-char start) - (while (< (point) end) - (cond ((looking-at "Branch: \\(.*\\)") - (put-text-property (match-beginning 1) (match-end 1) 'face 'bold)) - ((looking-at "\\([>+-]\\) \\([^ ]+\\) *| \\(.*\\)") - (let ((state (match-string 1))) - (put-text-property - (match-beginning 2) (match-end 2) - 'face (cond ((string= state ">") 'stgit-top-patch-face) - ((string= state "+") 'stgit-applied-patch-face) - ((string= state "-") 'stgit-unapplied-patch-face))) - (put-text-property (match-beginning 3) (match-end 3) - 'face 'stgit-description-face)))) - (forward-line 1)))) + (let ((marked ())) + (goto-char (point-min)) + (while (not (eobp)) + (cond ((looking-at "Branch: \\(.*\\)") + (put-text-property (match-beginning 1) (match-end 1) + 'face 'bold)) + ((looking-at "\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)") + (let ((state (match-string 1)) + (patchsym (intern (match-string 3)))) + (put-text-property + (match-beginning 3) (match-end 3) 'face + (cond ((string= state ">") 'stgit-top-patch-face) + ((string= state "+") 'stgit-applied-patch-face) + ((string= state "-") 'stgit-unapplied-patch-face))) + (put-text-property (match-beginning 4) (match-end 4) + 'face 'stgit-description-face) + (when (memq patchsym stgit-marked-patches) + (replace-match "*" nil nil nil 2) + (setq marked (cons patchsym marked)))))) + (forward-line 1)) + (setq stgit-marked-patches (nreverse marked))))) (defvar stgit-mode-hook nil "Run after `stgit-mode' is setup.") @@ -125,6 +143,8 @@ Argument DIR is the repository path." (unless stgit-mode-map (setq stgit-mode-map (make-keymap)) (suppress-keymap stgit-mode-map) + (define-key stgit-mode-map " " 'stgit-mark) + (define-key stgit-mode-map "\d" 'stgit-unmark) (define-key stgit-mode-map "?" 'stgit-help) (define-key stgit-mode-map "h" 'stgit-help) (define-key stgit-mode-map "p" 'previous-line) @@ -132,15 +152,17 @@ Argument DIR is the repository path." (define-key stgit-mode-map "g" 'stgit-refresh) (define-key stgit-mode-map "r" 'stgit-rename) (define-key stgit-mode-map "e" 'stgit-edit) + (define-key stgit-mode-map "c" 'stgit-coalesce) (define-key stgit-mode-map "N" 'stgit-new) - (define-key stgit-mode-map "\C-r" 'stgit-repair) + (define-key stgit-mode-map "R" 'stgit-repair) (define-key stgit-mode-map "C" 'stgit-commit) (define-key stgit-mode-map "U" 'stgit-uncommit) (define-key stgit-mode-map ">" 'stgit-push-next) (define-key stgit-mode-map "<" 'stgit-pop-next) (define-key stgit-mode-map "P" 'stgit-push-or-pop) (define-key stgit-mode-map "G" 'stgit-goto) - (define-key stgit-mode-map "=" 'stgit-show)) + (define-key stgit-mode-map "=" 'stgit-show) + (define-key stgit-mode-map "D" 'stgit-delete)) (defun stgit-mode () "Major mode for interacting with StGit. @@ -153,27 +175,65 @@ Commands: 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-variable 'truncate-lines 't) (run-hooks 'stgit-mode-hook)) +(defun stgit-add-mark (patch) + (let ((patchsym (intern patch))) + (setq stgit-marked-patches (cons patchsym stgit-marked-patches)))) + +(defun stgit-remove-mark (patch) + (let ((patchsym (intern patch))) + (setq stgit-marked-patches (delq patchsym stgit-marked-patches)))) + +(defun stgit-marked-patches () + "Return the names of the marked patches." + (mapcar 'symbol-name stgit-marked-patches)) + (defun stgit-patch-at-point () "Return the patch name on the current line" (save-excursion (beginning-of-line) - (if (looking-at "[>+-] \\([^ ]*\\)") + (if (looking-at "[>+-][ *]\\([^ ]*\\)") (match-string-no-properties 1) nil))) +(defun stgit-patches-marked-or-at-point () + "Return the names of the marked patches, or the patch on the current line." + (if stgit-marked-patches + (stgit-marked-patches) + (let ((patch (stgit-patch-at-point))) + (if patch + (list patch) + '())))) + (defun stgit-goto-patch (patch) "Move point to the line containing PATCH" (let ((p (point))) (goto-char (point-min)) - (if (re-search-forward (concat "[>+-] " (regexp-quote patch) " ") nil t) + (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ") nil t) (progn (move-to-column goal-column) t) (goto-char p) nil))) +(defun stgit-mark () + "Mark the patch under point" + (interactive) + (let ((patch (stgit-patch-at-point))) + (stgit-add-mark patch) + (stgit-refresh)) + (next-line)) + +(defun stgit-unmark () + "Mark the patch on the previous line" + (interactive) + (forward-line -1) + (let ((patch (stgit-patch-at-point))) + (stgit-remove-mark patch) + (stgit-refresh))) + (defun stgit-rename (name) "Rename the patch under point" (interactive (list (read-string "Patch name: " (stgit-patch-at-point)))) @@ -251,10 +311,8 @@ Commands: (defun stgit-edit () "Edit the patch on the current line" (interactive) - (let ((patch (if (stgit-applied-at-point) - (stgit-patch-at-point) - (error "This patch is not applied"))) - (edit-buf (get-buffer-create "*stgit edit*")) + (let ((patch (stgit-patch-at-point)) + (edit-buf (get-buffer-create "*StGit edit*")) (dir default-directory)) (log-edit 'stgit-confirm-edit t nil edit-buf) (set (make-local-variable 'stgit-edit-patch) patch) @@ -274,21 +332,15 @@ Commands: (defun stgit-new () "Create a new patch" (interactive) - (let ((edit-buf (get-buffer-create "*stgit edit*"))) + (let ((edit-buf (get-buffer-create "*StGit edit*"))) (log-edit 'stgit-confirm-new t nil edit-buf))) (defun stgit-confirm-new () (interactive) - (let ((file (make-temp-file "stgit-edit-")) - (patch (stgit-create-patch-name - (buffer-substring (point-min) - (save-excursion (goto-char (point-min)) - (end-of-line) - (point)))))) + (let ((file (make-temp-file "stgit-edit-"))) (write-region (point-min) (point-max) file) (stgit-capture-output nil - (stgit-run "new" "-m" "placeholder" patch) - (stgit-run "edit" "-f" file patch)) + (stgit-run "new" "-f" file)) (with-current-buffer log-edit-parent-buffer (stgit-refresh)))) @@ -310,6 +362,37 @@ Commands: (substring patch 0 20)) (t patch)))) +(defun stgit-delete (patch-names) + "Delete the named patches" + (interactive (list (stgit-patches-marked-or-at-point))) + (if (zerop (length patch-names)) + (error "No patches to delete") + (when (yes-or-no-p (format "Really delete %d patches? " + (length patch-names))) + (stgit-capture-output nil + (apply 'stgit-run "delete" patch-names)) + (stgit-refresh)))) + +(defun stgit-coalesce (patch-names) + "Run stg coalesce on the named patches" + (interactive (list (stgit-marked-patches))) + (let ((edit-buf (get-buffer-create "*StGit edit*")) + (dir default-directory)) + (log-edit 'stgit-confirm-coalesce t nil edit-buf) + (set (make-local-variable 'stgit-patches) patch-names) + (setq default-directory dir) + (let ((standard-output edit-buf)) + (apply 'stgit-run "coalesce" "--save-template=-" patch-names)))) + +(defun stgit-confirm-coalesce () + (interactive) + (let ((file (make-temp-file "stgit-edit-"))) + (write-region (point-min) (point-max) file) + (stgit-capture-output nil + (apply 'stgit-run "coalesce" "-f" file stgit-patches)) + (with-current-buffer log-edit-parent-buffer + (stgit-refresh)))) + (defun stgit-help () "Display help for the StGit mode." (interactive)