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

   1 (defun stgit (dir)
   2   "Manage stgit patches"
   3   (interactive "DDirectory: \n")
   4   (switch-to-stgit-buffer dir)
   5   (stgit-refresh))
   6
   7 (defun switch-to-stgit-buffer (dir)
   8   "Switch to a (possibly new) buffer displaying StGit patches for DIR"
   9   (setq dir (file-name-as-directory dir))
  10   (let ((buffers (buffer-list)))
  11     (while (and buffers
  12                 (not (with-current-buffer (car buffers)
  13                        (and (eq major-mode 'stgit-mode)
  14                             (string= default-directory dir)))))
  15       (setq buffers (cdr buffers)))
  16     (switch-to-buffer (if buffers
  17                           (car buffers)
  18                         (create-stgit-buffer dir)))))
  19
  20 (defun create-stgit-buffer (dir)
  21   "Create a buffer for showing StGit patches.
  22 Argument DIR is the repository path."
  23   (let ((buf (create-file-buffer (concat dir "*stgit*")))
  24         (inhibit-read-only t))
  25     (with-current-buffer buf
  26       (setq default-directory dir)
  27       (stgit-mode)
  28       (setq buffer-read-only t))
  29     buf))
  30
  31 (defmacro stgit-capture-output (name &rest body)
  32   "Capture StGit output and show it in a window at the end"
  33   `(let ((output-buf (get-buffer-create ,(or name "*StGit output*"))))
  34      (with-current-buffer output-buf
  35        (erase-buffer))
  36      (let ((standard-output output-buf))
  37        ,@body)
  38      (if (with-current-buffer output-buf (< (point-min) (point-max)))
  39          (display-buffer output-buf t))))
  40 (put 'stgit-capture-output 'lisp-indent-function 1)
  41
  42 (defun stgit-run (&rest args)
  43   (apply 'call-process "stg" nil standard-output nil args))
  44
  45 (defun stgit-refresh ()
  46   "Update the contents of the stgit buffer"
  47   (interactive)
  48   (let ((inhibit-read-only t)
  49         (curline (line-number-at-pos))
  50         (curpatch (stgit-patch-at-point)))
  51     (erase-buffer)
  52     (insert "Branch: ")
  53     (stgit-run "branch")
  54     (stgit-run "series")
  55     (if curpatch
  56         (stgit-goto-patch curpatch)
  57       (goto-line curline))))
  58
  59 (defvar stgit-mode-hook nil
  60   "Run after `stgit-mode' is setup.")
  61
  62 (defvar stgit-mode-map nil
  63   "Keymap for StGit major mode.")
  64
  65 (unless stgit-mode-map
  66   (setq stgit-mode-map (make-keymap))
  67   (suppress-keymap stgit-mode-map)
  68   (define-key stgit-mode-map "?"   'stgit-help)
  69   (define-key stgit-mode-map "h"   'stgit-help)
  70   (define-key stgit-mode-map "g"   'stgit-refresh)
  71   (define-key stgit-mode-map "r"   'stgit-rename)
  72   (define-key stgit-mode-map ">"   'stgit-push-next)
  73   (define-key stgit-mode-map "<"   'stgit-pop)
  74   (define-key stgit-mode-map "="   'stgit-show))
  75
  76 (defun stgit-mode ()
  77   "Major mode for interacting with StGit.
  78 Commands:
  79 \\{stgit-mode-map}"
  80   (kill-all-local-variables)
  81   (buffer-disable-undo)
  82   (setq mode-name "StGit"
  83         major-mode 'stgit-mode
  84         goal-column 2)
  85   (use-local-map stgit-mode-map)
  86   (set (make-local-variable 'list-buffers-directory) default-directory)
  87   (run-hooks 'stgit-mode-hook))
  88
  89 (defun stgit-patch-at-point ()
  90   "Return the patch name on the current line"
  91   (save-excursion
  92     (beginning-of-line)
  93     (if (looking-at "[>+-] \\(.*\\)")
  94         (match-string 1)
  95       nil)))
  96
  97 (defun stgit-goto-patch (patch)
  98   "Move point to the line containing PATCH"
  99   (let ((p (point)))
 100     (goto-char (point-min))
 101     (if (re-search-forward (concat "[>+-] " (regexp-quote patch) "$") nil t)
 102         (progn (move-to-column goal-column)
 103                t)
 104       (goto-char p)
 105       nil)))
 106
 107 (defun stgit-rename (name)
 108   "Rename the patch under point"
 109   (interactive (list (read-string "Patch name: " (stgit-patch-at-point))))
 110   (let ((old-name (stgit-patch-at-point)))
 111     (unless old-name
 112       (error "No patch on this line"))
 113     (stgit-capture-output nil
 114       (stgit-run "rename" old-name name))
 115     (stgit-refresh)
 116     (stgit-goto-patch name)))
 117
 118 (defun stgit-push-next ()
 119   "Push the patch on the line after pos"
 120   (interactive)
 121   (forward-line 1)
 122   (let ((patch (stgit-patch-at-point)))
 123     (stgit-capture-output nil
 124       (stgit-run "push" patch))
 125     (stgit-refresh)))
 126
 127 (defun stgit-pop ()
 128   "Pop the patch on the current line"
 129   (interactive)
 130   (let ((patch (stgit-patch-at-point)))
 131     (stgit-capture-output nil
 132       (stgit-run "pop" patch))
 133     (stgit-refresh)
 134     (previous-line)))
 135
 136 (defun stgit-show ()
 137   "Show the patch on the current line"
 138   (interactive)
 139   (stgit-capture-output "*StGit patch*"
 140     (stgit-run "show" (stgit-patch-at-point))
 141     (with-current-buffer standard-output
 142       (goto-char (point-min))
 143       (diff-mode))))
 144
 145 (defun stgit-help ()
 146   "Display help for the StGit mode."
 147   (interactive)
 148   (describe-function 'stgit-mode))