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