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      (with-current-buffer output-buf
  46        (erase-buffer))
  47      (let ((standard-output output-buf))
  48        ,@body)
  49      (if (with-current-buffer output-buf (< (point-min) (point-max)))
  50          (display-buffer output-buf t))))
  51 (put 'stgit-capture-output 'lisp-indent-function 1)
  52
  53 (defun stgit-run (&rest args)
  54   (apply 'call-process "stg" nil standard-output nil args))
  55
  56 (defun stgit-refresh ()
  57   "Update the contents of the stgit buffer"
  58   (interactive)
  59   (let ((inhibit-read-only t)
  60         (curline (line-number-at-pos))
  61         (curpatch (stgit-patch-at-point)))
  62     (erase-buffer)
  63     (insert "Branch: ")
  64     (stgit-run "branch")
  65     (stgit-run "series")
  66     (if curpatch
  67         (stgit-goto-patch curpatch)
  68       (goto-line curline))))
  69
  70 (defvar stgit-mode-hook nil
  71   "Run after `stgit-mode' is setup.")
  72
  73 (defvar stgit-mode-map nil
  74   "Keymap for StGit major mode.")
  75
  76 (unless stgit-mode-map
  77   (setq stgit-mode-map (make-keymap))
  78   (suppress-keymap stgit-mode-map)
  79   (define-key stgit-mode-map "?"   'stgit-help)
  80   (define-key stgit-mode-map "h"   'stgit-help)
  81   (define-key stgit-mode-map "g"   'stgit-refresh)
  82   (define-key stgit-mode-map "r"   'stgit-rename)
  83   (define-key stgit-mode-map ">"   'stgit-push-next)
  84   (define-key stgit-mode-map "<"   'stgit-pop-next)
  85   (define-key stgit-mode-map "P"   'stgit-push-or-pop)
  86   (define-key stgit-mode-map "="   'stgit-show))
  87
  88 (defun stgit-mode ()
  89   "Major mode for interacting with StGit.
  90 Commands:
  91 \\{stgit-mode-map}"
  92   (kill-all-local-variables)
  93   (buffer-disable-undo)
  94   (setq mode-name "StGit"
  95         major-mode 'stgit-mode
  96         goal-column 2)
  97   (use-local-map stgit-mode-map)
  98   (set (make-local-variable 'list-buffers-directory) default-directory)
  99   (run-hooks 'stgit-mode-hook))
 100
 101 (defun stgit-patch-at-point ()
 102   "Return the patch name on the current line"
 103   (save-excursion
 104     (beginning-of-line)
 105     (if (looking-at "[>+-] \\(.*\\)")
 106         (match-string 1)
 107       nil)))
 108
 109 (defun stgit-goto-patch (patch)
 110   "Move point to the line containing PATCH"
 111   (let ((p (point)))
 112     (goto-char (point-min))
 113     (if (re-search-forward (concat "[>+-] " (regexp-quote patch) "$") nil t)
 114         (progn (move-to-column goal-column)
 115                t)
 116       (goto-char p)
 117       nil)))
 118
 119 (defun stgit-rename (name)
 120   "Rename the patch under point"
 121   (interactive (list (read-string "Patch name: " (stgit-patch-at-point))))
 122   (let ((old-name (stgit-patch-at-point)))
 123     (unless old-name
 124       (error "No patch on this line"))
 125     (stgit-capture-output nil
 126       (stgit-run "rename" old-name name))
 127     (stgit-refresh)
 128     (stgit-goto-patch name)))
 129
 130 (defun stgit-push-next ()
 131   "Push the first unapplied patch"
 132   (interactive)
 133   (stgit-capture-output nil (stgit-run "push"))
 134   (stgit-refresh))
 135
 136 (defun stgit-pop-next ()
 137   "Pop the topmost applied patch"
 138   (interactive)
 139   (stgit-capture-output nil (stgit-run "pop"))
 140   (stgit-refresh))
 141
 142 (defun stgit-applied-at-point ()
 143   "Is the patch on the current line applied?"
 144   (save-excursion
 145     (beginning-of-line)
 146     (looking-at "[>+]")))
 147
 148 (defun stgit-push-or-pop ()
 149   "Push or pop the patch on the current line"
 150   (interactive)
 151   (let ((patch (stgit-patch-at-point))
 152         (applied (stgit-applied-at-point)))
 153     (stgit-capture-output nil
 154        (stgit-run (if applied "pop" "push") patch))
 155     (stgit-refresh)))
 156
 157 (defun stgit-show ()
 158   "Show the patch on the current line"
 159   (interactive)
 160   (stgit-capture-output "*StGit patch*"
 161     (stgit-run "show" (stgit-patch-at-point))
 162     (with-current-buffer standard-output
 163       (goto-char (point-min))
 164       (diff-mode))))
 165
 166 (defun stgit-help ()
 167   "Display help for the StGit mode."
 168   (interactive)
 169   (describe-function 'stgit-mode))
 170
 171 (provide 'stgit)