chiark - git - mdw - stgit/blob - contrib/stgit.el

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