| 1 | ;; stgit.el: An emacs mode for StGit |
| 2 | ;; |
| 3 | ;; Copyright (C) 2007 David Kågedal <davidk@lysator.liu.se> |
| 4 | ;; |
| 5 | ;; To install: put this file on the load-path and place the following |
| 6 | ;; in your .emacs file: |
| 7 | ;; |
| 8 | ;; (require 'stgit) |
| 9 | ;; |
| 10 | ;; To start: `M-x stgit' |
| 11 | |
| 12 | (defun stgit (dir) |
| 13 | "Manage stgit patches" |
| 14 | (interactive "DDirectory: \n") |
| 15 | (switch-to-stgit-buffer (git-get-top-dir dir)) |
| 16 | (stgit-refresh)) |
| 17 | |
| 18 | (defun git-get-top-dir (dir) |
| 19 | "Retrieve the top-level directory of a git tree." |
| 20 | (let ((cdup (with-output-to-string |
| 21 | (with-current-buffer standard-output |
| 22 | (cd dir) |
| 23 | (unless (eq 0 (call-process "git" nil t nil |
| 24 | "rev-parse" "--show-cdup")) |
| 25 | (error "cannot find top-level git tree for %s." dir)))))) |
| 26 | (expand-file-name (concat (file-name-as-directory dir) |
| 27 | (car (split-string cdup "\n")))))) |
| 28 | |
| 29 | (defun switch-to-stgit-buffer (dir) |
| 30 | "Switch to a (possibly new) buffer displaying StGit patches for DIR" |
| 31 | (setq dir (file-name-as-directory dir)) |
| 32 | (let ((buffers (buffer-list))) |
| 33 | (while (and buffers |
| 34 | (not (with-current-buffer (car buffers) |
| 35 | (and (eq major-mode 'stgit-mode) |
| 36 | (string= default-directory dir))))) |
| 37 | (setq buffers (cdr buffers))) |
| 38 | (switch-to-buffer (if buffers |
| 39 | (car buffers) |
| 40 | (create-stgit-buffer dir))))) |
| 41 | |
| 42 | (defun create-stgit-buffer (dir) |
| 43 | "Create a buffer for showing StGit patches. |
| 44 | Argument DIR is the repository path." |
| 45 | (let ((buf (create-file-buffer (concat dir "*stgit*"))) |
| 46 | (inhibit-read-only t)) |
| 47 | (with-current-buffer buf |
| 48 | (setq default-directory dir) |
| 49 | (stgit-mode) |
| 50 | (setq buffer-read-only t)) |
| 51 | buf)) |
| 52 | |
| 53 | (defmacro stgit-capture-output (name &rest body) |
| 54 | "Capture StGit output and show it in a window at the end" |
| 55 | `(let ((output-buf (get-buffer-create ,(or name "*StGit output*"))) |
| 56 | (stgit-dir default-directory) |
| 57 | (inhibit-read-only t)) |
| 58 | (with-current-buffer output-buf |
| 59 | (erase-buffer) |
| 60 | (setq default-directory stgit-dir) |
| 61 | (setq buffer-read-only t)) |
| 62 | (let ((standard-output output-buf)) |
| 63 | ,@body) |
| 64 | (with-current-buffer output-buf |
| 65 | (set-buffer-modified-p nil) |
| 66 | (setq buffer-read-only t) |
| 67 | (if (< (point-min) (point-max)) |
| 68 | (display-buffer output-buf t))))) |
| 69 | (put 'stgit-capture-output 'lisp-indent-function 1) |
| 70 | |
| 71 | (defun stgit-run (&rest args) |
| 72 | (apply 'call-process "stg" nil standard-output nil args)) |
| 73 | |
| 74 | (defun stgit-refresh () |
| 75 | "Update the contents of the stgit buffer" |
| 76 | (interactive) |
| 77 | (let ((inhibit-read-only t) |
| 78 | (curline (line-number-at-pos)) |
| 79 | (curpatch (stgit-patch-at-point))) |
| 80 | (erase-buffer) |
| 81 | (insert "Branch: ") |
| 82 | (stgit-run "branch") |
| 83 | (stgit-run "series" "--description") |
| 84 | (stgit-rescan) |
| 85 | (if curpatch |
| 86 | (stgit-goto-patch curpatch) |
| 87 | (goto-line curline)))) |
| 88 | |
| 89 | (defface stgit-description-face |
| 90 | '((((background dark)) (:foreground "tan")) |
| 91 | (((background light)) (:foreground "dark red"))) |
| 92 | "The face used for StGit desriptions") |
| 93 | |
| 94 | (defface stgit-top-patch-face |
| 95 | '((((background dark)) (:weight bold :foreground "yellow")) |
| 96 | (((background light)) (:weight bold :foreground "purple")) |
| 97 | (t (:weight bold))) |
| 98 | "The face used for the top patch names") |
| 99 | |
| 100 | (defface stgit-applied-patch-face |
| 101 | '((((background dark)) (:foreground "light yellow")) |
| 102 | (((background light)) (:foreground "purple")) |
| 103 | (t ())) |
| 104 | "The face used for applied patch names") |
| 105 | |
| 106 | (defface stgit-unapplied-patch-face |
| 107 | '((((background dark)) (:foreground "gray80")) |
| 108 | (((background light)) (:foreground "orchid")) |
| 109 | (t ())) |
| 110 | "The face used for unapplied patch names") |
| 111 | |
| 112 | (defun stgit-rescan () |
| 113 | "Rescan the status buffer." |
| 114 | (save-excursion |
| 115 | (let ((marked ())) |
| 116 | (goto-char (point-min)) |
| 117 | (while (not (eobp)) |
| 118 | (cond ((looking-at "Branch: \\(.*\\)") |
| 119 | (put-text-property (match-beginning 1) (match-end 1) |
| 120 | 'face 'bold)) |
| 121 | ((looking-at "\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)") |
| 122 | (let ((state (match-string 1)) |
| 123 | (patchsym (intern (match-string 3)))) |
| 124 | (put-text-property |
| 125 | (match-beginning 3) (match-end 3) 'face |
| 126 | (cond ((string= state ">") 'stgit-top-patch-face) |
| 127 | ((string= state "+") 'stgit-applied-patch-face) |
| 128 | ((string= state "-") 'stgit-unapplied-patch-face))) |
| 129 | (put-text-property (match-beginning 4) (match-end 4) |
| 130 | 'face 'stgit-description-face) |
| 131 | (when (memq patchsym stgit-marked-patches) |
| 132 | (replace-match "*" nil nil nil 2) |
| 133 | (setq marked (cons patchsym marked)))))) |
| 134 | (forward-line 1)) |
| 135 | (setq stgit-marked-patches (nreverse marked))))) |
| 136 | |
| 137 | (defvar stgit-mode-hook nil |
| 138 | "Run after `stgit-mode' is setup.") |
| 139 | |
| 140 | (defvar stgit-mode-map nil |
| 141 | "Keymap for StGit major mode.") |
| 142 | |
| 143 | (unless stgit-mode-map |
| 144 | (setq stgit-mode-map (make-keymap)) |
| 145 | (suppress-keymap stgit-mode-map) |
| 146 | (define-key stgit-mode-map " " 'stgit-mark) |
| 147 | (define-key stgit-mode-map "\d" 'stgit-unmark) |
| 148 | (define-key stgit-mode-map "?" 'stgit-help) |
| 149 | (define-key stgit-mode-map "h" 'stgit-help) |
| 150 | (define-key stgit-mode-map "p" 'previous-line) |
| 151 | (define-key stgit-mode-map "n" 'next-line) |
| 152 | (define-key stgit-mode-map "g" 'stgit-refresh) |
| 153 | (define-key stgit-mode-map "r" 'stgit-rename) |
| 154 | (define-key stgit-mode-map "e" 'stgit-edit) |
| 155 | (define-key stgit-mode-map "c" 'stgit-coalesce) |
| 156 | (define-key stgit-mode-map "N" 'stgit-new) |
| 157 | (define-key stgit-mode-map "R" 'stgit-repair) |
| 158 | (define-key stgit-mode-map "C" 'stgit-commit) |
| 159 | (define-key stgit-mode-map "U" 'stgit-uncommit) |
| 160 | (define-key stgit-mode-map ">" 'stgit-push-next) |
| 161 | (define-key stgit-mode-map "<" 'stgit-pop-next) |
| 162 | (define-key stgit-mode-map "P" 'stgit-push-or-pop) |
| 163 | (define-key stgit-mode-map "G" 'stgit-goto) |
| 164 | (define-key stgit-mode-map "=" 'stgit-show) |
| 165 | (define-key stgit-mode-map "D" 'stgit-delete)) |
| 166 | |
| 167 | (defun stgit-mode () |
| 168 | "Major mode for interacting with StGit. |
| 169 | Commands: |
| 170 | \\{stgit-mode-map}" |
| 171 | (kill-all-local-variables) |
| 172 | (buffer-disable-undo) |
| 173 | (setq mode-name "StGit" |
| 174 | major-mode 'stgit-mode |
| 175 | goal-column 2) |
| 176 | (use-local-map stgit-mode-map) |
| 177 | (set (make-local-variable 'list-buffers-directory) default-directory) |
| 178 | (set (make-local-variable 'stgit-marked-patches) nil) |
| 179 | (set-variable 'truncate-lines 't) |
| 180 | (run-hooks 'stgit-mode-hook)) |
| 181 | |
| 182 | (defun stgit-add-mark (patch) |
| 183 | (let ((patchsym (intern patch))) |
| 184 | (setq stgit-marked-patches (cons patchsym stgit-marked-patches)))) |
| 185 | |
| 186 | (defun stgit-remove-mark (patch) |
| 187 | (let ((patchsym (intern patch))) |
| 188 | (setq stgit-marked-patches (delq patchsym stgit-marked-patches)))) |
| 189 | |
| 190 | (defun stgit-marked-patches () |
| 191 | "Return the names of the marked patches." |
| 192 | (mapcar 'symbol-name stgit-marked-patches)) |
| 193 | |
| 194 | (defun stgit-patch-at-point () |
| 195 | "Return the patch name on the current line" |
| 196 | (save-excursion |
| 197 | (beginning-of-line) |
| 198 | (if (looking-at "[>+-][ *]\\([^ ]*\\)") |
| 199 | (match-string-no-properties 1) |
| 200 | nil))) |
| 201 | |
| 202 | (defun stgit-patches-marked-or-at-point () |
| 203 | "Return the names of the marked patches, or the patch on the current line." |
| 204 | (if stgit-marked-patches |
| 205 | (stgit-marked-patches) |
| 206 | (let ((patch (stgit-patch-at-point))) |
| 207 | (if patch |
| 208 | (list patch) |
| 209 | '())))) |
| 210 | |
| 211 | (defun stgit-goto-patch (patch) |
| 212 | "Move point to the line containing PATCH" |
| 213 | (let ((p (point))) |
| 214 | (goto-char (point-min)) |
| 215 | (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ") nil t) |
| 216 | (progn (move-to-column goal-column) |
| 217 | t) |
| 218 | (goto-char p) |
| 219 | nil))) |
| 220 | |
| 221 | (defun stgit-mark () |
| 222 | "Mark the patch under point" |
| 223 | (interactive) |
| 224 | (let ((patch (stgit-patch-at-point))) |
| 225 | (stgit-add-mark patch) |
| 226 | (stgit-refresh)) |
| 227 | (next-line)) |
| 228 | |
| 229 | (defun stgit-unmark () |
| 230 | "Mark the patch on the previous line" |
| 231 | (interactive) |
| 232 | (forward-line -1) |
| 233 | (let ((patch (stgit-patch-at-point))) |
| 234 | (stgit-remove-mark patch) |
| 235 | (stgit-refresh))) |
| 236 | |
| 237 | (defun stgit-rename (name) |
| 238 | "Rename the patch under point" |
| 239 | (interactive (list (read-string "Patch name: " (stgit-patch-at-point)))) |
| 240 | (let ((old-name (stgit-patch-at-point))) |
| 241 | (unless old-name |
| 242 | (error "No patch on this line")) |
| 243 | (stgit-capture-output nil |
| 244 | (stgit-run "rename" old-name name)) |
| 245 | (stgit-refresh) |
| 246 | (stgit-goto-patch name))) |
| 247 | |
| 248 | (defun stgit-repair () |
| 249 | "Run stg repair" |
| 250 | (interactive) |
| 251 | (stgit-capture-output nil |
| 252 | (stgit-run "repair")) |
| 253 | (stgit-refresh)) |
| 254 | |
| 255 | (defun stgit-commit () |
| 256 | "Run stg commit." |
| 257 | (interactive) |
| 258 | (stgit-capture-output nil (stgit-run "commit")) |
| 259 | (stgit-refresh)) |
| 260 | |
| 261 | (defun stgit-uncommit (arg) |
| 262 | "Run stg uncommit. Numeric arg determines number of patches to uncommit." |
| 263 | (interactive "p") |
| 264 | (stgit-capture-output nil (stgit-run "uncommit" "-n" (number-to-string arg))) |
| 265 | (stgit-refresh)) |
| 266 | |
| 267 | (defun stgit-push-next () |
| 268 | "Push the first unapplied patch" |
| 269 | (interactive) |
| 270 | (stgit-capture-output nil (stgit-run "push")) |
| 271 | (stgit-refresh)) |
| 272 | |
| 273 | (defun stgit-pop-next () |
| 274 | "Pop the topmost applied patch" |
| 275 | (interactive) |
| 276 | (stgit-capture-output nil (stgit-run "pop")) |
| 277 | (stgit-refresh)) |
| 278 | |
| 279 | (defun stgit-applied-at-point () |
| 280 | "Is the patch on the current line applied?" |
| 281 | (save-excursion |
| 282 | (beginning-of-line) |
| 283 | (looking-at "[>+]"))) |
| 284 | |
| 285 | (defun stgit-push-or-pop () |
| 286 | "Push or pop the patch on the current line" |
| 287 | (interactive) |
| 288 | (let ((patch (stgit-patch-at-point)) |
| 289 | (applied (stgit-applied-at-point))) |
| 290 | (stgit-capture-output nil |
| 291 | (stgit-run (if applied "pop" "push") patch)) |
| 292 | (stgit-refresh))) |
| 293 | |
| 294 | (defun stgit-goto () |
| 295 | "Go to the patch on the current line" |
| 296 | (interactive) |
| 297 | (let ((patch (stgit-patch-at-point))) |
| 298 | (stgit-capture-output nil |
| 299 | (stgit-run "goto" patch)) |
| 300 | (stgit-refresh))) |
| 301 | |
| 302 | (defun stgit-show () |
| 303 | "Show the patch on the current line" |
| 304 | (interactive) |
| 305 | (stgit-capture-output "*StGit patch*" |
| 306 | (stgit-run "show" (stgit-patch-at-point)) |
| 307 | (with-current-buffer standard-output |
| 308 | (goto-char (point-min)) |
| 309 | (diff-mode)))) |
| 310 | |
| 311 | (defun stgit-edit () |
| 312 | "Edit the patch on the current line" |
| 313 | (interactive) |
| 314 | (let ((patch (stgit-patch-at-point)) |
| 315 | (edit-buf (get-buffer-create "*StGit edit*")) |
| 316 | (dir default-directory)) |
| 317 | (log-edit 'stgit-confirm-edit t nil edit-buf) |
| 318 | (set (make-local-variable 'stgit-edit-patch) patch) |
| 319 | (setq default-directory dir) |
| 320 | (let ((standard-output edit-buf)) |
| 321 | (stgit-run "edit" "--save-template=-" patch)))) |
| 322 | |
| 323 | (defun stgit-confirm-edit () |
| 324 | (interactive) |
| 325 | (let ((file (make-temp-file "stgit-edit-"))) |
| 326 | (write-region (point-min) (point-max) file) |
| 327 | (stgit-capture-output nil |
| 328 | (stgit-run "edit" "-f" file stgit-edit-patch)) |
| 329 | (with-current-buffer log-edit-parent-buffer |
| 330 | (stgit-refresh)))) |
| 331 | |
| 332 | (defun stgit-new () |
| 333 | "Create a new patch" |
| 334 | (interactive) |
| 335 | (let ((edit-buf (get-buffer-create "*StGit edit*"))) |
| 336 | (log-edit 'stgit-confirm-new t nil edit-buf))) |
| 337 | |
| 338 | (defun stgit-confirm-new () |
| 339 | (interactive) |
| 340 | (let ((file (make-temp-file "stgit-edit-"))) |
| 341 | (write-region (point-min) (point-max) file) |
| 342 | (stgit-capture-output nil |
| 343 | (stgit-run "new" "-f" file)) |
| 344 | (with-current-buffer log-edit-parent-buffer |
| 345 | (stgit-refresh)))) |
| 346 | |
| 347 | (defun stgit-create-patch-name (description) |
| 348 | "Create a patch name from a long description" |
| 349 | (let ((patch "")) |
| 350 | (while (> (length description) 0) |
| 351 | (cond ((string-match "\\`[a-zA-Z_-]+" description) |
| 352 | (setq patch (downcase (concat patch (match-string 0 description)))) |
| 353 | (setq description (substring description (match-end 0)))) |
| 354 | ((string-match "\\` +" description) |
| 355 | (setq patch (concat patch "-")) |
| 356 | (setq description (substring description (match-end 0)))) |
| 357 | ((string-match "\\`[^a-zA-Z_-]+" description) |
| 358 | (setq description (substring description (match-end 0)))))) |
| 359 | (cond ((= (length patch) 0) |
| 360 | "patch") |
| 361 | ((> (length patch) 20) |
| 362 | (substring patch 0 20)) |
| 363 | (t patch)))) |
| 364 | |
| 365 | (defun stgit-delete (patch-names) |
| 366 | "Delete the named patches" |
| 367 | (interactive (list (stgit-patches-marked-or-at-point))) |
| 368 | (if (zerop (length patch-names)) |
| 369 | (error "No patches to delete") |
| 370 | (when (yes-or-no-p (format "Really delete %d patches? " |
| 371 | (length patch-names))) |
| 372 | (stgit-capture-output nil |
| 373 | (apply 'stgit-run "delete" patch-names)) |
| 374 | (stgit-refresh)))) |
| 375 | |
| 376 | (defun stgit-coalesce (patch-names) |
| 377 | "Run stg coalesce on the named patches" |
| 378 | (interactive (list (stgit-marked-patches))) |
| 379 | (let ((edit-buf (get-buffer-create "*StGit edit*")) |
| 380 | (dir default-directory)) |
| 381 | (log-edit 'stgit-confirm-coalesce t nil edit-buf) |
| 382 | (set (make-local-variable 'stgit-patches) patch-names) |
| 383 | (setq default-directory dir) |
| 384 | (let ((standard-output edit-buf)) |
| 385 | (apply 'stgit-run "coalesce" "--save-template=-" patch-names)))) |
| 386 | |
| 387 | (defun stgit-confirm-coalesce () |
| 388 | (interactive) |
| 389 | (let ((file (make-temp-file "stgit-edit-"))) |
| 390 | (write-region (point-min) (point-max) file) |
| 391 | (stgit-capture-output nil |
| 392 | (apply 'stgit-run "coalesce" "-f" file stgit-patches)) |
| 393 | (with-current-buffer log-edit-parent-buffer |
| 394 | (stgit-refresh)))) |
| 395 | |
| 396 | (defun stgit-help () |
| 397 | "Display help for the StGit mode." |
| 398 | (interactive) |
| 399 | (describe-function 'stgit-mode)) |
| 400 | |
| 401 | (provide 'stgit) |