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 for the tree in DIR."
  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 (&optional cause-error)
 233   "Return the patch name on the current line. If CAUSE-ERROR is
 234 not nil, signal an error if none found."
 235   (save-excursion
 236     (beginning-of-line)
 237     (cond ((looking-at "[>+-][ *]\\([^ ]*\\)")
 238            (match-string-no-properties 1))
 239           (cause-error
 240            (error "No patch on this line")))))
 241
 242 (defun stgit-patches-marked-or-at-point ()
 243   "Return the names of the marked patches, or the patch on the current line."
 244   (if stgit-marked-patches
 245       (stgit-marked-patches)
 246     (let ((patch (stgit-patch-at-point)))
 247       (if patch
 248           (list patch)
 249         '()))))
 250
 251 (defun stgit-goto-patch (patch)
 252   "Move point to the line containing PATCH."
 253   (let ((p (point)))
 254     (goto-char (point-min))
 255     (if (re-search-forward (concat "^[>+-][ *]" (regexp-quote patch) " ") nil t)
 256         (progn (move-to-column goal-column)
 257                t)
 258       (goto-char p)
 259       nil)))
 260
 261 (defun stgit-init ()
 262   "Run stg init."
 263   (interactive)
 264   (stgit-capture-output nil
 265     (stgit-run "init"))
 266   (stgit-reload))
 267
 268 (defun stgit-mark ()
 269   "Mark the patch under point."
 270   (interactive)
 271   (let ((patch (stgit-patch-at-point t)))
 272     (stgit-add-mark patch)
 273     (stgit-reload))
 274   (next-line))
 275
 276 (defun stgit-unmark-up ()
 277   "Remove mark from the patch on the previous line."
 278   (interactive)
 279   (forward-line -1)
 280   (stgit-remove-mark (stgit-patch-at-point t))
 281   (stgit-reload))
 282
 283 (defun stgit-unmark-down ()
 284   "Remove mark from the patch on the current line."
 285   (interactive)
 286   (stgit-remove-mark (stgit-patch-at-point t))
 287   (forward-line)
 288   (stgit-reload))
 289
 290 (defun stgit-rename (name)
 291   "Rename the patch under point to NAME."
 292   (interactive (list (read-string "Patch name: " (stgit-patch-at-point t))))
 293   (let ((old-name (stgit-patch-at-point t)))
 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 t))
 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 t)))
 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 t))
 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 t))
 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 marked patch or 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)