Mercurial > hg > mercurial-crew-with-dirclash

comparison contrib/mq.el @ 2993:425413d9ef59

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Emacs: add mq.el, early support for Mercurial Queues.
author Bryan O'Sullivan <bos@serpentine.com>
date Tue, 22 Aug 2006 16:04:58 -0700
parents
children e2bad806ccc3
comparison
equal deleted inserted replaced
2992:7017fc9a9478 2993:425413d9ef59
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: