Show More
@@ -1,346 +1,355 b'' | |||||
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 |
|
42 | (defvar mq-mode nil | |
43 | "Is this file managed by MQ?") |
|
43 | "Is this file managed by MQ?") | |
44 | (make-variable-buffer-local 'mq-mode) |
|
44 | (make-variable-buffer-local 'mq-mode) | |
45 | (put 'mq-mode 'permanent-local t) |
|
45 | (put 'mq-mode 'permanent-local t) | |
46 |
|
46 | |||
47 | (defvar mq-patch-history nil) |
|
47 | (defvar mq-patch-history nil) | |
48 |
|
48 | |||
49 | (defvar mq-top-patch '(nil)) |
|
49 | (defvar mq-top-patch '(nil)) | |
50 |
|
50 | |||
51 | (defvar mq-prev-buffer nil) |
|
51 | (defvar mq-prev-buffer nil) | |
52 | (make-variable-buffer-local 'mq-prev-buffer) |
|
52 | (make-variable-buffer-local 'mq-prev-buffer) | |
53 | (put 'mq-prev-buffer 'permanent-local t) |
|
53 | (put 'mq-prev-buffer 'permanent-local t) | |
54 |
|
54 | |||
55 |
|
55 | |||
56 | ;;; Global keymap. |
|
56 | ;;; Global keymap. | |
57 |
|
57 | |||
58 | (defvar mq-global-map (make-sparse-keymap)) |
|
58 | (defvar mq-global-map (make-sparse-keymap)) | |
59 | (fset 'mq-global-map mq-global-map) |
|
59 | (fset 'mq-global-map mq-global-map) | |
60 | (global-set-key mq-global-prefix 'mq-global-map) |
|
60 | (global-set-key mq-global-prefix 'mq-global-map) | |
61 | (define-key mq-global-map "." 'mq-push) |
|
61 | (define-key mq-global-map "." 'mq-push) | |
62 | (define-key mq-global-map ">" 'mq-push-all) |
|
62 | (define-key mq-global-map ">" 'mq-push-all) | |
63 | (define-key mq-global-map "," 'mq-pop) |
|
63 | (define-key mq-global-map "," 'mq-pop) | |
64 | (define-key mq-global-map "<" 'mq-pop-all) |
|
64 | (define-key mq-global-map "<" 'mq-pop-all) | |
65 | (define-key mq-global-map "r" 'mq-refresh) |
|
65 | (define-key mq-global-map "r" 'mq-refresh) | |
66 | (define-key mq-global-map "e" 'mq-refresh-edit) |
|
66 | (define-key mq-global-map "e" 'mq-refresh-edit) | |
67 | (define-key mq-global-map "i" 'mq-new) |
|
67 | (define-key mq-global-map "i" 'mq-new) | |
68 | (define-key mq-global-map "n" 'mq-next) |
|
68 | (define-key mq-global-map "n" 'mq-next) | |
69 | (define-key mq-global-map "p" 'mq-previous) |
|
69 | (define-key mq-global-map "p" 'mq-previous) | |
|
70 | (define-key mq-global-map "s" 'mq-edit-series) | |||
70 | (define-key mq-global-map "t" 'mq-top) |
|
71 | (define-key mq-global-map "t" 'mq-top) | |
71 |
|
72 | |||
72 | (add-minor-mode 'mq-mode 'mq-mode) |
|
73 | (add-minor-mode 'mq-mode 'mq-mode) | |
73 |
|
74 | |||
74 |
|
75 | |||
75 | ;;; Refresh edit mode keymap. |
|
76 | ;;; Refresh edit mode keymap. | |
76 |
|
77 | |||
77 | (defvar mq-edit-mode-map (make-sparse-keymap)) |
|
78 | (defvar mq-edit-mode-map (make-sparse-keymap)) | |
78 | (define-key mq-edit-mode-map "\C-c\C-c" 'mq-edit-finish) |
|
79 | (define-key mq-edit-mode-map "\C-c\C-c" 'mq-edit-finish) | |
79 | (define-key mq-edit-mode-map "\C-c\C-k" 'mq-edit-kill) |
|
80 | (define-key mq-edit-mode-map "\C-c\C-k" 'mq-edit-kill) | |
80 |
|
81 | |||
81 |
|
82 | |||
82 | ;;; Helper functions. |
|
83 | ;;; Helper functions. | |
83 |
|
84 | |||
84 | (defun mq-read-patch-name (&optional source prompt force) |
|
85 | (defun mq-read-patch-name (&optional source prompt force) | |
85 | "Read a patch name to use with a command. |
|
86 | "Read a patch name to use with a command. | |
86 | May return nil, meaning \"use the default\"." |
|
87 | May return nil, meaning \"use the default\"." | |
87 | (let ((patches (split-string |
|
88 | (let ((patches (split-string | |
88 | (hg-chomp (hg-run0 (or source "qseries"))) "\n"))) |
|
89 | (hg-chomp (hg-run0 (or source "qseries"))) "\n"))) | |
89 | (when force |
|
90 | (when force | |
90 | (completing-read (format "Patch%s: " (or prompt "")) |
|
91 | (completing-read (format "Patch%s: " (or prompt "")) | |
91 | (map 'list 'cons patches patches) |
|
92 | (map 'list 'cons patches patches) | |
92 | nil |
|
93 | nil | |
93 | nil |
|
94 | nil | |
94 | nil |
|
95 | nil | |
95 | 'mq-patch-history)))) |
|
96 | 'mq-patch-history)))) | |
96 |
|
97 | |||
97 | (defun mq-refresh-buffers (root) |
|
98 | (defun mq-refresh-buffers (root) | |
98 | (save-excursion |
|
99 | (save-excursion | |
99 | (dolist (buf (hg-buffers-visiting-repo root)) |
|
100 | (dolist (buf (hg-buffers-visiting-repo root)) | |
100 | (when (not (verify-visited-file-modtime buf)) |
|
101 | (when (not (verify-visited-file-modtime buf)) | |
101 | (set-buffer buf) |
|
102 | (set-buffer buf) | |
102 | (let ((ctx (hg-buffer-context))) |
|
103 | (let ((ctx (hg-buffer-context))) | |
103 | (message "Refreshing %s..." (buffer-name)) |
|
104 | (message "Refreshing %s..." (buffer-name)) | |
104 | (revert-buffer t t t) |
|
105 | (revert-buffer t t t) | |
105 | (hg-restore-context ctx) |
|
106 | (hg-restore-context ctx) | |
106 | (message "Refreshing %s...done" (buffer-name)))))) |
|
107 | (message "Refreshing %s...done" (buffer-name)))))) | |
107 | (hg-update-mode-lines root) |
|
108 | (hg-update-mode-lines root) | |
108 | (mq-update-mode-lines root)) |
|
109 | (mq-update-mode-lines root)) | |
109 |
|
110 | |||
110 | (defun mq-last-line () |
|
111 | (defun mq-last-line () | |
111 | (goto-char (point-max)) |
|
112 | (goto-char (point-max)) | |
112 | (beginning-of-line) |
|
113 | (beginning-of-line) | |
113 | (when (looking-at "^$") |
|
114 | (when (looking-at "^$") | |
114 | (forward-line -1)) |
|
115 | (forward-line -1)) | |
115 | (let ((bol (point))) |
|
116 | (let ((bol (point))) | |
116 | (end-of-line) |
|
117 | (end-of-line) | |
117 | (let ((line (buffer-substring bol (point)))) |
|
118 | (let ((line (buffer-substring bol (point)))) | |
118 | (when (> (length line) 0) |
|
119 | (when (> (length line) 0) | |
119 | line)))) |
|
120 | line)))) | |
120 |
|
121 | |||
121 | (defun mq-push (&optional patch) |
|
122 | (defun mq-push (&optional patch) | |
122 | "Push patches until PATCH is reached. |
|
123 | "Push patches until PATCH is reached. | |
123 | If PATCH is nil, push at most one patch." |
|
124 | If PATCH is nil, push at most one patch." | |
124 | (interactive (list (mq-read-patch-name "qunapplied" " to push" |
|
125 | (interactive (list (mq-read-patch-name "qunapplied" " to push" | |
125 | current-prefix-arg))) |
|
126 | current-prefix-arg))) | |
126 | (let ((root (hg-root)) |
|
127 | (let ((root (hg-root)) | |
127 | (prev-buf (current-buffer)) |
|
128 | (prev-buf (current-buffer)) | |
128 | last-line ok) |
|
129 | last-line ok) | |
129 | (unless root |
|
130 | (unless root | |
130 | (error "Cannot push outside a repository!")) |
|
131 | (error "Cannot push outside a repository!")) | |
131 | (hg-sync-buffers root) |
|
132 | (hg-sync-buffers root) | |
132 | (let ((buf-name (format "MQ: Push %s" (or patch "next patch")))) |
|
133 | (let ((buf-name (format "MQ: Push %s" (or patch "next patch")))) | |
133 | (kill-buffer (get-buffer-create buf-name)) |
|
134 | (kill-buffer (get-buffer-create buf-name)) | |
134 | (split-window-vertically) |
|
135 | (split-window-vertically) | |
135 | (other-window 1) |
|
136 | (other-window 1) | |
136 | (switch-to-buffer (get-buffer-create buf-name)) |
|
137 | (switch-to-buffer (get-buffer-create buf-name)) | |
137 | (cd root) |
|
138 | (cd root) | |
138 | (message "Pushing...") |
|
139 | (message "Pushing...") | |
139 | (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpush" |
|
140 | (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpush" | |
140 | (if patch (list patch)))) |
|
141 | (if patch (list patch)))) | |
141 | last-line (mq-last-line)) |
|
142 | last-line (mq-last-line)) | |
142 | (let ((lines (count-lines (point-min) (point-max)))) |
|
143 | (let ((lines (count-lines (point-min) (point-max)))) | |
143 | (if (and (equal lines 2) (string-match "Now at:" last-line)) |
|
144 | (if (and (equal lines 2) (string-match "Now at:" last-line)) | |
144 | (progn |
|
145 | (progn | |
145 | (kill-buffer (current-buffer)) |
|
146 | (kill-buffer (current-buffer)) | |
146 | (delete-window)) |
|
147 | (delete-window)) | |
147 | (hg-view-mode prev-buf)))) |
|
148 | (hg-view-mode prev-buf)))) | |
148 | (mq-refresh-buffers root) |
|
149 | (mq-refresh-buffers root) | |
149 | (sit-for 0) |
|
150 | (sit-for 0) | |
150 | (when last-line |
|
151 | (when last-line | |
151 | (if ok |
|
152 | (if ok | |
152 | (message "Pushing... %s" last-line) |
|
153 | (message "Pushing... %s" last-line) | |
153 | (error "Pushing... %s" last-line))))) |
|
154 | (error "Pushing... %s" last-line))))) | |
154 |
|
155 | |||
155 | (defun mq-push-all () |
|
156 | (defun mq-push-all () | |
156 | "Push patches until all are applied." |
|
157 | "Push patches until all are applied." | |
157 | (interactive) |
|
158 | (interactive) | |
158 | (mq-push "-a")) |
|
159 | (mq-push "-a")) | |
159 |
|
160 | |||
160 | (defun mq-pop (&optional patch) |
|
161 | (defun mq-pop (&optional patch) | |
161 | "Pop patches until PATCH is reached. |
|
162 | "Pop patches until PATCH is reached. | |
162 | If PATCH is nil, pop at most one patch." |
|
163 | If PATCH is nil, pop at most one patch." | |
163 | (interactive (list (mq-read-patch-name "qapplied" " to pop to" |
|
164 | (interactive (list (mq-read-patch-name "qapplied" " to pop to" | |
164 | current-prefix-arg))) |
|
165 | current-prefix-arg))) | |
165 | (let ((root (hg-root)) |
|
166 | (let ((root (hg-root)) | |
166 | last-line ok) |
|
167 | last-line ok) | |
167 | (unless root |
|
168 | (unless root | |
168 | (error "Cannot pop outside a repository!")) |
|
169 | (error "Cannot pop outside a repository!")) | |
169 | (hg-sync-buffers root) |
|
170 | (hg-sync-buffers root) | |
170 | (set-buffer (generate-new-buffer "qpop")) |
|
171 | (set-buffer (generate-new-buffer "qpop")) | |
171 | (cd root) |
|
172 | (cd root) | |
172 | (message "Popping...") |
|
173 | (message "Popping...") | |
173 | (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpop" |
|
174 | (setq ok (= 0 (apply 'call-process (hg-binary) nil t t "qpop" | |
174 | (if patch (list patch)))) |
|
175 | (if patch (list patch)))) | |
175 | last-line (mq-last-line)) |
|
176 | last-line (mq-last-line)) | |
176 | (kill-buffer (current-buffer)) |
|
177 | (kill-buffer (current-buffer)) | |
177 | (mq-refresh-buffers root) |
|
178 | (mq-refresh-buffers root) | |
178 | (sit-for 0) |
|
179 | (sit-for 0) | |
179 | (when last-line |
|
180 | (when last-line | |
180 | (if ok |
|
181 | (if ok | |
181 | (message "Popping... %s" last-line) |
|
182 | (message "Popping... %s" last-line) | |
182 | (error "Popping... %s" last-line))))) |
|
183 | (error "Popping... %s" last-line))))) | |
183 |
|
184 | |||
184 | (defun mq-pop-all () |
|
185 | (defun mq-pop-all () | |
185 | "Push patches until none are applied." |
|
186 | "Push patches until none are applied." | |
186 | (interactive) |
|
187 | (interactive) | |
187 | (mq-pop "-a")) |
|
188 | (mq-pop "-a")) | |
188 |
|
189 | |||
189 | (defun mq-refresh-internal (root &rest args) |
|
190 | (defun mq-refresh-internal (root &rest args) | |
190 | (hg-sync-buffers root) |
|
191 | (hg-sync-buffers root) | |
191 | (let ((patch (mq-patch-info "qtop"))) |
|
192 | (let ((patch (mq-patch-info "qtop"))) | |
192 | (message "Refreshing %s..." patch) |
|
193 | (message "Refreshing %s..." patch) | |
193 | (let ((ret (apply 'hg-run "qrefresh" args))) |
|
194 | (let ((ret (apply 'hg-run "qrefresh" args))) | |
194 | (if (equal (car ret) 0) |
|
195 | (if (equal (car ret) 0) | |
195 | (message "Refreshing %s... done." patch) |
|
196 | (message "Refreshing %s... done." patch) | |
196 | (error "Refreshing %s... %s" patch (hg-chomp (cdr ret))))))) |
|
197 | (error "Refreshing %s... %s" patch (hg-chomp (cdr ret))))))) | |
197 |
|
198 | |||
198 | (defun mq-refresh () |
|
199 | (defun mq-refresh () | |
199 | "Refresh the topmost applied patch." |
|
200 | "Refresh the topmost applied patch." | |
200 | (interactive) |
|
201 | (interactive) | |
201 | (let ((root (hg-root))) |
|
202 | (let ((root (hg-root))) | |
202 | (unless root |
|
203 | (unless root | |
203 | (error "Cannot refresh outside of a repository!")) |
|
204 | (error "Cannot refresh outside of a repository!")) | |
204 | (mq-refresh-internal root))) |
|
205 | (mq-refresh-internal root))) | |
205 |
|
206 | |||
206 | (defun mq-patch-info (cmd &optional msg) |
|
207 | (defun mq-patch-info (cmd &optional msg) | |
207 | (let* ((ret (hg-run cmd)) |
|
208 | (let* ((ret (hg-run cmd)) | |
208 | (info (hg-chomp (cdr ret)))) |
|
209 | (info (hg-chomp (cdr ret)))) | |
209 | (if (equal (car ret) 0) |
|
210 | (if (equal (car ret) 0) | |
210 | (if msg |
|
211 | (if msg | |
211 | (message "%s patch: %s" msg info) |
|
212 | (message "%s patch: %s" msg info) | |
212 | info) |
|
213 | info) | |
213 | (error "%s" info)))) |
|
214 | (error "%s" info)))) | |
214 |
|
215 | |||
215 | (defun mq-top () |
|
216 | (defun mq-top () | |
216 | "Print the name of the topmost applied patch." |
|
217 | "Print the name of the topmost applied patch." | |
217 | (interactive) |
|
218 | (interactive) | |
218 | (mq-patch-info "qtop" "Top")) |
|
219 | (mq-patch-info "qtop" "Top")) | |
219 |
|
220 | |||
220 | (defun mq-next () |
|
221 | (defun mq-next () | |
221 | "Print the name of the next patch to be pushed." |
|
222 | "Print the name of the next patch to be pushed." | |
222 | (interactive) |
|
223 | (interactive) | |
223 | (mq-patch-info "qnext" "Next")) |
|
224 | (mq-patch-info "qnext" "Next")) | |
224 |
|
225 | |||
225 | (defun mq-previous () |
|
226 | (defun mq-previous () | |
226 | "Print the name of the first patch below the topmost applied patch. |
|
227 | "Print the name of the first patch below the topmost applied patch. | |
227 | This would become the active patch if popped to." |
|
228 | This would become the active patch if popped to." | |
228 | (interactive) |
|
229 | (interactive) | |
229 | (mq-patch-info "qprev" "Previous")) |
|
230 | (mq-patch-info "qprev" "Previous")) | |
230 |
|
231 | |||
231 | (defun mq-edit-finish () |
|
232 | (defun mq-edit-finish () | |
232 | "Finish editing the description of this patch, and refresh the patch." |
|
233 | "Finish editing the description of this patch, and refresh the patch." | |
233 | (interactive) |
|
234 | (interactive) | |
234 | (unless (equal (mq-patch-info "qtop") mq-top) |
|
235 | (unless (equal (mq-patch-info "qtop") mq-top) | |
235 | (error "Topmost patch has changed!")) |
|
236 | (error "Topmost patch has changed!")) | |
236 | (hg-sync-buffers hg-root) |
|
237 | (hg-sync-buffers hg-root) | |
237 | (mq-refresh-internal hg-root "-m" (buffer-substring (point-min) (point-max))) |
|
238 | (mq-refresh-internal hg-root "-m" (buffer-substring (point-min) (point-max))) | |
238 | (let ((buf mq-prev-buffer)) |
|
239 | (let ((buf mq-prev-buffer)) | |
239 | (kill-buffer nil) |
|
240 | (kill-buffer nil) | |
240 | (switch-to-buffer buf))) |
|
241 | (switch-to-buffer buf))) | |
241 |
|
242 | |||
242 | (defun mq-edit-kill () |
|
243 | (defun mq-edit-kill () | |
243 | "Kill the edit currently being prepared." |
|
244 | "Kill the edit currently being prepared." | |
244 | (interactive) |
|
245 | (interactive) | |
245 | (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this edit? ")) |
|
246 | (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this edit? ")) | |
246 | (let ((buf mq-prev-buffer)) |
|
247 | (let ((buf mq-prev-buffer)) | |
247 | (kill-buffer nil) |
|
248 | (kill-buffer nil) | |
248 | (switch-to-buffer buf)))) |
|
249 | (switch-to-buffer buf)))) | |
249 |
|
250 | |||
250 | (defun mq-get-top (root) |
|
251 | (defun mq-get-top (root) | |
251 | (let ((entry (assoc root mq-top-patch))) |
|
252 | (let ((entry (assoc root mq-top-patch))) | |
252 | (if entry |
|
253 | (if entry | |
253 | (cdr entry)))) |
|
254 | (cdr entry)))) | |
254 |
|
255 | |||
255 | (defun mq-set-top (root patch) |
|
256 | (defun mq-set-top (root patch) | |
256 | (let ((entry (assoc root mq-top-patch))) |
|
257 | (let ((entry (assoc root mq-top-patch))) | |
257 | (if entry |
|
258 | (if entry | |
258 | (if patch |
|
259 | (if patch | |
259 | (setcdr entry patch) |
|
260 | (setcdr entry patch) | |
260 | (setq mq-top-patch (delq entry mq-top-patch))) |
|
261 | (setq mq-top-patch (delq entry mq-top-patch))) | |
261 | (setq mq-top-patch (cons (cons root patch) mq-top-patch))))) |
|
262 | (setq mq-top-patch (cons (cons root patch) mq-top-patch))))) | |
262 |
|
263 | |||
263 | (defun mq-update-mode-lines (root) |
|
264 | (defun mq-update-mode-lines (root) | |
264 | (let ((cwd default-directory)) |
|
265 | (let ((cwd default-directory)) | |
265 | (cd root) |
|
266 | (cd root) | |
266 | (condition-case nil |
|
267 | (condition-case nil | |
267 | (mq-set-top root (mq-patch-info "qtop")) |
|
268 | (mq-set-top root (mq-patch-info "qtop")) | |
268 | (error (mq-set-top root nil))) |
|
269 | (error (mq-set-top root nil))) | |
269 | (cd cwd)) |
|
270 | (cd cwd)) | |
270 | (let ((patch (mq-get-top root))) |
|
271 | (let ((patch (mq-get-top root))) | |
271 | (save-excursion |
|
272 | (save-excursion | |
272 | (dolist (buf (hg-buffers-visiting-repo root)) |
|
273 | (dolist (buf (hg-buffers-visiting-repo root)) | |
273 | (set-buffer buf) |
|
274 | (set-buffer buf) | |
274 | (if mq-mode |
|
275 | (if mq-mode | |
275 | (setq mq-mode (or (and patch (concat " MQ:" patch)) " MQ"))))))) |
|
276 | (setq mq-mode (or (and patch (concat " MQ:" patch)) " MQ"))))))) | |
276 |
|
277 | |||
277 | (defun mq-mode (&optional arg) |
|
278 | (defun mq-mode (&optional arg) | |
278 | "Minor mode for Mercurial repositories with an MQ patch queue" |
|
279 | "Minor mode for Mercurial repositories with an MQ patch queue" | |
279 | (interactive "i") |
|
280 | (interactive "i") | |
280 | (cond ((hg-root) |
|
281 | (cond ((hg-root) | |
281 | (setq mq-mode (if (null arg) (not mq-mode) |
|
282 | (setq mq-mode (if (null arg) (not mq-mode) | |
282 | arg)) |
|
283 | arg)) | |
283 | (mq-update-mode-lines (hg-root)))) |
|
284 | (mq-update-mode-lines (hg-root)))) | |
284 | (run-hooks 'mq-mode-hook)) |
|
285 | (run-hooks 'mq-mode-hook)) | |
285 |
|
286 | |||
286 | (defun mq-edit-mode () |
|
287 | (defun mq-edit-mode () | |
287 | "Mode for editing the description of a patch. |
|
288 | "Mode for editing the description of a patch. | |
288 |
|
289 | |||
289 | Key bindings |
|
290 | Key bindings | |
290 | ------------ |
|
291 | ------------ | |
291 | \\[mq-edit-finish] use this description |
|
292 | \\[mq-edit-finish] use this description | |
292 | \\[mq-edit-kill] abandon this description" |
|
293 | \\[mq-edit-kill] abandon this description" | |
293 | (interactive) |
|
294 | (interactive) | |
294 | (use-local-map mq-edit-mode-map) |
|
295 | (use-local-map mq-edit-mode-map) | |
295 | (set-syntax-table text-mode-syntax-table) |
|
296 | (set-syntax-table text-mode-syntax-table) | |
296 | (setq local-abbrev-table text-mode-abbrev-table |
|
297 | (setq local-abbrev-table text-mode-abbrev-table | |
297 | major-mode 'mq-edit-mode |
|
298 | major-mode 'mq-edit-mode | |
298 | mode-name "MQ-Edit") |
|
299 | mode-name "MQ-Edit") | |
299 | (set-buffer-modified-p nil) |
|
300 | (set-buffer-modified-p nil) | |
300 | (setq buffer-undo-list nil) |
|
301 | (setq buffer-undo-list nil) | |
301 | (run-hooks 'text-mode-hook 'mq-edit-mode-hook)) |
|
302 | (run-hooks 'text-mode-hook 'mq-edit-mode-hook)) | |
302 |
|
303 | |||
303 | (defun mq-refresh-edit () |
|
304 | (defun mq-refresh-edit () | |
304 | "Refresh the topmost applied patch, editing the patch description." |
|
305 | "Refresh the topmost applied patch, editing the patch description." | |
305 | (interactive) |
|
306 | (interactive) | |
306 | (while mq-prev-buffer |
|
307 | (while mq-prev-buffer | |
307 | (set-buffer mq-prev-buffer)) |
|
308 | (set-buffer mq-prev-buffer)) | |
308 | (let ((root (hg-root)) |
|
309 | (let ((root (hg-root)) | |
309 | (prev-buffer (current-buffer)) |
|
310 | (prev-buffer (current-buffer)) | |
310 | (patch (mq-patch-info "qtop"))) |
|
311 | (patch (mq-patch-info "qtop"))) | |
311 | (hg-sync-buffers root) |
|
312 | (hg-sync-buffers root) | |
312 | (let ((buf-name (format "*MQ: Edit description of %s*" patch))) |
|
313 | (let ((buf-name (format "*MQ: Edit description of %s*" patch))) | |
313 | (switch-to-buffer (get-buffer-create buf-name)) |
|
314 | (switch-to-buffer (get-buffer-create buf-name)) | |
314 | (when (= (point-min) (point-max)) |
|
315 | (when (= (point-min) (point-max)) | |
315 | (set (make-local-variable 'hg-root) root) |
|
316 | (set (make-local-variable 'hg-root) root) | |
316 | (set (make-local-variable 'mq-top) patch) |
|
317 | (set (make-local-variable 'mq-top) patch) | |
317 | (setq mq-prev-buffer prev-buffer) |
|
318 | (setq mq-prev-buffer prev-buffer) | |
318 | (insert (hg-run0 "qheader")) |
|
319 | (insert (hg-run0 "qheader")) | |
319 | (goto-char (point-min))) |
|
320 | (goto-char (point-min))) | |
320 | (mq-edit-mode) |
|
321 | (mq-edit-mode) | |
321 | (cd root))) |
|
322 | (cd root))) | |
322 | (message "Type `C-c C-c' to finish editing and refresh the patch.")) |
|
323 | (message "Type `C-c C-c' to finish editing and refresh the patch.")) | |
323 |
|
324 | |||
324 | (defun mq-new (name) |
|
325 | (defun mq-new (name) | |
325 | "Create a new empty patch named NAME. |
|
326 | "Create a new empty patch named NAME. | |
326 | The patch is applied on top of the current topmost patch. |
|
327 | The patch is applied on top of the current topmost patch. | |
327 | With a prefix argument, forcibly create the patch even if the working |
|
328 | With a prefix argument, forcibly create the patch even if the working | |
328 | directory is modified." |
|
329 | directory is modified." | |
329 | (interactive (list (mq-read-patch-name "qseries" " to create" t))) |
|
330 | (interactive (list (mq-read-patch-name "qseries" " to create" t))) | |
330 | (message "Creating patch...") |
|
331 | (message "Creating patch...") | |
331 | (let ((ret (if current-prefix-arg |
|
332 | (let ((ret (if current-prefix-arg | |
332 | (hg-run "qnew" "-f" name) |
|
333 | (hg-run "qnew" "-f" name) | |
333 | (hg-run "qnew" name)))) |
|
334 | (hg-run "qnew" name)))) | |
334 | (if (equal (car ret) 0) |
|
335 | (if (equal (car ret) 0) | |
335 | (progn |
|
336 | (progn | |
336 | (hg-update-mode-lines (buffer-file-name)) |
|
337 | (hg-update-mode-lines (buffer-file-name)) | |
337 | (message "Creating patch... done.")) |
|
338 | (message "Creating patch... done.")) | |
338 | (error "Creating patch... %s" (hg-chomp (cdr ret)))))) |
|
339 | (error "Creating patch... %s" (hg-chomp (cdr ret)))))) | |
339 |
|
340 | |||
|
341 | (defun mq-edit-series () | |||
|
342 | "Edit the MQ series file directly." | |||
|
343 | (interactive) | |||
|
344 | (let ((root (hg-root))) | |||
|
345 | (unless root | |||
|
346 | (error "Not in an MQ repository!")) | |||
|
347 | (find-file (concat root ".hg/patches/series")))) | |||
|
348 | ||||
340 |
|
349 | |||
341 | (provide 'mq) |
|
350 | (provide 'mq) | |
342 |
|
351 | |||
343 |
|
352 | |||
344 | ;;; Local Variables: |
|
353 | ;;; Local Variables: | |
345 | ;;; prompt-to-byte-compile: nil |
|
354 | ;;; prompt-to-byte-compile: nil | |
346 | ;;; end: |
|
355 | ;;; end: |
General Comments 0
You need to be logged in to leave comments.
Login now