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 (defun stgit (dir)
  13   "Manage stgit patches"
  14   (interactive "DDirectory: \n")
  15   (switch-to-stgit-buffer dir)
  16   (stgit-refresh))
  17
  18 (defun switch-to-stgit-buffer (dir)
  19   "Switch to a (possibly new) buffer displaying StGit patches for DIR"
  20   (setq dir (file-name-as-directory dir))
  21   (let ((buffers (buffer-list)))
  22     (while (and buffers
  23                 (not (with-current-buffer (car buffers)
  24                        (and (eq major-mode 'stgit-mode)
  25                             (string= default-directory dir)))))
  26       (setq buffers (cdr buffers)))
  27     (switch-to-buffer (if buffers
  28                           (car buffers)
  29                         (create-stgit-buffer dir)))))
  30
  31 (defun create-stgit-buffer (dir)
  32   "Create a buffer for showing StGit patches.
  33 Argument DIR is the repository path."
  34   (let ((buf (create-file-buffer (concat dir "*stgit*")))
  35         (inhibit-read-only t))
  36     (with-current-buffer buf
  37       (setq default-directory dir)
  38       (stgit-mode)
  39       (setq buffer-read-only t))
  40     buf))
  41
  42 (defmacro stgit-capture-output (name &rest body)
  43   "Capture StGit output and show it in a window at the end"
  44   `(let ((output-buf (get-buffer-create ,(or name "*StGit output*")))
  45          (stgit-dir default-directory)
  46          (inhibit-read-only t))
  47      (with-current-buffer output-buf
  48        (erase-buffer)
  49        (setq default-directory stgit-dir)
  50        (setq buffer-read-only t))
  51      (let ((standard-output output-buf))
  52        ,@body)
  53      (with-current-buffer output-buf
  54        (set-buffer-modified-p nil)
  55        (setq buffer-read-only t)
  56        (if (< (point-min) (point-max))
  57            (display-buffer output-buf t)))))
  58 (put 'stgit-capture-output 'lisp-indent-function 1)
  59
  60 (defun stgit-run (&rest args)
  61   (apply 'call-process "stg" nil standard-output nil args))
  62
  63 (defun stgit-refresh ()
  64   "Update the contents of the stgit buffer"
  65   (interactive)
  66   (let ((inhibit-read-only t)
  67         (curline (line-number-at-pos))
  68         (curpatch (stgit-patch-at-point)))
  69     (erase-buffer)
  70     (insert "Branch: ")
  71     (stgit-run "branch")
  72     (stgit-run "series" "--description")
  73     (if curpatch
  74         (stgit-goto-patch curpatch)
  75       (goto-line curline))))
  76
  77 (defvar stgit-mode-hook nil
  78   "Run after `stgit-mode' is setup.")
  79
  80 (defvar stgit-mode-map nil
  81   "Keymap for StGit major mode.")
  82
  83 (unless stgit-mode-map
  84   (setq stgit-mode-map (make-keymap))
  85   (suppress-keymap stgit-mode-map)
  86   (define-key stgit-mode-map "?"   'stgit-help)
  87   (define-key stgit-mode-map "h"   'stgit-help)
  88   (define-key stgit-mode-map "p"   'previous-line)
  89   (define-key stgit-mode-map "n"   'next-line)
  90   (define-key stgit-mode-map "g"   'stgit-refresh)
  91   (define-key stgit-mode-map "r"   'stgit-rename)
  92   (define-key stgit-mode-map "e"   'stgit-edit)
  93   (define-key stgit-mode-map "\C-r"   'stgit-repair)
  94   (define-key stgit-mode-map "C"   'stgit-commit)
  95   (define-key stgit-mode-map "U"   'stgit-uncommit)
  96   (define-key stgit-mode-map ">"   'stgit-push-next)
  97   (define-key stgit-mode-map "<"   'stgit-pop-next)
  98   (define-key stgit-mode-map "P"   'stgit-push-or-pop)
  99   (define-key stgit-mode-map "G"   'stgit-goto)
 100   (define-key stgit-mode-map "="   'stgit-show))
 101
 102 (defun stgit-mode ()
 103   "Major mode for interacting with StGit.
 104 Commands:
 105 \\{stgit-mode-map}"
 106   (kill-all-local-variables)
 107   (buffer-disable-undo)
 108   (setq mode-name "StGit"
 109         major-mode 'stgit-mode
 110         goal-column 2)
 111   (use-local-map stgit-mode-map)
 112   (set (make-local-variable 'list-buffers-directory) default-directory)
 113   (set-variable 'truncate-lines 't)
 114   (run-hooks 'stgit-mode-hook))
 115
 116 (defun stgit-patch-at-point ()
 117   "Return the patch name on the current line"
 118   (save-excursion
 119     (beginning-of-line)
 120     (if (looking-at "[>+-] \\([^ ]*\\)")
 121         (match-string 1)
 122       nil)))
 123
 124 (defun stgit-goto-patch (patch)
 125   "Move point to the line containing PATCH"
 126   (let ((p (point)))
 127     (goto-char (point-min))
 128     (if (re-search-forward (concat "[>+-] " (regexp-quote patch) " ") nil t)
 129         (progn (move-to-column goal-column)
 130                t)
 131       (goto-char p)
 132       nil)))
 133
 134 (defun stgit-rename (name)
 135   "Rename the patch under point"
 136   (interactive (list (read-string "Patch name: " (stgit-patch-at-point))))
 137   (let ((old-name (stgit-patch-at-point)))
 138     (unless old-name
 139       (error "No patch on this line"))
 140     (stgit-capture-output nil
 141       (stgit-run "rename" old-name name))
 142     (stgit-refresh)
 143     (stgit-goto-patch name)))
 144
 145 (defun stgit-repair ()
 146   "Run stg repair"
 147   (interactive)
 148   (stgit-capture-output nil
 149    (stgit-run "repair"))
 150   (stgit-refresh))
 151
 152 (defun stgit-commit ()
 153   "Run stg commit."
 154   (interactive)
 155   (stgit-capture-output nil (stgit-run "commit"))
 156   (stgit-refresh))
 157
 158 (defun stgit-uncommit (arg)
 159   "Run stg uncommit. Numeric arg determines number of patches to uncommit."
 160   (interactive "p")
 161   (stgit-capture-output nil (stgit-run "uncommit" "-n" (number-to-string arg)))
 162   (stgit-refresh))
 163
 164 (defun stgit-push-next ()
 165   "Push the first unapplied patch"
 166   (interactive)
 167   (stgit-capture-output nil (stgit-run "push"))
 168   (stgit-refresh))
 169
 170 (defun stgit-pop-next ()
 171   "Pop the topmost applied patch"
 172   (interactive)
 173   (stgit-capture-output nil (stgit-run "pop"))
 174   (stgit-refresh))
 175
 176 (defun stgit-applied-at-point ()
 177   "Is the patch on the current line applied?"
 178   (save-excursion
 179     (beginning-of-line)
 180     (looking-at "[>+]")))
 181
 182 (defun stgit-push-or-pop ()
 183   "Push or pop the patch on the current line"
 184   (interactive)
 185   (let ((patch (stgit-patch-at-point))
 186         (applied (stgit-applied-at-point)))
 187     (stgit-capture-output nil
 188        (stgit-run (if applied "pop" "push") patch))
 189     (stgit-refresh)))
 190
 191 (defun stgit-goto ()
 192   "Go to the patch on the current line"
 193   (interactive)
 194   (let ((patch (stgit-patch-at-point)))
 195     (stgit-capture-output nil
 196        (stgit-run "goto" patch))
 197     (stgit-refresh)))
 198
 199 (defun stgit-show ()
 200   "Show the patch on the current line"
 201   (interactive)
 202   (stgit-capture-output "*StGit patch*"
 203     (stgit-run "show" (stgit-patch-at-point))
 204     (with-current-buffer standard-output
 205       (goto-char (point-min))
 206       (diff-mode))))
 207
 208 (defun stgit-edit ()
 209   "Edit the patch on the current line"
 210   (interactive)
 211   (let ((patch (if (stgit-applied-at-point)
 212                    (stgit-patch-at-point)
 213                  (error "This patch is not applied")))
 214         (edit-buf (get-buffer-create "*stgit edit*"))
 215         (dir default-directory))
 216     (log-edit 'stgit-confirm-edit t nil edit-buf)
 217     (set (make-local-variable 'stgit-edit-patch) patch)
 218     (setq default-directory dir)
 219     (let ((standard-output edit-buf))
 220       (stgit-run "edit" "--save-template=-" patch))))
 221
 222 (defun stgit-confirm-edit ()
 223   (interactive)
 224   (let ((file (make-temp-file "stgit-edit-")))
 225     (write-region (point-min) (point-max) file)
 226     (stgit-capture-output nil
 227       (stgit-run "edit" "-f" file stgit-edit-patch))
 228     (with-current-buffer log-edit-parent-buffer
 229       (stgit-refresh))))
 230
 231
 232 (defun stgit-help ()
 233   "Display help for the StGit mode."
 234   (interactive)
 235   (describe-function 'stgit-mode))
 236
 237 (provide 'stgit)