Show More
@@ -0,0 +1,206 | |||||
|
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: |
General Comments 0
You need to be logged in to leave comments.
Login now