|
1 ;;; mq.el --- Emacs support for Mercurial Queues |
|
2 |
|
3 ;; Copyright (C) 2006 Bryan O'Sullivan |
|
4 |
|
5 ;; Author: Bryan O'Sullivan <bos@serpentine.com> |
|
6 |
|
7 ;; mq.el is free software; you can redistribute it and/or modify it |
|
8 ;; under the terms of version 2 of the GNU General Public License as |
|
9 ;; published by the Free Software Foundation. |
|
10 |
|
11 ;; mq.el is distributed in the hope that it will be useful, but |
|
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
|
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
|
14 ;; General Public License for more details. |
|
15 |
|
16 ;; You should have received a copy of the GNU General Public License |
|
17 ;; along with mq.el, GNU Emacs, or XEmacs; see the file COPYING (`C-h |
|
18 ;; C-l'). If not, write to the Free Software Foundation, Inc., 59 |
|
19 ;; Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
|
20 |
|
21 (require 'mercurial) |
|
22 |
|
23 |
|
24 (defcustom mq-mode-hook nil |
|
25 "Hook run when a buffer enters mq-mode." |
|
26 :type 'sexp |
|
27 :group 'mercurial) |
|
28 |
|
29 (defcustom mq-global-prefix "\C-cq" |
|
30 "The global prefix for Mercurial Queues keymap bindings." |
|
31 :type 'sexp |
|
32 :group 'mercurial) |
|
33 |
|
34 |
|
35 ;;; Internal variables. |
|
36 |
|
37 (defvar mq-patch-history nil) |
|
38 |
|
39 |
|
40 ;;; Global keymap. |
|
41 |
|
42 (defvar mq-global-map (make-sparse-keymap)) |
|
43 (fset 'mq-global-map mq-global-map) |
|
44 (global-set-key mq-global-prefix 'mq-global-map) |
|
45 (define-key mq-global-map "." 'mq-push) |
|
46 (define-key mq-global-map ">" 'mq-push-all) |
|
47 (define-key mq-global-map "," 'mq-pop) |
|
48 (define-key mq-global-map "<" 'mq-pop-all) |
|
49 (define-key mq-global-map "r" 'mq-refresh) |
|
50 (define-key mq-global-map "e" 'mq-refresh-edit) |
|
51 (define-key mq-global-map "n" 'mq-next) |
|
52 (define-key mq-global-map "p" 'mq-previous) |
|
53 (define-key mq-global-map "t" 'mq-top) |
|
54 |
|
55 |
|
56 ;;; Helper functions. |
|
57 |
|
58 (defun mq-read-patch-name (&optional source prompt) |
|
59 "Read a patch name to use with a command. |
|
60 May return nil, meaning \"use the default\"." |
|
61 (let ((patches (split-string |
|
62 (hg-chomp (hg-run0 (or source "qseries"))) "\n"))) |
|
63 (when current-prefix-arg |
|
64 (completing-read (format "Patch%s: " (or prompt "")) |
|
65 (map 'list 'cons patches patches) |
|
66 nil |
|
67 nil |
|
68 nil |
|
69 'mq-patch-history)))) |
|
70 |
|
71 (defun mq-refresh-buffers (root) |
|
72 (save-excursion |
|
73 (dolist (buf (hg-buffers-visiting-repo root)) |
|
74 (when (not (verify-visited-file-modtime buf)) |
|
75 (set-buffer buf) |
|
76 (let ((ctx (hg-buffer-context))) |
|
77 (message "Refreshing %s..." (buffer-name)) |
|
78 (revert-buffer t t t) |
|
79 (hg-restore-context ctx) |
|
80 (message "Refreshing %s...done" (buffer-name)))))) |
|
81 (hg-update-mode-lines root)) |
|
82 |
|
83 (defun mq-last-line () |
|
84 (goto-char (point-max)) |
|
85 (beginning-of-line) |
|
86 (when (looking-at "^$") |
|
87 (forward-line -1)) |
|
88 (let ((bol (point))) |
|
89 (end-of-line) |
|
90 (let ((line (buffer-substring bol (point)))) |
|
91 (when (> (length line) 0) |
|
92 line)))) |
|
93 |
|
94 (defun mq-push (&optional patch) |
|
95 "Push patches until PATCH is reached. |
|
96 If PATCH is nil, push at most one patch." |
|
97 (interactive (list (mq-read-patch-name "qunapplied" " to push"))) |
|
98 (let ((root (hg-root)) |
|
99 (prev-buf (current-buffer)) |
|
100 last-line ok) |
|
101 (unless root |
|
102 (error "Cannot push outside a repository!")) |
|
103 (hg-sync-buffers root) |
|
104 (let ((buf-name (format "MQ: Push %s" (or patch "next patch")))) |
|
105 (kill-buffer (get-buffer-create buf-name)) |
|
106 (split-window-vertically) |
|
107 (other-window 1) |
|
108 (switch-to-buffer (get-buffer-create buf-name)) |
|
109 (cd root) |
|
110 (message "Pushing...") |
|
111 (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpush" |
|
112 (if patch (list patch)))) |
|
113 last-line (mq-last-line)) |
|
114 (let ((lines (count-lines (point-min) (point-max)))) |
|
115 (if (and (equal lines 2) (string-match "Now at:" last-line)) |
|
116 (progn |
|
117 (kill-buffer (current-buffer)) |
|
118 (delete-window)) |
|
119 (hg-view-mode prev-buf)))) |
|
120 (mq-refresh-buffers root) |
|
121 (sit-for 0) |
|
122 (when last-line |
|
123 (if ok |
|
124 (message "Pushing... %s" last-line) |
|
125 (error "Pushing... %s" last-line))))) |
|
126 |
|
127 (defun mq-push-all () |
|
128 "Push patches until all are applied." |
|
129 (interactive) |
|
130 (mq-push "-a")) |
|
131 |
|
132 (defun mq-pop (&optional patch) |
|
133 "Pop patches until PATCH is reached. |
|
134 If PATCH is nil, pop at most one patch." |
|
135 (interactive (list (mq-read-patch-name "qapplied" " to pop to"))) |
|
136 (let ((root (hg-root)) |
|
137 last-line ok) |
|
138 (unless root |
|
139 (error "Cannot pop outside a repository!")) |
|
140 (hg-sync-buffers root) |
|
141 (set-buffer (generate-new-buffer "qpop")) |
|
142 (cd root) |
|
143 (message "Popping...") |
|
144 (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpop" |
|
145 (if patch (list patch)))) |
|
146 last-line (mq-last-line)) |
|
147 (kill-buffer (current-buffer)) |
|
148 (mq-refresh-buffers root) |
|
149 (sit-for 0) |
|
150 (when last-line |
|
151 (if ok |
|
152 (message "Popping... %s" last-line) |
|
153 (error "Popping... %s" last-line))))) |
|
154 |
|
155 (defun mq-pop-all () |
|
156 "Push patches until none are applied." |
|
157 (interactive) |
|
158 (mq-pop "-a")) |
|
159 |
|
160 (defun mq-refresh () |
|
161 "Refresh the topmost applied patch." |
|
162 (interactive) |
|
163 (let ((root (hg-root))) |
|
164 (unless root |
|
165 (error "Cannot refresh outside a repository!")) |
|
166 (hg-sync-buffers root) |
|
167 (message "Refreshing patch...") |
|
168 (let ((ret (hg-run "qrefresh"))) |
|
169 (if (equal (car ret) 0) |
|
170 (message "Refreshing patch... done.") |
|
171 (error "Refreshing patch... %s" (hg-chomp (cdr ret))))))) |
|
172 |
|
173 (defun mq-patch-info (msg cmd) |
|
174 (let ((ret (hg-run cmd))) |
|
175 (if (equal (car ret) 0) |
|
176 (message "%s %s" msg (hg-chomp (cdr ret))) |
|
177 (error "%s" (cdr ret))))) |
|
178 |
|
179 (defun mq-top () |
|
180 "Print the name of the topmost applied patch." |
|
181 (interactive) |
|
182 (mq-patch-info "Top patch is " "qtop")) |
|
183 |
|
184 (defun mq-next () |
|
185 "Print the name of the next patch to be pushed." |
|
186 (interactive) |
|
187 (mq-patch-info "Next patch is " "qnext")) |
|
188 |
|
189 (defun mq-previous () |
|
190 "Print the name of the first patch below the topmost applied patch. |
|
191 This would become the active patch if popped to." |
|
192 (interactive) |
|
193 (mq-patch-info "Previous patch is " "qprev")) |
|
194 |
|
195 (defun mq-refresh-edit () |
|
196 "Refresh the topmost applied patch, editing the patch description." |
|
197 (interactive) |
|
198 (error "Not yet implemented")) |
|
199 |
|
200 |
|
201 (provide 'mq) |
|
202 |
|
203 |
|
204 ;;; Local Variables: |
|
205 ;;; prompt-to-byte-compile: nil |
|
206 ;;; end: |