##// END OF EJS Templates
mq.el: add ability to edit a patch.
Bryan O'Sullivan -
r3009:e2bad806 default
parent child Browse files
Show More
@@ -1,206 +1,280
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
35 "Hook run after a buffer is populated to edit a patch description."
36 :type 'sexp
37 :group 'mercurial)
38
34
39
35 ;;; Internal variables.
40 ;;; Internal variables.
36
41
37 (defvar mq-patch-history nil)
42 (defvar mq-patch-history nil)
38
43
44 (defvar mq-prev-buffer nil)
45 (make-variable-buffer-local 'mq-prev-buffer)
46 (put 'mq-prev-buffer 'permanent-local t)
47
39
48
40 ;;; Global keymap.
49 ;;; Global keymap.
41
50
42 (defvar mq-global-map (make-sparse-keymap))
51 (defvar mq-global-map (make-sparse-keymap))
43 (fset 'mq-global-map mq-global-map)
52 (fset 'mq-global-map mq-global-map)
44 (global-set-key mq-global-prefix 'mq-global-map)
53 (global-set-key mq-global-prefix 'mq-global-map)
45 (define-key mq-global-map "." 'mq-push)
54 (define-key mq-global-map "." 'mq-push)
46 (define-key mq-global-map ">" 'mq-push-all)
55 (define-key mq-global-map ">" 'mq-push-all)
47 (define-key mq-global-map "," 'mq-pop)
56 (define-key mq-global-map "," 'mq-pop)
48 (define-key mq-global-map "<" 'mq-pop-all)
57 (define-key mq-global-map "<" 'mq-pop-all)
49 (define-key mq-global-map "r" 'mq-refresh)
58 (define-key mq-global-map "r" 'mq-refresh)
50 (define-key mq-global-map "e" 'mq-refresh-edit)
59 (define-key mq-global-map "e" 'mq-refresh-edit)
51 (define-key mq-global-map "n" 'mq-next)
60 (define-key mq-global-map "n" 'mq-next)
52 (define-key mq-global-map "p" 'mq-previous)
61 (define-key mq-global-map "p" 'mq-previous)
53 (define-key mq-global-map "t" 'mq-top)
62 (define-key mq-global-map "t" 'mq-top)
54
63
55
64
65 ;;; Refresh edit mode keymap.
66
67 (defvar mq-edit-mode-map (make-sparse-keymap))
68 (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)
70
71
56 ;;; Helper functions.
72 ;;; Helper functions.
57
73
58 (defun mq-read-patch-name (&optional source prompt)
74 (defun mq-read-patch-name (&optional source prompt)
59 "Read a patch name to use with a command.
75 "Read a patch name to use with a command.
60 May return nil, meaning \"use the default\"."
76 May return nil, meaning \"use the default\"."
61 (let ((patches (split-string
77 (let ((patches (split-string
62 (hg-chomp (hg-run0 (or source "qseries"))) "\n")))
78 (hg-chomp (hg-run0 (or source "qseries"))) "\n")))
63 (when current-prefix-arg
79 (when current-prefix-arg
64 (completing-read (format "Patch%s: " (or prompt ""))
80 (completing-read (format "Patch%s: " (or prompt ""))
65 (map 'list 'cons patches patches)
81 (map 'list 'cons patches patches)
66 nil
82 nil
67 nil
83 nil
68 nil
84 nil
69 'mq-patch-history))))
85 'mq-patch-history))))
70
86
71 (defun mq-refresh-buffers (root)
87 (defun mq-refresh-buffers (root)
72 (save-excursion
88 (save-excursion
73 (dolist (buf (hg-buffers-visiting-repo root))
89 (dolist (buf (hg-buffers-visiting-repo root))
74 (when (not (verify-visited-file-modtime buf))
90 (when (not (verify-visited-file-modtime buf))
75 (set-buffer buf)
91 (set-buffer buf)
76 (let ((ctx (hg-buffer-context)))
92 (let ((ctx (hg-buffer-context)))
77 (message "Refreshing %s..." (buffer-name))
93 (message "Refreshing %s..." (buffer-name))
78 (revert-buffer t t t)
94 (revert-buffer t t t)
79 (hg-restore-context ctx)
95 (hg-restore-context ctx)
80 (message "Refreshing %s...done" (buffer-name))))))
96 (message "Refreshing %s...done" (buffer-name))))))
81 (hg-update-mode-lines root))
97 (hg-update-mode-lines root))
82
98
83 (defun mq-last-line ()
99 (defun mq-last-line ()
84 (goto-char (point-max))
100 (goto-char (point-max))
85 (beginning-of-line)
101 (beginning-of-line)
86 (when (looking-at "^$")
102 (when (looking-at "^$")
87 (forward-line -1))
103 (forward-line -1))
88 (let ((bol (point)))
104 (let ((bol (point)))
89 (end-of-line)
105 (end-of-line)
90 (let ((line (buffer-substring bol (point))))
106 (let ((line (buffer-substring bol (point))))
91 (when (> (length line) 0)
107 (when (> (length line) 0)
92 line))))
108 line))))
93
109
94 (defun mq-push (&optional patch)
110 (defun mq-push (&optional patch)
95 "Push patches until PATCH is reached.
111 "Push patches until PATCH is reached.
96 If PATCH is nil, push at most one patch."
112 If PATCH is nil, push at most one patch."
97 (interactive (list (mq-read-patch-name "qunapplied" " to push")))
113 (interactive (list (mq-read-patch-name "qunapplied" " to push")))
98 (let ((root (hg-root))
114 (let ((root (hg-root))
99 (prev-buf (current-buffer))
115 (prev-buf (current-buffer))
100 last-line ok)
116 last-line ok)
101 (unless root
117 (unless root
102 (error "Cannot push outside a repository!"))
118 (error "Cannot push outside a repository!"))
103 (hg-sync-buffers root)
119 (hg-sync-buffers root)
104 (let ((buf-name (format "MQ: Push %s" (or patch "next patch"))))
120 (let ((buf-name (format "MQ: Push %s" (or patch "next patch"))))
105 (kill-buffer (get-buffer-create buf-name))
121 (kill-buffer (get-buffer-create buf-name))
106 (split-window-vertically)
122 (split-window-vertically)
107 (other-window 1)
123 (other-window 1)
108 (switch-to-buffer (get-buffer-create buf-name))
124 (switch-to-buffer (get-buffer-create buf-name))
109 (cd root)
125 (cd root)
110 (message "Pushing...")
126 (message "Pushing...")
111 (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpush"
127 (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpush"
112 (if patch (list patch))))
128 (if patch (list patch))))
113 last-line (mq-last-line))
129 last-line (mq-last-line))
114 (let ((lines (count-lines (point-min) (point-max))))
130 (let ((lines (count-lines (point-min) (point-max))))
115 (if (and (equal lines 2) (string-match "Now at:" last-line))
131 (if (and (equal lines 2) (string-match "Now at:" last-line))
116 (progn
132 (progn
117 (kill-buffer (current-buffer))
133 (kill-buffer (current-buffer))
118 (delete-window))
134 (delete-window))
119 (hg-view-mode prev-buf))))
135 (hg-view-mode prev-buf))))
120 (mq-refresh-buffers root)
136 (mq-refresh-buffers root)
121 (sit-for 0)
137 (sit-for 0)
122 (when last-line
138 (when last-line
123 (if ok
139 (if ok
124 (message "Pushing... %s" last-line)
140 (message "Pushing... %s" last-line)
125 (error "Pushing... %s" last-line)))))
141 (error "Pushing... %s" last-line)))))
126
142
127 (defun mq-push-all ()
143 (defun mq-push-all ()
128 "Push patches until all are applied."
144 "Push patches until all are applied."
129 (interactive)
145 (interactive)
130 (mq-push "-a"))
146 (mq-push "-a"))
131
147
132 (defun mq-pop (&optional patch)
148 (defun mq-pop (&optional patch)
133 "Pop patches until PATCH is reached.
149 "Pop patches until PATCH is reached.
134 If PATCH is nil, pop at most one patch."
150 If PATCH is nil, pop at most one patch."
135 (interactive (list (mq-read-patch-name "qapplied" " to pop to")))
151 (interactive (list (mq-read-patch-name "qapplied" " to pop to")))
136 (let ((root (hg-root))
152 (let ((root (hg-root))
137 last-line ok)
153 last-line ok)
138 (unless root
154 (unless root
139 (error "Cannot pop outside a repository!"))
155 (error "Cannot pop outside a repository!"))
140 (hg-sync-buffers root)
156 (hg-sync-buffers root)
141 (set-buffer (generate-new-buffer "qpop"))
157 (set-buffer (generate-new-buffer "qpop"))
142 (cd root)
158 (cd root)
143 (message "Popping...")
159 (message "Popping...")
144 (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpop"
160 (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpop"
145 (if patch (list patch))))
161 (if patch (list patch))))
146 last-line (mq-last-line))
162 last-line (mq-last-line))
147 (kill-buffer (current-buffer))
163 (kill-buffer (current-buffer))
148 (mq-refresh-buffers root)
164 (mq-refresh-buffers root)
149 (sit-for 0)
165 (sit-for 0)
150 (when last-line
166 (when last-line
151 (if ok
167 (if ok
152 (message "Popping... %s" last-line)
168 (message "Popping... %s" last-line)
153 (error "Popping... %s" last-line)))))
169 (error "Popping... %s" last-line)))))
154
170
155 (defun mq-pop-all ()
171 (defun mq-pop-all ()
156 "Push patches until none are applied."
172 "Push patches until none are applied."
157 (interactive)
173 (interactive)
158 (mq-pop "-a"))
174 (mq-pop "-a"))
159
175
176 (defun mq-refresh-internal (root &rest args)
177 (hg-sync-buffers root)
178 (let ((patch (mq-patch-info "qtop")))
179 (message "Refreshing %s..." patch)
180 (let ((ret (apply 'hg-run "qrefresh" args)))
181 (if (equal (car ret) 0)
182 (message "Refreshing %s... done." patch)
183 (error "Refreshing %s... %s" patch (hg-chomp (cdr ret)))))))
184
160 (defun mq-refresh ()
185 (defun mq-refresh ()
161 "Refresh the topmost applied patch."
186 "Refresh the topmost applied patch."
162 (interactive)
187 (interactive)
163 (let ((root (hg-root)))
188 (let ((root (hg-root)))
164 (unless root
189 (unless root
165 (error "Cannot refresh outside a repository!"))
190 (error "Cannot refresh outside of a repository!"))
166 (hg-sync-buffers root)
191 (mq-refresh-internal root)))
167 (message "Refreshing patch...")
192
168 (let ((ret (hg-run "qrefresh")))
193 (defun mq-patch-info (cmd &optional msg)
194 (let* ((ret (hg-run cmd))
195 (info (hg-chomp (cdr ret))))
169 (if (equal (car ret) 0)
196 (if (equal (car ret) 0)
170 (message "Refreshing patch... done.")
197 (if msg
171 (error "Refreshing patch... %s" (hg-chomp (cdr ret)))))))
198 (message "%s patch: %s" msg info)
172
199 info)
173 (defun mq-patch-info (msg cmd)
200 (error "%s" info))))
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
201
179 (defun mq-top ()
202 (defun mq-top ()
180 "Print the name of the topmost applied patch."
203 "Print the name of the topmost applied patch."
181 (interactive)
204 (interactive)
182 (mq-patch-info "Top patch is " "qtop"))
205 (mq-patch-info "qtop" "Top"))
183
206
184 (defun mq-next ()
207 (defun mq-next ()
185 "Print the name of the next patch to be pushed."
208 "Print the name of the next patch to be pushed."
186 (interactive)
209 (interactive)
187 (mq-patch-info "Next patch is " "qnext"))
210 (mq-patch-info "qnext" "Next"))
188
211
189 (defun mq-previous ()
212 (defun mq-previous ()
190 "Print the name of the first patch below the topmost applied patch.
213 "Print the name of the first patch below the topmost applied patch.
191 This would become the active patch if popped to."
214 This would become the active patch if popped to."
192 (interactive)
215 (interactive)
193 (mq-patch-info "Previous patch is " "qprev"))
216 (mq-patch-info "qprev" "Previous"))
217
218 (defun mq-edit-finish ()
219 (interactive)
220 (unless (equal (mq-patch-info "qtop") mq-top)
221 (error "Topmost patch has changed!"))
222 (hg-sync-buffers hg-root)
223 (mq-refresh-internal hg-root "-m" (buffer-substring (point-min) (point-max)))
224 (let ((buf mq-prev-buffer))
225 (kill-buffer nil)
226 (switch-to-buffer buf)))
227
228 (defun mq-edit-kill ()
229 "Kill the edit currently being prepared."
230 (interactive)
231 (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this edit? "))
232 (let ((buf mq-prev-buffer))
233 (kill-buffer nil)
234 (switch-to-buffer buf))))
235
236 (defun mq-edit-mode ()
237 "Mode for editing the description of a patch.
238
239 Key bindings
240 ------------
241 \\[mq-edit-finish] use this description
242 \\[mq-edit-kill] abandon this description"
243 (interactive)
244 (use-local-map mq-edit-mode-map)
245 (set-syntax-table text-mode-syntax-table)
246 (setq local-abbrev-table text-mode-abbrev-table
247 major-mode 'mq-edit-mode
248 mode-name "MQ-Edit")
249 (set-buffer-modified-p nil)
250 (setq buffer-undo-list nil)
251 (run-hooks 'text-mode-hook 'mq-edit-mode-hook))
194
252
195 (defun mq-refresh-edit ()
253 (defun mq-refresh-edit ()
196 "Refresh the topmost applied patch, editing the patch description."
254 "Refresh the topmost applied patch, editing the patch description."
197 (interactive)
255 (interactive)
198 (error "Not yet implemented"))
256 (while mq-prev-buffer
257 (set-buffer mq-prev-buffer))
258 (let ((root (hg-root))
259 (prev-buffer (current-buffer))
260 (patch (mq-patch-info "qtop")))
261 (hg-sync-buffers root)
262 (let ((buf-name (format "*MQ: Edit description of %s*" patch)))
263 (switch-to-buffer (get-buffer-create buf-name))
264 (when (= (point-min) (point-max))
265 (set (make-local-variable 'hg-root) root)
266 (set (make-local-variable 'mq-top) patch)
267 (setq mq-prev-buffer prev-buffer)
268 (insert (hg-run0 "qheader"))
269 (goto-char (point-min)))
270 (mq-edit-mode)
271 (cd root)))
272 (message "Type `C-c C-c' to finish editing and refresh the patch."))
199
273
200
274
201 (provide 'mq)
275 (provide 'mq)
202
276
203
277
204 ;;; Local Variables:
278 ;;; Local Variables:
205 ;;; prompt-to-byte-compile: nil
279 ;;; prompt-to-byte-compile: nil
206 ;;; end:
280 ;;; end:
General Comments 0
You need to be logged in to leave comments. Login now