+;; stgit.el: An emacs mode for StGit
+;;
+;; Copyright (C) 2007 David Kågedal <davidk@lysator.liu.se>
+;;
+;; To install: put this file on the load-path and place the following
+;; in your .emacs file:
+;;
+;; (require 'stgit)
+;;
+;; To start: `M-x stgit'
+
(defun stgit (dir)
"Manage stgit patches"
(interactive "DDirectory: \n")
(defmacro stgit-capture-output (name &rest body)
"Capture StGit output and show it in a window at the end"
- `(let ((output-buf (get-buffer-create ,(or name "*StGit output*"))))
+ `(let ((output-buf (get-buffer-create ,(or name "*StGit output*")))
+ (stgit-dir default-directory)
+ (inhibit-read-only t))
(with-current-buffer output-buf
- (erase-buffer))
+ (erase-buffer)
+ (setq default-directory stgit-dir)
+ (setq buffer-read-only t))
(let ((standard-output output-buf))
,@body)
- (if (with-current-buffer output-buf (< (point-min) (point-max)))
- (display-buffer output-buf t))))
+ (with-current-buffer output-buf
+ (set-buffer-modified-p nil)
+ (setq buffer-read-only t)
+ (if (< (point-min) (point-max))
+ (display-buffer output-buf t)))))
(put 'stgit-capture-output 'lisp-indent-function 1)
(defun stgit-run (&rest args)
(erase-buffer)
(insert "Branch: ")
(stgit-run "branch")
- (stgit-run "series")
+ (stgit-run "series" "--description")
+ (stgit-rehighlight (point-min) (point-max))
(if curpatch
(stgit-goto-patch curpatch)
(goto-line curline))))
+(defface stgit-description-face
+ '((((background dark)) (:foreground "tan"))
+ (((background light)) (:foreground "dark red")))
+ "The face used for StGit desriptions")
+
+(defface stgit-top-patch-face
+ '((((background dark)) (:weight bold :foreground "yellow"))
+ (((background light)) (:weight bold :foreground "purple"))
+ (t (:weight bold)))
+ "The face used for the top patch names")
+
+(defface stgit-applied-patch-face
+ '((((background dark)) (:foreground "light yellow"))
+ (((background light)) (:foreground "purple"))
+ (t ()))
+ "The face used for applied patch names")
+
+(defface stgit-unapplied-patch-face
+ '((((background dark)) (:foreground "gray80"))
+ (((background light)) (:foreground "orchid"))
+ (t ()))
+ "The face used for unapplied patch names")
+
+(defun stgit-rehighlight (start end)
+ "Refresh fontification of region between START and END."
+ (save-excursion
+ (goto-char start)
+ (while (< (point) end)
+ (cond ((looking-at "Branch: \\(.*\\)")
+ (put-text-property (match-beginning 1) (match-end 1) 'face 'bold))
+ ((looking-at "\\([>+-]\\) \\([^ ]+\\) *| \\(.*\\)")
+ (let ((state (match-string 1)))
+ (put-text-property
+ (match-beginning 2) (match-end 2)
+ 'face (cond ((string= state ">") 'stgit-top-patch-face)
+ ((string= state "+") 'stgit-applied-patch-face)
+ ((string= state "-") 'stgit-unapplied-patch-face)))
+ (put-text-property (match-beginning 3) (match-end 3)
+ 'face 'stgit-description-face))))
+ (forward-line 1))))
+
(defvar stgit-mode-hook nil
"Run after `stgit-mode' is setup.")
(suppress-keymap stgit-mode-map)
(define-key stgit-mode-map "?" 'stgit-help)
(define-key stgit-mode-map "h" 'stgit-help)
+ (define-key stgit-mode-map "p" 'previous-line)
+ (define-key stgit-mode-map "n" 'next-line)
(define-key stgit-mode-map "g" 'stgit-refresh)
(define-key stgit-mode-map "r" 'stgit-rename)
+ (define-key stgit-mode-map "e" 'stgit-edit)
+ (define-key stgit-mode-map "N" 'stgit-new)
+ (define-key stgit-mode-map "\C-r" 'stgit-repair)
+ (define-key stgit-mode-map "C" 'stgit-commit)
+ (define-key stgit-mode-map "U" 'stgit-uncommit)
(define-key stgit-mode-map ">" 'stgit-push-next)
- (define-key stgit-mode-map "<" 'stgit-pop)
+ (define-key stgit-mode-map "<" 'stgit-pop-next)
+ (define-key stgit-mode-map "P" 'stgit-push-or-pop)
+ (define-key stgit-mode-map "G" 'stgit-goto)
(define-key stgit-mode-map "=" 'stgit-show))
(defun stgit-mode ()
goal-column 2)
(use-local-map stgit-mode-map)
(set (make-local-variable 'list-buffers-directory) default-directory)
+ (set-variable 'truncate-lines 't)
(run-hooks 'stgit-mode-hook))
(defun stgit-patch-at-point ()
"Return the patch name on the current line"
(save-excursion
(beginning-of-line)
- (if (looking-at "[>+-] \\(.*\\)")
- (match-string 1)
+ (if (looking-at "[>+-] \\([^ ]*\\)")
+ (match-string-no-properties 1)
nil)))
(defun stgit-goto-patch (patch)
"Move point to the line containing PATCH"
(let ((p (point)))
(goto-char (point-min))
- (if (re-search-forward (concat "[>+-] " (regexp-quote patch) "$") nil t)
+ (if (re-search-forward (concat "[>+-] " (regexp-quote patch) " ") nil t)
(progn (move-to-column goal-column)
t)
(goto-char p)
(stgit-refresh)
(stgit-goto-patch name)))
+(defun stgit-repair ()
+ "Run stg repair"
+ (interactive)
+ (stgit-capture-output nil
+ (stgit-run "repair"))
+ (stgit-refresh))
+
+(defun stgit-commit ()
+ "Run stg commit."
+ (interactive)
+ (stgit-capture-output nil (stgit-run "commit"))
+ (stgit-refresh))
+
+(defun stgit-uncommit (arg)
+ "Run stg uncommit. Numeric arg determines number of patches to uncommit."
+ (interactive "p")
+ (stgit-capture-output nil (stgit-run "uncommit" "-n" (number-to-string arg)))
+ (stgit-refresh))
+
(defun stgit-push-next ()
- "Push the patch on the line after pos"
+ "Push the first unapplied patch"
(interactive)
- (forward-line 1)
- (let ((patch (stgit-patch-at-point)))
+ (stgit-capture-output nil (stgit-run "push"))
+ (stgit-refresh))
+
+(defun stgit-pop-next ()
+ "Pop the topmost applied patch"
+ (interactive)
+ (stgit-capture-output nil (stgit-run "pop"))
+ (stgit-refresh))
+
+(defun stgit-applied-at-point ()
+ "Is the patch on the current line applied?"
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "[>+]")))
+
+(defun stgit-push-or-pop ()
+ "Push or pop the patch on the current line"
+ (interactive)
+ (let ((patch (stgit-patch-at-point))
+ (applied (stgit-applied-at-point)))
(stgit-capture-output nil
- (stgit-run "push" patch))
+ (stgit-run (if applied "pop" "push") patch))
(stgit-refresh)))
-(defun stgit-pop ()
- "Pop the patch on the current line"
+(defun stgit-goto ()
+ "Go to the patch on the current line"
(interactive)
(let ((patch (stgit-patch-at-point)))
(stgit-capture-output nil
- (stgit-run "pop" patch))
- (stgit-refresh)
- (previous-line)))
+ (stgit-run "goto" patch))
+ (stgit-refresh)))
(defun stgit-show ()
"Show the patch on the current line"
(goto-char (point-min))
(diff-mode))))
+(defun stgit-edit ()
+ "Edit the patch on the current line"
+ (interactive)
+ (let ((patch (if (stgit-applied-at-point)
+ (stgit-patch-at-point)
+ (error "This patch is not applied")))
+ (edit-buf (get-buffer-create "*stgit edit*"))
+ (dir default-directory))
+ (log-edit 'stgit-confirm-edit t nil edit-buf)
+ (set (make-local-variable 'stgit-edit-patch) patch)
+ (setq default-directory dir)
+ (let ((standard-output edit-buf))
+ (stgit-run "edit" "--save-template=-" patch))))
+
+(defun stgit-confirm-edit ()
+ (interactive)
+ (let ((file (make-temp-file "stgit-edit-")))
+ (write-region (point-min) (point-max) file)
+ (stgit-capture-output nil
+ (stgit-run "edit" "-f" file stgit-edit-patch))
+ (with-current-buffer log-edit-parent-buffer
+ (stgit-refresh))))
+
+(defun stgit-new ()
+ "Create a new patch"
+ (interactive)
+ (let ((edit-buf (get-buffer-create "*stgit edit*")))
+ (log-edit 'stgit-confirm-new t nil edit-buf)))
+
+(defun stgit-confirm-new ()
+ (interactive)
+ (let ((file (make-temp-file "stgit-edit-"))
+ (patch (stgit-create-patch-name
+ (buffer-substring (point-min)
+ (save-excursion (goto-char (point-min))
+ (end-of-line)
+ (point))))))
+ (write-region (point-min) (point-max) file)
+ (stgit-capture-output nil
+ (stgit-run "new" "-m" "placeholder" patch)
+ (stgit-run "edit" "-f" file patch))
+ (with-current-buffer log-edit-parent-buffer
+ (stgit-refresh))))
+
+(defun stgit-create-patch-name (description)
+ "Create a patch name from a long description"
+ (let ((patch ""))
+ (while (> (length description) 0)
+ (cond ((string-match "\\`[a-zA-Z_-]+" description)
+ (setq patch (downcase (concat patch (match-string 0 description))))
+ (setq description (substring description (match-end 0))))
+ ((string-match "\\` +" description)
+ (setq patch (concat patch "-"))
+ (setq description (substring description (match-end 0))))
+ ((string-match "\\`[^a-zA-Z_-]+" description)
+ (setq description (substring description (match-end 0))))))
+ (cond ((= (length patch) 0)
+ "patch")
+ ((> (length patch) 20)
+ (substring patch 0 20))
+ (t patch))))
+
(defun stgit-help ()
"Display help for the StGit mode."
(interactive)
(describe-function 'stgit-mode))
+
+(provide 'stgit)
~mdw / stgit / blobdiff