##// END OF EJS Templates
mq.el: add mode-line hook
Brendan Cully -
r3370:b7fe334f default
parent child Browse files
Show More
@@ -1,281 +1,327
1 ;;; mq.el --- Emacs support for Mercurial Queues
1 ;;; mq.el --- Emacs support for Mercurial Queues
2
2
3 ;; Copyright (C) 2006 Bryan O'Sullivan
3 ;; Copyright (C) 2006 Bryan O'Sullivan
4
4
5 ;; Author: Bryan O'Sullivan <bos@serpentine.com>
5 ;; Author: Bryan O'Sullivan <bos@serpentine.com>
6
6
7 ;; mq.el is free software; you can redistribute it and/or modify it
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
8 ;; under the terms of version 2 of the GNU General Public License as
9 ;; published by the Free Software Foundation.
9 ;; published by the Free Software Foundation.
10
10
11 ;; mq.el is distributed in the hope that it will be useful, but
11 ;; mq.el is distributed in the hope that it will be useful, but
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;; General Public License for more details.
14 ;; General Public License for more details.
15
15
16 ;; You should have received a copy of the GNU General Public License
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
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
18 ;; C-l'). If not, write to the Free Software Foundation, Inc., 59
19 ;; Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19 ;; Temple Place - Suite 330, Boston, MA 02111-1307, USA.
20
20
21 (require 'mercurial)
21 (require 'mercurial)
22
22
23
23
24 (defcustom mq-mode-hook nil
24 (defcustom mq-mode-hook nil
25 "Hook run when a buffer enters mq-mode."
25 "Hook run when a buffer enters mq-mode."
26 :type 'sexp
26 :type 'sexp
27 :group 'mercurial)
27 :group 'mercurial)
28
28
29 (defcustom mq-global-prefix "\C-cq"
29 (defcustom mq-global-prefix "\C-cq"
30 "The global prefix for Mercurial Queues keymap bindings."
30 "The global prefix for Mercurial Queues keymap bindings."
31 :type 'sexp
31 :type 'sexp
32 :group 'mercurial)
32 :group 'mercurial)
33
33
34 (defcustom mq-edit-mode-hook nil
34 (defcustom mq-edit-mode-hook nil
35 "Hook run after a buffer is populated to edit a patch description."
35 "Hook run after a buffer is populated to edit a patch description."
36 :type 'sexp
36 :type 'sexp
37 :group 'mercurial)
37 :group 'mercurial)
38
38
39
39
40 ;;; Internal variables.
40 ;;; Internal variables.
41
41
42 (defvar mq-mode nil
43 "Is this file managed by MQ?")
44 (make-variable-buffer-local 'mq-mode)
45 (put 'mq-mode 'permanent-local t)
46
42 (defvar mq-patch-history nil)
47 (defvar mq-patch-history nil)
43
48
49 (defvar mq-top-patch '(nil))
50
44 (defvar mq-prev-buffer nil)
51 (defvar mq-prev-buffer nil)
45 (make-variable-buffer-local 'mq-prev-buffer)
52 (make-variable-buffer-local 'mq-prev-buffer)
46 (put 'mq-prev-buffer 'permanent-local t)
53 (put 'mq-prev-buffer 'permanent-local t)
47
54
48
55
49 ;;; Global keymap.
56 ;;; Global keymap.
50
57
51 (defvar mq-global-map (make-sparse-keymap))
58 (defvar mq-global-map (make-sparse-keymap))
52 (fset 'mq-global-map mq-global-map)
59 (fset 'mq-global-map mq-global-map)
53 (global-set-key mq-global-prefix 'mq-global-map)
60 (global-set-key mq-global-prefix 'mq-global-map)
54 (define-key mq-global-map "." 'mq-push)
61 (define-key mq-global-map "." 'mq-push)
55 (define-key mq-global-map ">" 'mq-push-all)
62 (define-key mq-global-map ">" 'mq-push-all)
56 (define-key mq-global-map "," 'mq-pop)
63 (define-key mq-global-map "," 'mq-pop)
57 (define-key mq-global-map "<" 'mq-pop-all)
64 (define-key mq-global-map "<" 'mq-pop-all)
58 (define-key mq-global-map "r" 'mq-refresh)
65 (define-key mq-global-map "r" 'mq-refresh)
59 (define-key mq-global-map "e" 'mq-refresh-edit)
66 (define-key mq-global-map "e" 'mq-refresh-edit)
60 (define-key mq-global-map "n" 'mq-next)
67 (define-key mq-global-map "n" 'mq-next)
61 (define-key mq-global-map "p" 'mq-previous)
68 (define-key mq-global-map "p" 'mq-previous)
62 (define-key mq-global-map "t" 'mq-top)
69 (define-key mq-global-map "t" 'mq-top)
63
70
71 (add-minor-mode 'mq-mode 'mq-mode)
72
64
73
65 ;;; Refresh edit mode keymap.
74 ;;; Refresh edit mode keymap.
66
75
67 (defvar mq-edit-mode-map (make-sparse-keymap))
76 (defvar mq-edit-mode-map (make-sparse-keymap))
68 (define-key mq-edit-mode-map "\C-c\C-c" 'mq-edit-finish)
77 (define-key mq-edit-mode-map "\C-c\C-c" 'mq-edit-finish)
69 (define-key mq-edit-mode-map "\C-c\C-k" 'mq-edit-kill)
78 (define-key mq-edit-mode-map "\C-c\C-k" 'mq-edit-kill)
70
79
71
80
72 ;;; Helper functions.
81 ;;; Helper functions.
73
82
74 (defun mq-read-patch-name (&optional source prompt)
83 (defun mq-read-patch-name (&optional source prompt)
75 "Read a patch name to use with a command.
84 "Read a patch name to use with a command.
76 May return nil, meaning \"use the default\"."
85 May return nil, meaning \"use the default\"."
77 (let ((patches (split-string
86 (let ((patches (split-string
78 (hg-chomp (hg-run0 (or source "qseries"))) "\n")))
87 (hg-chomp (hg-run0 (or source "qseries"))) "\n")))
79 (when current-prefix-arg
88 (when current-prefix-arg
80 (completing-read (format "Patch%s: " (or prompt ""))
89 (completing-read (format "Patch%s: " (or prompt ""))
81 (map 'list 'cons patches patches)
90 (map 'list 'cons patches patches)
82 nil
91 nil
83 nil
92 nil
84 nil
93 nil
85 'mq-patch-history))))
94 'mq-patch-history))))
86
95
87 (defun mq-refresh-buffers (root)
96 (defun mq-refresh-buffers (root)
88 (save-excursion
97 (save-excursion
89 (dolist (buf (hg-buffers-visiting-repo root))
98 (dolist (buf (hg-buffers-visiting-repo root))
90 (when (not (verify-visited-file-modtime buf))
99 (when (not (verify-visited-file-modtime buf))
91 (set-buffer buf)
100 (set-buffer buf)
92 (let ((ctx (hg-buffer-context)))
101 (let ((ctx (hg-buffer-context)))
93 (message "Refreshing %s..." (buffer-name))
102 (message "Refreshing %s..." (buffer-name))
94 (revert-buffer t t t)
103 (revert-buffer t t t)
95 (hg-restore-context ctx)
104 (hg-restore-context ctx)
96 (message "Refreshing %s...done" (buffer-name))))))
105 (message "Refreshing %s...done" (buffer-name))))))
97 (hg-update-mode-lines root))
106 (hg-update-mode-lines root)
107 (mq-update-mode-lines root))
98
108
99 (defun mq-last-line ()
109 (defun mq-last-line ()
100 (goto-char (point-max))
110 (goto-char (point-max))
101 (beginning-of-line)
111 (beginning-of-line)
102 (when (looking-at "^$")
112 (when (looking-at "^$")
103 (forward-line -1))
113 (forward-line -1))
104 (let ((bol (point)))
114 (let ((bol (point)))
105 (end-of-line)
115 (end-of-line)
106 (let ((line (buffer-substring bol (point))))
116 (let ((line (buffer-substring bol (point))))
107 (when (> (length line) 0)
117 (when (> (length line) 0)
108 line))))
118 line))))
109
119
110 (defun mq-push (&optional patch)
120 (defun mq-push (&optional patch)
111 "Push patches until PATCH is reached.
121 "Push patches until PATCH is reached.
112 If PATCH is nil, push at most one patch."
122 If PATCH is nil, push at most one patch."
113 (interactive (list (mq-read-patch-name "qunapplied" " to push")))
123 (interactive (list (mq-read-patch-name "qunapplied" " to push")))
114 (let ((root (hg-root))
124 (let ((root (hg-root))
115 (prev-buf (current-buffer))
125 (prev-buf (current-buffer))
116 last-line ok)
126 last-line ok)
117 (unless root
127 (unless root
118 (error "Cannot push outside a repository!"))
128 (error "Cannot push outside a repository!"))
119 (hg-sync-buffers root)
129 (hg-sync-buffers root)
120 (let ((buf-name (format "MQ: Push %s" (or patch "next patch"))))
130 (let ((buf-name (format "MQ: Push %s" (or patch "next patch"))))
121 (kill-buffer (get-buffer-create buf-name))
131 (kill-buffer (get-buffer-create buf-name))
122 (split-window-vertically)
132 (split-window-vertically)
123 (other-window 1)
133 (other-window 1)
124 (switch-to-buffer (get-buffer-create buf-name))
134 (switch-to-buffer (get-buffer-create buf-name))
125 (cd root)
135 (cd root)
126 (message "Pushing...")
136 (message "Pushing...")
127 (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpush"
137 (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpush"
128 (if patch (list patch))))
138 (if patch (list patch))))
129 last-line (mq-last-line))
139 last-line (mq-last-line))
130 (let ((lines (count-lines (point-min) (point-max))))
140 (let ((lines (count-lines (point-min) (point-max))))
131 (if (and (equal lines 2) (string-match "Now at:" last-line))
141 (if (and (equal lines 2) (string-match "Now at:" last-line))
132 (progn
142 (progn
133 (kill-buffer (current-buffer))
143 (kill-buffer (current-buffer))
134 (delete-window))
144 (delete-window))
135 (hg-view-mode prev-buf))))
145 (hg-view-mode prev-buf))))
136 (mq-refresh-buffers root)
146 (mq-refresh-buffers root)
137 (sit-for 0)
147 (sit-for 0)
138 (when last-line
148 (when last-line
139 (if ok
149 (if ok
140 (message "Pushing... %s" last-line)
150 (message "Pushing... %s" last-line)
141 (error "Pushing... %s" last-line)))))
151 (error "Pushing... %s" last-line)))))
142
152
143 (defun mq-push-all ()
153 (defun mq-push-all ()
144 "Push patches until all are applied."
154 "Push patches until all are applied."
145 (interactive)
155 (interactive)
146 (mq-push "-a"))
156 (mq-push "-a"))
147
157
148 (defun mq-pop (&optional patch)
158 (defun mq-pop (&optional patch)
149 "Pop patches until PATCH is reached.
159 "Pop patches until PATCH is reached.
150 If PATCH is nil, pop at most one patch."
160 If PATCH is nil, pop at most one patch."
151 (interactive (list (mq-read-patch-name "qapplied" " to pop to")))
161 (interactive (list (mq-read-patch-name "qapplied" " to pop to")))
152 (let ((root (hg-root))
162 (let ((root (hg-root))
153 last-line ok)
163 last-line ok)
154 (unless root
164 (unless root
155 (error "Cannot pop outside a repository!"))
165 (error "Cannot pop outside a repository!"))
156 (hg-sync-buffers root)
166 (hg-sync-buffers root)
157 (set-buffer (generate-new-buffer "qpop"))
167 (set-buffer (generate-new-buffer "qpop"))
158 (cd root)
168 (cd root)
159 (message "Popping...")
169 (message "Popping...")
160 (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpop"
170 (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpop"
161 (if patch (list patch))))
171 (if patch (list patch))))
162 last-line (mq-last-line))
172 last-line (mq-last-line))
163 (kill-buffer (current-buffer))
173 (kill-buffer (current-buffer))
164 (mq-refresh-buffers root)
174 (mq-refresh-buffers root)
165 (sit-for 0)
175 (sit-for 0)
166 (when last-line
176 (when last-line
167 (if ok
177 (if ok
168 (message "Popping... %s" last-line)
178 (message "Popping... %s" last-line)
169 (error "Popping... %s" last-line)))))
179 (error "Popping... %s" last-line)))))
170
180
171 (defun mq-pop-all ()
181 (defun mq-pop-all ()
172 "Push patches until none are applied."
182 "Push patches until none are applied."
173 (interactive)
183 (interactive)
174 (mq-pop "-a"))
184 (mq-pop "-a"))
175
185
176 (defun mq-refresh-internal (root &rest args)
186 (defun mq-refresh-internal (root &rest args)
177 (hg-sync-buffers root)
187 (hg-sync-buffers root)
178 (let ((patch (mq-patch-info "qtop")))
188 (let ((patch (mq-patch-info "qtop")))
179 (message "Refreshing %s..." patch)
189 (message "Refreshing %s..." patch)
180 (let ((ret (apply 'hg-run "qrefresh" args)))
190 (let ((ret (apply 'hg-run "qrefresh" args)))
181 (if (equal (car ret) 0)
191 (if (equal (car ret) 0)
182 (message "Refreshing %s... done." patch)
192 (message "Refreshing %s... done." patch)
183 (error "Refreshing %s... %s" patch (hg-chomp (cdr ret)))))))
193 (error "Refreshing %s... %s" patch (hg-chomp (cdr ret)))))))
184
194
185 (defun mq-refresh ()
195 (defun mq-refresh ()
186 "Refresh the topmost applied patch."
196 "Refresh the topmost applied patch."
187 (interactive)
197 (interactive)
188 (let ((root (hg-root)))
198 (let ((root (hg-root)))
189 (unless root
199 (unless root
190 (error "Cannot refresh outside of a repository!"))
200 (error "Cannot refresh outside of a repository!"))
191 (mq-refresh-internal root)))
201 (mq-refresh-internal root)))
192
202
193 (defun mq-patch-info (cmd &optional msg)
203 (defun mq-patch-info (cmd &optional msg)
194 (let* ((ret (hg-run cmd))
204 (let* ((ret (hg-run cmd))
195 (info (hg-chomp (cdr ret))))
205 (info (hg-chomp (cdr ret))))
196 (if (equal (car ret) 0)
206 (if (equal (car ret) 0)
197 (if msg
207 (if msg
198 (message "%s patch: %s" msg info)
208 (message "%s patch: %s" msg info)
199 info)
209 info)
200 (error "%s" info))))
210 (error "%s" info))))
201
211
202 (defun mq-top ()
212 (defun mq-top ()
203 "Print the name of the topmost applied patch."
213 "Print the name of the topmost applied patch."
204 (interactive)
214 (interactive)
205 (mq-patch-info "qtop" "Top"))
215 (mq-patch-info "qtop" "Top"))
206
216
207 (defun mq-next ()
217 (defun mq-next ()
208 "Print the name of the next patch to be pushed."
218 "Print the name of the next patch to be pushed."
209 (interactive)
219 (interactive)
210 (mq-patch-info "qnext" "Next"))
220 (mq-patch-info "qnext" "Next"))
211
221
212 (defun mq-previous ()
222 (defun mq-previous ()
213 "Print the name of the first patch below the topmost applied patch.
223 "Print the name of the first patch below the topmost applied patch.
214 This would become the active patch if popped to."
224 This would become the active patch if popped to."
215 (interactive)
225 (interactive)
216 (mq-patch-info "qprev" "Previous"))
226 (mq-patch-info "qprev" "Previous"))
217
227
218 (defun mq-edit-finish ()
228 (defun mq-edit-finish ()
219 "Finish editing the description of this patch, and refresh the patch."
229 "Finish editing the description of this patch, and refresh the patch."
220 (interactive)
230 (interactive)
221 (unless (equal (mq-patch-info "qtop") mq-top)
231 (unless (equal (mq-patch-info "qtop") mq-top)
222 (error "Topmost patch has changed!"))
232 (error "Topmost patch has changed!"))
223 (hg-sync-buffers hg-root)
233 (hg-sync-buffers hg-root)
224 (mq-refresh-internal hg-root "-m" (buffer-substring (point-min) (point-max)))
234 (mq-refresh-internal hg-root "-m" (buffer-substring (point-min) (point-max)))
225 (let ((buf mq-prev-buffer))
235 (let ((buf mq-prev-buffer))
226 (kill-buffer nil)
236 (kill-buffer nil)
227 (switch-to-buffer buf)))
237 (switch-to-buffer buf)))
228
238
229 (defun mq-edit-kill ()
239 (defun mq-edit-kill ()
230 "Kill the edit currently being prepared."
240 "Kill the edit currently being prepared."
231 (interactive)
241 (interactive)
232 (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this edit? "))
242 (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this edit? "))
233 (let ((buf mq-prev-buffer))
243 (let ((buf mq-prev-buffer))
234 (kill-buffer nil)
244 (kill-buffer nil)
235 (switch-to-buffer buf))))
245 (switch-to-buffer buf))))
236
246
247 (defun mq-get-top (root)
248 (let ((entry (assoc root mq-top-patch)))
249 (if entry
250 (cdr entry))))
251
252 (defun mq-set-top (root patch)
253 (let ((entry (assoc root mq-top-patch)))
254 (if entry
255 (if patch
256 (setcdr entry patch)
257 (setq mq-top-patch (delq entry mq-top-patch)))
258 (setq mq-top-patch (cons (cons root patch) mq-top-patch)))))
259
260 (defun mq-update-mode-lines (root)
261 (let ((cwd default-directory))
262 (cd root)
263 (condition-case nil
264 (mq-set-top root (mq-patch-info "qtop"))
265 (error (mq-set-top root nil)))
266 (cd cwd))
267 (let ((patch (mq-get-top root)))
268 (save-excursion
269 (dolist (buf (hg-buffers-visiting-repo root))
270 (set-buffer buf)
271 (if mq-mode
272 (setq mq-mode (or (and patch (concat " MQ:" patch)) " MQ")))))))
273
274 (defun mq-mode (&optional arg)
275 "Minor mode for Mercurial repositories with an MQ patch queue"
276 (interactive "i")
277 (cond ((hg-root)
278 (setq mq-mode (if (null arg) (not mq-mode)
279 arg))
280 (mq-update-mode-lines (hg-root))))
281 (run-hooks 'mq-mode-hook))
282
237 (defun mq-edit-mode ()
283 (defun mq-edit-mode ()
238 "Mode for editing the description of a patch.
284 "Mode for editing the description of a patch.
239
285
240 Key bindings
286 Key bindings
241 ------------
287 ------------
242 \\[mq-edit-finish] use this description
288 \\[mq-edit-finish] use this description
243 \\[mq-edit-kill] abandon this description"
289 \\[mq-edit-kill] abandon this description"
244 (interactive)
290 (interactive)
245 (use-local-map mq-edit-mode-map)
291 (use-local-map mq-edit-mode-map)
246 (set-syntax-table text-mode-syntax-table)
292 (set-syntax-table text-mode-syntax-table)
247 (setq local-abbrev-table text-mode-abbrev-table
293 (setq local-abbrev-table text-mode-abbrev-table
248 major-mode 'mq-edit-mode
294 major-mode 'mq-edit-mode
249 mode-name "MQ-Edit")
295 mode-name "MQ-Edit")
250 (set-buffer-modified-p nil)
296 (set-buffer-modified-p nil)
251 (setq buffer-undo-list nil)
297 (setq buffer-undo-list nil)
252 (run-hooks 'text-mode-hook 'mq-edit-mode-hook))
298 (run-hooks 'text-mode-hook 'mq-edit-mode-hook))
253
299
254 (defun mq-refresh-edit ()
300 (defun mq-refresh-edit ()
255 "Refresh the topmost applied patch, editing the patch description."
301 "Refresh the topmost applied patch, editing the patch description."
256 (interactive)
302 (interactive)
257 (while mq-prev-buffer
303 (while mq-prev-buffer
258 (set-buffer mq-prev-buffer))
304 (set-buffer mq-prev-buffer))
259 (let ((root (hg-root))
305 (let ((root (hg-root))
260 (prev-buffer (current-buffer))
306 (prev-buffer (current-buffer))
261 (patch (mq-patch-info "qtop")))
307 (patch (mq-patch-info "qtop")))
262 (hg-sync-buffers root)
308 (hg-sync-buffers root)
263 (let ((buf-name (format "*MQ: Edit description of %s*" patch)))
309 (let ((buf-name (format "*MQ: Edit description of %s*" patch)))
264 (switch-to-buffer (get-buffer-create buf-name))
310 (switch-to-buffer (get-buffer-create buf-name))
265 (when (= (point-min) (point-max))
311 (when (= (point-min) (point-max))
266 (set (make-local-variable 'hg-root) root)
312 (set (make-local-variable 'hg-root) root)
267 (set (make-local-variable 'mq-top) patch)
313 (set (make-local-variable 'mq-top) patch)
268 (setq mq-prev-buffer prev-buffer)
314 (setq mq-prev-buffer prev-buffer)
269 (insert (hg-run0 "qheader"))
315 (insert (hg-run0 "qheader"))
270 (goto-char (point-min)))
316 (goto-char (point-min)))
271 (mq-edit-mode)
317 (mq-edit-mode)
272 (cd root)))
318 (cd root)))
273 (message "Type `C-c C-c' to finish editing and refresh the patch."))
319 (message "Type `C-c C-c' to finish editing and refresh the patch."))
274
320
275
321
276 (provide 'mq)
322 (provide 'mq)
277
323
278
324
279 ;;; Local Variables:
325 ;;; Local Variables:
280 ;;; prompt-to-byte-compile: nil
326 ;;; prompt-to-byte-compile: nil
281 ;;; end:
327 ;;; end:
General Comments 0
You need to be logged in to leave comments. Login now