| 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 | (require 'git nil t) |
| 13 | |
| 14 | (defun stgit (dir) |
| 15 | "Manage StGit patches for the tree in DIR." |
| 16 | (interactive "DDirectory: \n") |
| 17 | (switch-to-stgit-buffer (git-get-top-dir dir)) |
| 18 | (stgit-reload)) |
| 19 | |
| 20 | (unless (fboundp 'git-get-top-dir) |
| 21 | (defun git-get-top-dir (dir) |
| 22 | "Retrieve the top-level directory of a git tree." |
| 23 | (let ((cdup (with-output-to-string |
| 24 | (with-current-buffer standard-output |
| 25 | (cd dir) |
| 26 | (unless (eq 0 (call-process "git" nil t nil |
| 27 | "rev-parse" "--show-cdup")) |
| 28 | (error "cannot find top-level git tree for %s." dir)))))) |
| 29 | (expand-file-name (concat (file-name-as-directory dir) |
| 30 | (car (split-string cdup "\n"))))))) |
| 31 | |
| 32 | (defun stgit-refresh-git-status (&optional dir) |
| 33 | "If it exists, refresh the `git-status' buffer belonging to |
| 34 | directory DIR or `default-directory'" |
| 35 | (when (and (fboundp 'git-find-status-buffer) |
| 36 | (fboundp 'git-refresh-status)) |
| 37 | (let* ((top-dir (git-get-top-dir (or dir default-directory))) |
| 38 | (git-status-buffer (and top-dir (git-find-status-buffer top-dir)))) |
| 39 | (when git-status-buffer |
| 40 | (with-current-buffer git-status-buffer |
| 41 | (git-refresh-status)))))) |
| 42 | |
| 43 | (defun switch-to-stgit-buffer (dir) |
| 44 | "Switch to a (possibly new) buffer displaying StGit patches for DIR." |
| 45 | (setq dir (file-name-as-directory dir)) |
| 46 | (let ((buffers (buffer-list))) |
| 47 | (while (and buffers |
| 48 | (not (with-current-buffer (car buffers) |
| 49 | (and (eq major-mode 'stgit-mode) |
| 50 | (string= default-directory dir))))) |
| 51 | (setq buffers (cdr buffers))) |
| 52 | (switch-to-buffer (if buffers |
| 53 | (car buffers) |
| 54 | (create-stgit-buffer dir))))) |
| 55 | |
| 56 | (defun create-stgit-buffer (dir) |
| 57 | "Create a buffer for showing StGit patches. |
| 58 | Argument DIR is the repository path." |
| 59 | (let ((buf (create-file-buffer (concat dir "*stgit*"))) |
| 60 | (inhibit-read-only t)) |
| 61 | (with-current-buffer buf |
| 62 | (setq default-directory dir) |
| 63 | (stgit-mode) |
| 64 | (setq buffer-read-only t)) |
| 65 | buf)) |
| 66 | |
| 67 | (defmacro stgit-capture-output (name &rest body) |
| 68 | "Capture StGit output and show it in a window at the end." |
| 69 | `(let ((output-buf (get-buffer-create ,(or name "*StGit output*"))) |
| 70 | (stgit-dir default-directory) |
| 71 | (inhibit-read-only t)) |
| 72 | (with-current-buffer output-buf |
| 73 | (erase-buffer) |
| 74 | (setq default-directory stgit-dir) |
| 75 | (setq buffer-read-only t)) |
| 76 | (let ((standard-output output-buf)) |
| 77 | ,@body) |
| 78 | (with-current-buffer output-buf |
| 79 | (set-buffer-modified-p nil) |
| 80 | (setq buffer-read-only t) |
| 81 | (if (< (point-min) (point-max)) |
| 82 | (display-buffer output-buf t))))) |
| 83 | (put 'stgit-capture-output 'lisp-indent-function 1) |
| 84 | |
| 85 | (defun stgit-run-silent (&rest args) |
| 86 | (apply 'call-process "stg" nil standard-output nil args)) |
| 87 | |
| 88 | (defun stgit-run (&rest args) |
| 89 | (let ((msgcmd (mapconcat #'identity args " "))) |
| 90 | (message "Running stg %s..." msgcmd) |
| 91 | (apply 'call-process "stg" nil standard-output nil args) |
| 92 | (message "Running stg %s...done" msgcmd))) |
| 93 | |
| 94 | (defun stgit-reload () |
| 95 | "Update the contents of the StGit buffer." |
| 96 | (interactive) |
| 97 | (let ((inhibit-read-only t) |
| 98 | (curline (line-number-at-pos)) |
| 99 | (curpatch (stgit-patch-at-point))) |
| 100 | (erase-buffer) |
| 101 | (insert "Branch: ") |
| 102 | (stgit-run-silent "branch") |
| 103 | (stgit-run-silent "series" "--description") |
| 104 | (stgit-rescan) |
| 105 | (if curpatch |
| 106 | (stgit-goto-patch curpatch) |
| 107 | (goto-line curline))) |
| 108 | (stgit-refresh-git-status)) |
| 109 | |
| 110 | (defface stgit-description-face |
| 111 | '((((background dark)) (:foreground "tan")) |
| 112 | (((background light)) (:foreground "dark red"))) |
| 113 | "The face used for StGit desriptions") |
| 114 | |
| 115 | (defface stgit-top-patch-face |
| 116 | '((((background dark)) (:weight bold :foreground "yellow")) |
| 117 | (((background light)) (:weight bold :foreground "purple")) |
| 118 | (t (:weight bold))) |
| 119 | "The face used for the top patch names") |
| 120 | |
| 121 | (defface stgit-applied-patch-face |
| 122 | '((((background dark)) (:foreground "light yellow")) |
| 123 | (((background light)) (:foreground "purple")) |
| 124 | (t ())) |
| 125 | "The face used for applied patch names") |
| 126 | |
| 127 | (defface stgit-unapplied-patch-face |
| 128 | '((((background dark)) (:foreground "gray80")) |
| 129 | (((background light)) (:foreground "orchid")) |
| 130 | (t ())) |
| 131 | "The face used for unapplied patch names") |
| 132 | |
| 133 | (defun stgit-rescan () |
| 134 | "Rescan the status buffer." |
| 135 | (save-excursion |
| 136 | (let ((marked ())) |
| 137 | (goto-char (point-min)) |
| 138 | (while (not (eobp)) |
| 139 | (cond ((looking-at "Branch: \\(.*\\)") |
| 140 | (put-text-property (match-beginning 1) (match-end 1) |
| 141 | 'face 'bold)) |
| 142 | ((looking-at "\\([>+-]\\)\\( \\)\\([^ ]+\\) *[|#] \\(.*\\)") |
| 143 | (let ((state (match-string 1)) |
| 144 | (patchsym (intern (match-string 3)))) |
| 145 | (put-text-property |
| 146 | (match-beginning 3) (match-end 3) 'face |
| 147 | (cond ((string= state ">") 'stgit-top-patch-face) |
| 148 | ((string= state "+") 'stgit-applied-patch-face) |
| 149 | ((string= state "-") 'stgit-unapplied-patch-face))) |
| 150 | (put-text-property (match-beginning 4) (match-end 4) |
| 151 | 'face 'stgit-description-face) |
| 152 | (when (memq patchsym stgit-marked-patches) |
| 153 | (replace-match "*" nil nil nil 2) |
| 154 | (setq marked (cons patchsym marked))))) |
| 155 | ((or (looking-at "stg series: Branch \".*\" not initialised") |
| 156 | (looking-at "stg series: .*: branch not initialized")) |
| 157 | (forward-line 1) |
| 158 | (insert "Run M-x stgit-init to initialise"))) |
| 159 | (forward-line 1)) |
| 160 | (setq stgit-marked-patches (nreverse marked))))) |
| 161 | |
| 162 | (defun stgit-quit () |
| 163 | "Hide the stgit buffer." |
| 164 | (interactive) |
| 165 | (bury-buffer)) |
| 166 | |
| 167 | (defun stgit-git-status () |
| 168 | "Show status using `git-status'." |
| 169 | (interactive) |
| 170 | (unless (fboundp 'git-status) |
| 171 | (error "stgit-git-status requires git-status")) |
| 172 | (let ((dir default-directory)) |
| 173 | (save-selected-window |
| 174 | (pop-to-buffer nil) |
| 175 | (git-status dir)))) |
| 176 | |
| 177 | (defvar stgit-mode-hook nil |
| 178 | "Run after `stgit-mode' is setup.") |
| 179 | |
| 180 | (defvar stgit-mode-map nil |
| 181 | "Keymap for StGit major mode.") |
| 182 | |
| 183 | (unless stgit-mode-map |
| 184 | (setq stgit-mode-map (make-keymap)) |
| 185 | (suppress-keymap stgit-mode-map) |
| 186 | (mapc (lambda (arg) (define-key stgit-mode-map (car arg) (cdr arg))) |
| 187 | '((" " . stgit-mark) |
| 188 | ("m" . stgit-mark) |
| 189 | ("\d" . stgit-unmark-up) |
| 190 | ("u" . stgit-unmark-down) |
| 191 | ("?" . stgit-help) |
| 192 | ("h" . stgit-help) |
| 193 | ("p" . previous-line) |
| 194 | ("n" . next-line) |
| 195 | ("s" . stgit-git-status) |
| 196 | ("g" . stgit-reload) |
| 197 | ("r" . stgit-refresh) |
| 198 | ("\C-c\C-r" . stgit-rename) |
| 199 | ("e" . stgit-edit) |
| 200 | ("c" . stgit-coalesce) |
| 201 | ("N" . stgit-new) |
| 202 | ("R" . stgit-repair) |
| 203 | ("C" . stgit-commit) |
| 204 | ("U" . stgit-uncommit) |
| 205 | (">" . stgit-push-next) |
| 206 | ("<" . stgit-pop-next) |
| 207 | ("P" . stgit-push-or-pop) |
| 208 | ("G" . stgit-goto) |
| 209 | ("=" . stgit-show) |
| 210 | ("D" . stgit-delete) |
| 211 | ([(control ?/)] . stgit-undo) |
| 212 | ("\C-_" . stgit-undo) |
| 213 | ("q" . stgit-quit)))) |
| 214 | |
| 215 | (defun stgit-mode () |
| 216 | "Major mode for interacting with StGit. |
| 217 | Commands: |
| 218 | \\{stgit-mode-map}" |
| 219 | (kill-all-local-variables) |
| 220 | (buffer-disable-undo) |
| 221 | (setq mode-name "StGit" |
| 222 | major-mode 'stgit-mode |
| 223 | goal-column 2) |
| 224 | (use-local-map stgit-mode-map) |
| 225 | (set (make-local-variable 'list-buffers-directory) default-directory) |
| 226 | (set (make-local-variable 'stgit-marked-patches) nil) |
| 227 | (set-variable 'truncate-lines 't) |
| 228 | (run-hooks 'stgit-mode-hook)) |
| 229 | |
| 230 | (defun stgit-add-mark (patch) |
| 231 | (let ((patchsym (intern patch))) |
| 232 | (setq stgit-marked-patches (cons patchsym stgit-marked-patches)))) |
| 233 | |
| 234 | (defun stgit-remove-mark (patch) |
| 235 | (let ((patchsym (intern patch))) |
| 236 | (setq stgit-marked-patches (delq patchsym stgit-marked-patches)))) |
| 237 | |
| 238 | (defun stgit-clear-marks () |
| 239 | (setq stgit-marked-patches '())) |
| 240 | |
| 241 | (defun stgit-marked-patches () |
| 242 | "Return the names of the marked patches." |
| 243 | (mapcar 'symbol-name stgit-marked-patches)) |
| 244 | |
| 245 | (defun stgit-patch-at-point (&optional cause-error) |
| 246 | "Return the patch name on the current line. If CAUSE-ERROR is |
| 247 | not nil, signal an error if none found." |
| 248 | (save-excursion |
| 249 | (beginning-of-line) |
| 250 | (cond ((looking-at "[>+-][ *]\\([^ ]*\\)") |
| 251 | (match-string-no-properties 1)) |
| 252 | (cause-error |
| 253 | (error "No patch on this line"))))) |
| 254 | |
| 255 | (defun stgit-patches-marked-or-at-point () |
| 256 | "Return the names of the marked patches, or the patch on the current line." |
| 257 | (if stgit-marked-patches |
| 258 | (stgit-marked-patches) |
| 259 | (let ((patch (stgit-patch-at-point))) |
| 260 | (if patch |
| 261 | (list patch) |
| 262 | '())))) |
| 263 | |
| 264 | (defun stgit-goto-patch (patch) |
| 265 | "Move point to the line containing PATCH." |
| 266 | (let ((p (point))) |
| 267 | (goto-char (point-min)) |
| 268 | (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ") nil t) |
| 269 | (progn (move-to-column goal-column) |
| 270 | t) |
| 271 | (goto-char p) |
| 272 | nil))) |
| 273 | |
| 274 | (defun stgit-init () |
| 275 | "Run stg init." |
| 276 | (interactive) |
| 277 | (stgit-capture-output nil |
| 278 | (stgit-run "init")) |
| 279 | (stgit-reload)) |
| 280 | |
| 281 | (defun stgit-mark () |
| 282 | "Mark the patch under point." |
| 283 | (interactive) |
| 284 | (let ((patch (stgit-patch-at-point t))) |
| 285 | (stgit-add-mark patch) |
| 286 | (stgit-reload)) |
| 287 | (next-line)) |
| 288 | |
| 289 | (defun stgit-unmark-up () |
| 290 | "Remove mark from the patch on the previous line." |
| 291 | (interactive) |
| 292 | (forward-line -1) |
| 293 | (stgit-remove-mark (stgit-patch-at-point t)) |
| 294 | (stgit-reload)) |
| 295 | |
| 296 | (defun stgit-unmark-down () |
| 297 | "Remove mark from the patch on the current line." |
| 298 | (interactive) |
| 299 | (stgit-remove-mark (stgit-patch-at-point t)) |
| 300 | (forward-line) |
| 301 | (stgit-reload)) |
| 302 | |
| 303 | (defun stgit-rename (name) |
| 304 | "Rename the patch under point to NAME." |
| 305 | (interactive (list (read-string "Patch name: " (stgit-patch-at-point t)))) |
| 306 | (let ((old-name (stgit-patch-at-point t))) |
| 307 | (stgit-capture-output nil |
| 308 | (stgit-run "rename" old-name name)) |
| 309 | (stgit-reload) |
| 310 | (stgit-goto-patch name))) |
| 311 | |
| 312 | (defun stgit-repair () |
| 313 | "Run stg repair." |
| 314 | (interactive) |
| 315 | (stgit-capture-output nil |
| 316 | (stgit-run "repair")) |
| 317 | (stgit-reload)) |
| 318 | |
| 319 | (defun stgit-commit () |
| 320 | "Run stg commit." |
| 321 | (interactive) |
| 322 | (stgit-capture-output nil (stgit-run "commit")) |
| 323 | (stgit-reload)) |
| 324 | |
| 325 | (defun stgit-uncommit (arg) |
| 326 | "Run stg uncommit. Numeric arg determines number of patches to uncommit." |
| 327 | (interactive "p") |
| 328 | (stgit-capture-output nil (stgit-run "uncommit" "-n" (number-to-string arg))) |
| 329 | (stgit-reload)) |
| 330 | |
| 331 | (defun stgit-push-next (npatches) |
| 332 | "Push the first unapplied patch. |
| 333 | With numeric prefix argument, push that many patches." |
| 334 | (interactive "p") |
| 335 | (stgit-capture-output nil (stgit-run "push" "-n" |
| 336 | (number-to-string npatches))) |
| 337 | (stgit-reload) |
| 338 | (stgit-refresh-git-status)) |
| 339 | |
| 340 | (defun stgit-pop-next (npatches) |
| 341 | "Pop the topmost applied patch. |
| 342 | With numeric prefix argument, pop that many patches." |
| 343 | (interactive "p") |
| 344 | (stgit-capture-output nil (stgit-run "pop" "-n" (number-to-string npatches))) |
| 345 | (stgit-reload) |
| 346 | (stgit-refresh-git-status)) |
| 347 | |
| 348 | (defun stgit-applied-at-point () |
| 349 | "Is the patch on the current line applied?" |
| 350 | (save-excursion |
| 351 | (beginning-of-line) |
| 352 | (looking-at "[>+]"))) |
| 353 | |
| 354 | (defun stgit-push-or-pop () |
| 355 | "Push or pop the patch on the current line." |
| 356 | (interactive) |
| 357 | (let ((patch (stgit-patch-at-point t)) |
| 358 | (applied (stgit-applied-at-point))) |
| 359 | (stgit-capture-output nil |
| 360 | (stgit-run (if applied "pop" "push") patch)) |
| 361 | (stgit-reload))) |
| 362 | |
| 363 | (defun stgit-goto () |
| 364 | "Go to the patch on the current line." |
| 365 | (interactive) |
| 366 | (let ((patch (stgit-patch-at-point t))) |
| 367 | (stgit-capture-output nil |
| 368 | (stgit-run "goto" patch)) |
| 369 | (stgit-reload))) |
| 370 | |
| 371 | (defun stgit-show () |
| 372 | "Show the patch on the current line." |
| 373 | (interactive) |
| 374 | (stgit-capture-output "*StGit patch*" |
| 375 | (stgit-run "show" (stgit-patch-at-point t)) |
| 376 | (with-current-buffer standard-output |
| 377 | (goto-char (point-min)) |
| 378 | (diff-mode)))) |
| 379 | |
| 380 | (defun stgit-edit () |
| 381 | "Edit the patch on the current line." |
| 382 | (interactive) |
| 383 | (let ((patch (stgit-patch-at-point t)) |
| 384 | (edit-buf (get-buffer-create "*StGit edit*")) |
| 385 | (dir default-directory)) |
| 386 | (log-edit 'stgit-confirm-edit t nil edit-buf) |
| 387 | (set (make-local-variable 'stgit-edit-patch) patch) |
| 388 | (setq default-directory dir) |
| 389 | (let ((standard-output edit-buf)) |
| 390 | (stgit-run-silent "edit" "--save-template=-" patch)))) |
| 391 | |
| 392 | (defun stgit-confirm-edit () |
| 393 | (interactive) |
| 394 | (let ((file (make-temp-file "stgit-edit-"))) |
| 395 | (write-region (point-min) (point-max) file) |
| 396 | (stgit-capture-output nil |
| 397 | (stgit-run "edit" "-f" file stgit-edit-patch)) |
| 398 | (with-current-buffer log-edit-parent-buffer |
| 399 | (stgit-reload)))) |
| 400 | |
| 401 | (defun stgit-new () |
| 402 | "Create a new patch." |
| 403 | (interactive) |
| 404 | (let ((edit-buf (get-buffer-create "*StGit edit*")) |
| 405 | (dir default-directory)) |
| 406 | (log-edit 'stgit-confirm-new t nil edit-buf) |
| 407 | (setq default-directory dir))) |
| 408 | |
| 409 | (defun stgit-confirm-new () |
| 410 | (interactive) |
| 411 | (let ((file (make-temp-file "stgit-edit-"))) |
| 412 | (write-region (point-min) (point-max) file) |
| 413 | (stgit-capture-output nil |
| 414 | (stgit-run "new" "-f" file)) |
| 415 | (with-current-buffer log-edit-parent-buffer |
| 416 | (stgit-reload)))) |
| 417 | |
| 418 | (defun stgit-create-patch-name (description) |
| 419 | "Create a patch name from a long description" |
| 420 | (let ((patch "")) |
| 421 | (while (> (length description) 0) |
| 422 | (cond ((string-match "\\`[a-zA-Z_-]+" description) |
| 423 | (setq patch (downcase (concat patch (match-string 0 description)))) |
| 424 | (setq description (substring description (match-end 0)))) |
| 425 | ((string-match "\\` +" description) |
| 426 | (setq patch (concat patch "-")) |
| 427 | (setq description (substring description (match-end 0)))) |
| 428 | ((string-match "\\`[^a-zA-Z_-]+" description) |
| 429 | (setq description (substring description (match-end 0)))))) |
| 430 | (cond ((= (length patch) 0) |
| 431 | "patch") |
| 432 | ((> (length patch) 20) |
| 433 | (substring patch 0 20)) |
| 434 | (t patch)))) |
| 435 | |
| 436 | (defun stgit-delete (patch-names) |
| 437 | "Delete the named patches." |
| 438 | (interactive (list (stgit-patches-marked-or-at-point))) |
| 439 | (if (zerop (length patch-names)) |
| 440 | (error "No patches to delete") |
| 441 | (when (yes-or-no-p (format "Really delete %d patches? " |
| 442 | (length patch-names))) |
| 443 | (stgit-capture-output nil |
| 444 | (apply 'stgit-run "delete" patch-names)) |
| 445 | (stgit-reload)))) |
| 446 | |
| 447 | (defun stgit-coalesce (patch-names) |
| 448 | "Run stg coalesce on the named patches." |
| 449 | (interactive (list (stgit-marked-patches))) |
| 450 | (let ((edit-buf (get-buffer-create "*StGit edit*")) |
| 451 | (dir default-directory)) |
| 452 | (log-edit 'stgit-confirm-coalesce t nil edit-buf) |
| 453 | (set (make-local-variable 'stgit-patches) patch-names) |
| 454 | (setq default-directory dir) |
| 455 | (let ((standard-output edit-buf)) |
| 456 | (apply 'stgit-run-silent "coalesce" "--save-template=-" patch-names)))) |
| 457 | |
| 458 | (defun stgit-confirm-coalesce () |
| 459 | (interactive) |
| 460 | (let ((file (make-temp-file "stgit-edit-"))) |
| 461 | (write-region (point-min) (point-max) file) |
| 462 | (stgit-capture-output nil |
| 463 | (apply 'stgit-run "coalesce" "-f" file stgit-patches)) |
| 464 | (with-current-buffer log-edit-parent-buffer |
| 465 | (stgit-clear-marks) |
| 466 | ;; Go to first marked patch and stay there |
| 467 | (goto-char (point-min)) |
| 468 | (re-search-forward (concat "^[>+-]\\*") nil t) |
| 469 | (move-to-column goal-column) |
| 470 | (let ((pos (point))) |
| 471 | (stgit-reload) |
| 472 | (goto-char pos))))) |
| 473 | |
| 474 | (defun stgit-help () |
| 475 | "Display help for the StGit mode." |
| 476 | (interactive) |
| 477 | (describe-function 'stgit-mode)) |
| 478 | |
| 479 | (defun stgit-undo (&optional arg) |
| 480 | "Run stg undo. |
| 481 | With prefix argument, run it with the --hard flag." |
| 482 | (interactive "P") |
| 483 | (stgit-capture-output nil |
| 484 | (if arg |
| 485 | (stgit-run "undo" "--hard") |
| 486 | (stgit-run "undo"))) |
| 487 | (stgit-reload)) |
| 488 | |
| 489 | (defun stgit-refresh (&optional arg) |
| 490 | "Run stg refresh. |
| 491 | With prefix argument, refresh the marked patch or the patch under point." |
| 492 | (interactive "P") |
| 493 | (let ((patchargs (if arg |
| 494 | (let ((patches (stgit-patches-marked-or-at-point))) |
| 495 | (cond ((null patches) |
| 496 | (error "no patch to update")) |
| 497 | ((> (length patches) 1) |
| 498 | (error "too many patches selected")) |
| 499 | (t |
| 500 | (cons "-p" patches)))) |
| 501 | nil))) |
| 502 | (stgit-capture-output nil |
| 503 | (apply 'stgit-run "refresh" patchargs)) |
| 504 | (stgit-refresh-git-status)) |
| 505 | (stgit-reload)) |
| 506 | |
| 507 | (provide 'stgit) |