##// END OF EJS Templates
Unconfuse font-lock
Brendan Cully -
r4411:681b681f default
parent child Browse files
Show More
@@ -1,1267 +1,1267 b''
1 ;;; mercurial.el --- Emacs support for the Mercurial distributed SCM
1 ;;; mercurial.el --- Emacs support for the Mercurial distributed SCM
2
2
3 ;; Copyright (C) 2005, 2006 Bryan O'Sullivan
3 ;; Copyright (C) 2005, 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 ;; mercurial.el is free software; you can redistribute it and/or
7 ;; mercurial.el is free software; you can redistribute it and/or
8 ;; modify it under the terms of version 2 of the GNU General Public
8 ;; modify it under the terms of version 2 of the GNU General Public
9 ;; License as published by the Free Software Foundation.
9 ;; License as published by the Free Software Foundation.
10
10
11 ;; mercurial.el is distributed in the hope that it will be useful, but
11 ;; mercurial.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 mercurial.el, GNU Emacs, or XEmacs; see the file COPYING
17 ;; along with mercurial.el, GNU Emacs, or XEmacs; see the file COPYING
18 ;; (`C-h C-l'). If not, write to the Free Software Foundation, Inc.,
18 ;; (`C-h C-l'). If not, write to the Free Software Foundation, Inc.,
19 ;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19 ;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
20
20
21 ;;; Commentary:
21 ;;; Commentary:
22
22
23 ;; mercurial.el builds upon Emacs's VC mode to provide flexible
23 ;; mercurial.el builds upon Emacs's VC mode to provide flexible
24 ;; integration with the Mercurial distributed SCM tool.
24 ;; integration with the Mercurial distributed SCM tool.
25
25
26 ;; To get going as quickly as possible, load mercurial.el into Emacs and
26 ;; To get going as quickly as possible, load mercurial.el into Emacs and
27 ;; type `C-c h h'; this runs hg-help-overview, which prints a helpful
27 ;; type `C-c h h'; this runs hg-help-overview, which prints a helpful
28 ;; usage overview.
28 ;; usage overview.
29
29
30 ;; Much of the inspiration for mercurial.el comes from Rajesh
30 ;; Much of the inspiration for mercurial.el comes from Rajesh
31 ;; Vaidheeswarran's excellent p4.el, which does an admirably thorough
31 ;; Vaidheeswarran's excellent p4.el, which does an admirably thorough
32 ;; job for the commercial Perforce SCM product. In fact, substantial
32 ;; job for the commercial Perforce SCM product. In fact, substantial
33 ;; chunks of code are adapted from p4.el.
33 ;; chunks of code are adapted from p4.el.
34
34
35 ;; This code has been developed under XEmacs 21.5, and may not work as
35 ;; This code has been developed under XEmacs 21.5, and may not work as
36 ;; well under GNU Emacs (albeit tested under 21.4). Patches to
36 ;; well under GNU Emacs (albeit tested under 21.4). Patches to
37 ;; enhance the portability of this code, fix bugs, and add features
37 ;; enhance the portability of this code, fix bugs, and add features
38 ;; are most welcome. You can clone a Mercurial repository for this
38 ;; are most welcome. You can clone a Mercurial repository for this
39 ;; package from http://www.serpentine.com/hg/hg-emacs
39 ;; package from http://www.serpentine.com/hg/hg-emacs
40
40
41 ;; Please send problem reports and suggestions to bos@serpentine.com.
41 ;; Please send problem reports and suggestions to bos@serpentine.com.
42
42
43
43
44 ;;; Code:
44 ;;; Code:
45
45
46 (require 'advice)
46 (require 'advice)
47 (require 'cl)
47 (require 'cl)
48 (require 'diff-mode)
48 (require 'diff-mode)
49 (require 'easymenu)
49 (require 'easymenu)
50 (require 'executable)
50 (require 'executable)
51 (require 'vc)
51 (require 'vc)
52
52
53
53
54 ;;; XEmacs has view-less, while GNU Emacs has view. Joy.
54 ;;; XEmacs has view-less, while GNU Emacs has view. Joy.
55
55
56 (condition-case nil
56 (condition-case nil
57 (require 'view-less)
57 (require 'view-less)
58 (error nil))
58 (error nil))
59 (condition-case nil
59 (condition-case nil
60 (require 'view)
60 (require 'view)
61 (error nil))
61 (error nil))
62
62
63
63
64 ;;; Variables accessible through the custom system.
64 ;;; Variables accessible through the custom system.
65
65
66 (defgroup mercurial nil
66 (defgroup mercurial nil
67 "Mercurial distributed SCM."
67 "Mercurial distributed SCM."
68 :group 'tools)
68 :group 'tools)
69
69
70 (defcustom hg-binary
70 (defcustom hg-binary
71 (or (executable-find "hg")
71 (or (executable-find "hg")
72 (dolist (path '("~/bin/hg" "/usr/bin/hg" "/usr/local/bin/hg"))
72 (dolist (path '("~/bin/hg" "/usr/bin/hg" "/usr/local/bin/hg"))
73 (when (file-executable-p path)
73 (when (file-executable-p path)
74 (return path))))
74 (return path))))
75 "The path to Mercurial's hg executable."
75 "The path to Mercurial's hg executable."
76 :type '(file :must-match t)
76 :type '(file :must-match t)
77 :group 'mercurial)
77 :group 'mercurial)
78
78
79 (defcustom hg-mode-hook nil
79 (defcustom hg-mode-hook nil
80 "Hook run when a buffer enters hg-mode."
80 "Hook run when a buffer enters hg-mode."
81 :type 'sexp
81 :type 'sexp
82 :group 'mercurial)
82 :group 'mercurial)
83
83
84 (defcustom hg-commit-mode-hook nil
84 (defcustom hg-commit-mode-hook nil
85 "Hook run when a buffer is created to prepare a commit."
85 "Hook run when a buffer is created to prepare a commit."
86 :type 'sexp
86 :type 'sexp
87 :group 'mercurial)
87 :group 'mercurial)
88
88
89 (defcustom hg-pre-commit-hook nil
89 (defcustom hg-pre-commit-hook nil
90 "Hook run before a commit is performed.
90 "Hook run before a commit is performed.
91 If you want to prevent the commit from proceeding, raise an error."
91 If you want to prevent the commit from proceeding, raise an error."
92 :type 'sexp
92 :type 'sexp
93 :group 'mercurial)
93 :group 'mercurial)
94
94
95 (defcustom hg-log-mode-hook nil
95 (defcustom hg-log-mode-hook nil
96 "Hook run after a buffer is filled with log information."
96 "Hook run after a buffer is filled with log information."
97 :type 'sexp
97 :type 'sexp
98 :group 'mercurial)
98 :group 'mercurial)
99
99
100 (defcustom hg-global-prefix "\C-ch"
100 (defcustom hg-global-prefix "\C-ch"
101 "The global prefix for Mercurial keymap bindings."
101 "The global prefix for Mercurial keymap bindings."
102 :type 'sexp
102 :type 'sexp
103 :group 'mercurial)
103 :group 'mercurial)
104
104
105 (defcustom hg-commit-allow-empty-message nil
105 (defcustom hg-commit-allow-empty-message nil
106 "Whether to allow changes to be committed with empty descriptions."
106 "Whether to allow changes to be committed with empty descriptions."
107 :type 'boolean
107 :type 'boolean
108 :group 'mercurial)
108 :group 'mercurial)
109
109
110 (defcustom hg-commit-allow-empty-file-list nil
110 (defcustom hg-commit-allow-empty-file-list nil
111 "Whether to allow changes to be committed without any modified files."
111 "Whether to allow changes to be committed without any modified files."
112 :type 'boolean
112 :type 'boolean
113 :group 'mercurial)
113 :group 'mercurial)
114
114
115 (defcustom hg-rev-completion-limit 100
115 (defcustom hg-rev-completion-limit 100
116 "The maximum number of revisions that hg-read-rev will offer to complete.
116 "The maximum number of revisions that hg-read-rev will offer to complete.
117 This affects memory usage and performance when prompting for revisions
117 This affects memory usage and performance when prompting for revisions
118 in a repository with a lot of history."
118 in a repository with a lot of history."
119 :type 'integer
119 :type 'integer
120 :group 'mercurial)
120 :group 'mercurial)
121
121
122 (defcustom hg-log-limit 50
122 (defcustom hg-log-limit 50
123 "The maximum number of revisions that hg-log will display."
123 "The maximum number of revisions that hg-log will display."
124 :type 'integer
124 :type 'integer
125 :group 'mercurial)
125 :group 'mercurial)
126
126
127 (defcustom hg-update-modeline t
127 (defcustom hg-update-modeline t
128 "Whether to update the modeline with the status of a file after every save.
128 "Whether to update the modeline with the status of a file after every save.
129 Set this to nil on platforms with poor process management, such as Windows."
129 Set this to nil on platforms with poor process management, such as Windows."
130 :type 'boolean
130 :type 'boolean
131 :group 'mercurial)
131 :group 'mercurial)
132
132
133 (defcustom hg-incoming-repository "default"
133 (defcustom hg-incoming-repository "default"
134 "The repository from which changes are pulled from by default.
134 "The repository from which changes are pulled from by default.
135 This should be a symbolic repository name, since it is used for all
135 This should be a symbolic repository name, since it is used for all
136 repository-related commands."
136 repository-related commands."
137 :type 'string
137 :type 'string
138 :group 'mercurial)
138 :group 'mercurial)
139
139
140 (defcustom hg-outgoing-repository "default-push"
140 (defcustom hg-outgoing-repository "default-push"
141 "The repository to which changes are pushed to by default.
141 "The repository to which changes are pushed to by default.
142 This should be a symbolic repository name, since it is used for all
142 This should be a symbolic repository name, since it is used for all
143 repository-related commands."
143 repository-related commands."
144 :type 'string
144 :type 'string
145 :group 'mercurial)
145 :group 'mercurial)
146
146
147
147
148 ;;; Other variables.
148 ;;; Other variables.
149
149
150 (defconst hg-running-xemacs (string-match "XEmacs" emacs-version)
150 (defconst hg-running-xemacs (string-match "XEmacs" emacs-version)
151 "Is mercurial.el running under XEmacs?")
151 "Is mercurial.el running under XEmacs?")
152
152
153 (defvar hg-mode nil
153 (defvar hg-mode nil
154 "Is this file managed by Mercurial?")
154 "Is this file managed by Mercurial?")
155 (make-variable-buffer-local 'hg-mode)
155 (make-variable-buffer-local 'hg-mode)
156 (put 'hg-mode 'permanent-local t)
156 (put 'hg-mode 'permanent-local t)
157
157
158 (defvar hg-status nil)
158 (defvar hg-status nil)
159 (make-variable-buffer-local 'hg-status)
159 (make-variable-buffer-local 'hg-status)
160 (put 'hg-status 'permanent-local t)
160 (put 'hg-status 'permanent-local t)
161
161
162 (defvar hg-prev-buffer nil)
162 (defvar hg-prev-buffer nil)
163 (make-variable-buffer-local 'hg-prev-buffer)
163 (make-variable-buffer-local 'hg-prev-buffer)
164 (put 'hg-prev-buffer 'permanent-local t)
164 (put 'hg-prev-buffer 'permanent-local t)
165
165
166 (defvar hg-root nil)
166 (defvar hg-root nil)
167 (make-variable-buffer-local 'hg-root)
167 (make-variable-buffer-local 'hg-root)
168 (put 'hg-root 'permanent-local t)
168 (put 'hg-root 'permanent-local t)
169
169
170 (defvar hg-output-buffer-name "*Hg*"
170 (defvar hg-output-buffer-name "*Hg*"
171 "The name to use for Mercurial output buffers.")
171 "The name to use for Mercurial output buffers.")
172
172
173 (defvar hg-file-history nil)
173 (defvar hg-file-history nil)
174 (defvar hg-repo-history nil)
174 (defvar hg-repo-history nil)
175 (defvar hg-rev-history nil)
175 (defvar hg-rev-history nil)
176
176
177
177
178 ;;; Random constants.
178 ;;; Random constants.
179
179
180 (defconst hg-commit-message-start
180 (defconst hg-commit-message-start
181 "--- Enter your commit message. Type `C-c C-c' to commit. ---\n")
181 "--- Enter your commit message. Type `C-c C-c' to commit. ---\n")
182
182
183 (defconst hg-commit-message-end
183 (defconst hg-commit-message-end
184 "--- Files in bold will be committed. Click to toggle selection. ---\n")
184 "--- Files in bold will be committed. Click to toggle selection. ---\n")
185
185
186
186
187 ;;; hg-mode keymap.
187 ;;; hg-mode keymap.
188
188
189 (defvar hg-mode-map (make-sparse-keymap))
189 (defvar hg-mode-map (make-sparse-keymap))
190 (define-key hg-mode-map "\C-xv" 'hg-prefix-map)
190 (define-key hg-mode-map "\C-xv" 'hg-prefix-map)
191
191
192 (defvar hg-prefix-map
192 (defvar hg-prefix-map
193 (let ((map (copy-keymap vc-prefix-map)))
193 (let ((map (copy-keymap vc-prefix-map)))
194 (if (functionp 'set-keymap-name)
194 (if (functionp 'set-keymap-name)
195 (set-keymap-name map 'hg-prefix-map)); XEmacs
195 (set-keymap-name map 'hg-prefix-map)); XEmacs
196 map)
196 map)
197 "This keymap overrides some default vc-mode bindings.")
197 "This keymap overrides some default vc-mode bindings.")
198 (fset 'hg-prefix-map hg-prefix-map)
198 (fset 'hg-prefix-map hg-prefix-map)
199 (define-key hg-prefix-map "=" 'hg-diff)
199 (define-key hg-prefix-map "=" 'hg-diff)
200 (define-key hg-prefix-map "c" 'hg-undo)
200 (define-key hg-prefix-map "c" 'hg-undo)
201 (define-key hg-prefix-map "g" 'hg-annotate)
201 (define-key hg-prefix-map "g" 'hg-annotate)
202 (define-key hg-prefix-map "l" 'hg-log)
202 (define-key hg-prefix-map "l" 'hg-log)
203 (define-key hg-prefix-map "n" 'hg-commit-start)
203 (define-key hg-prefix-map "n" 'hg-commit-start)
204 ;; (define-key hg-prefix-map "r" 'hg-update)
204 ;; (define-key hg-prefix-map "r" 'hg-update)
205 (define-key hg-prefix-map "u" 'hg-revert-buffer)
205 (define-key hg-prefix-map "u" 'hg-revert-buffer)
206 (define-key hg-prefix-map "~" 'hg-version-other-window)
206 (define-key hg-prefix-map "~" 'hg-version-other-window)
207
207
208 (add-minor-mode 'hg-mode 'hg-mode hg-mode-map)
208 (add-minor-mode 'hg-mode 'hg-mode hg-mode-map)
209
209
210
210
211 ;;; Global keymap.
211 ;;; Global keymap.
212
212
213 (global-set-key "\C-xvi" 'hg-add)
213 (global-set-key "\C-xvi" 'hg-add)
214
214
215 (defvar hg-global-map (make-sparse-keymap))
215 (defvar hg-global-map (make-sparse-keymap))
216 (fset 'hg-global-map hg-global-map)
216 (fset 'hg-global-map hg-global-map)
217 (global-set-key hg-global-prefix 'hg-global-map)
217 (global-set-key hg-global-prefix 'hg-global-map)
218 (define-key hg-global-map "," 'hg-incoming)
218 (define-key hg-global-map "," 'hg-incoming)
219 (define-key hg-global-map "." 'hg-outgoing)
219 (define-key hg-global-map "." 'hg-outgoing)
220 (define-key hg-global-map "<" 'hg-pull)
220 (define-key hg-global-map "<" 'hg-pull)
221 (define-key hg-global-map "=" 'hg-diff-repo)
221 (define-key hg-global-map "=" 'hg-diff-repo)
222 (define-key hg-global-map ">" 'hg-push)
222 (define-key hg-global-map ">" 'hg-push)
223 (define-key hg-global-map "?" 'hg-help-overview)
223 (define-key hg-global-map "?" 'hg-help-overview)
224 (define-key hg-global-map "A" 'hg-addremove)
224 (define-key hg-global-map "A" 'hg-addremove)
225 (define-key hg-global-map "U" 'hg-revert)
225 (define-key hg-global-map "U" 'hg-revert)
226 (define-key hg-global-map "a" 'hg-add)
226 (define-key hg-global-map "a" 'hg-add)
227 (define-key hg-global-map "c" 'hg-commit-start)
227 (define-key hg-global-map "c" 'hg-commit-start)
228 (define-key hg-global-map "f" 'hg-forget)
228 (define-key hg-global-map "f" 'hg-forget)
229 (define-key hg-global-map "h" 'hg-help-overview)
229 (define-key hg-global-map "h" 'hg-help-overview)
230 (define-key hg-global-map "i" 'hg-init)
230 (define-key hg-global-map "i" 'hg-init)
231 (define-key hg-global-map "l" 'hg-log-repo)
231 (define-key hg-global-map "l" 'hg-log-repo)
232 (define-key hg-global-map "r" 'hg-root)
232 (define-key hg-global-map "r" 'hg-root)
233 (define-key hg-global-map "s" 'hg-status)
233 (define-key hg-global-map "s" 'hg-status)
234 (define-key hg-global-map "u" 'hg-update)
234 (define-key hg-global-map "u" 'hg-update)
235
235
236
236
237 ;;; View mode keymap.
237 ;;; View mode keymap.
238
238
239 (defvar hg-view-mode-map
239 (defvar hg-view-mode-map
240 (let ((map (copy-keymap (if (boundp 'view-minor-mode-map)
240 (let ((map (copy-keymap (if (boundp 'view-minor-mode-map)
241 view-minor-mode-map
241 view-minor-mode-map
242 view-mode-map))))
242 view-mode-map))))
243 (if (functionp 'set-keymap-name)
243 (if (functionp 'set-keymap-name)
244 (set-keymap-name map 'hg-view-mode-map)); XEmacs
244 (set-keymap-name map 'hg-view-mode-map)); XEmacs
245 map))
245 map))
246 (fset 'hg-view-mode-map hg-view-mode-map)
246 (fset 'hg-view-mode-map hg-view-mode-map)
247 (define-key hg-view-mode-map
247 (define-key hg-view-mode-map
248 (if hg-running-xemacs [button2] [mouse-2])
248 (if hg-running-xemacs [button2] [mouse-2])
249 'hg-buffer-mouse-clicked)
249 'hg-buffer-mouse-clicked)
250
250
251
251
252 ;;; Commit mode keymaps.
252 ;;; Commit mode keymaps.
253
253
254 (defvar hg-commit-mode-map (make-sparse-keymap))
254 (defvar hg-commit-mode-map (make-sparse-keymap))
255 (define-key hg-commit-mode-map "\C-c\C-c" 'hg-commit-finish)
255 (define-key hg-commit-mode-map "\C-c\C-c" 'hg-commit-finish)
256 (define-key hg-commit-mode-map "\C-c\C-k" 'hg-commit-kill)
256 (define-key hg-commit-mode-map "\C-c\C-k" 'hg-commit-kill)
257 (define-key hg-commit-mode-map "\C-xv=" 'hg-diff-repo)
257 (define-key hg-commit-mode-map "\C-xv=" 'hg-diff-repo)
258
258
259 (defvar hg-commit-mode-file-map (make-sparse-keymap))
259 (defvar hg-commit-mode-file-map (make-sparse-keymap))
260 (define-key hg-commit-mode-file-map
260 (define-key hg-commit-mode-file-map
261 (if hg-running-xemacs [button2] [mouse-2])
261 (if hg-running-xemacs [button2] [mouse-2])
262 'hg-commit-mouse-clicked)
262 'hg-commit-mouse-clicked)
263 (define-key hg-commit-mode-file-map " " 'hg-commit-toggle-file)
263 (define-key hg-commit-mode-file-map " " 'hg-commit-toggle-file)
264 (define-key hg-commit-mode-file-map "\r" 'hg-commit-toggle-file)
264 (define-key hg-commit-mode-file-map "\r" 'hg-commit-toggle-file)
265
265
266
266
267 ;;; Convenience functions.
267 ;;; Convenience functions.
268
268
269 (defsubst hg-binary ()
269 (defsubst hg-binary ()
270 (if hg-binary
270 (if hg-binary
271 hg-binary
271 hg-binary
272 (error "No `hg' executable found!")))
272 (error "No `hg' executable found!")))
273
273
274 (defsubst hg-replace-in-string (str regexp newtext &optional literal)
274 (defsubst hg-replace-in-string (str regexp newtext &optional literal)
275 "Replace all matches in STR for REGEXP with NEWTEXT string.
275 "Replace all matches in STR for REGEXP with NEWTEXT string.
276 Return the new string. Optional LITERAL non-nil means do a literal
276 Return the new string. Optional LITERAL non-nil means do a literal
277 replacement.
277 replacement.
278
278
279 This function bridges yet another pointless impedance gap between
279 This function bridges yet another pointless impedance gap between
280 XEmacs and GNU Emacs."
280 XEmacs and GNU Emacs."
281 (if (fboundp 'replace-in-string)
281 (if (fboundp 'replace-in-string)
282 (replace-in-string str regexp newtext literal)
282 (replace-in-string str regexp newtext literal)
283 (replace-regexp-in-string regexp newtext str nil literal)))
283 (replace-regexp-in-string regexp newtext str nil literal)))
284
284
285 (defsubst hg-strip (str)
285 (defsubst hg-strip (str)
286 "Strip leading and trailing blank lines from a string."
286 "Strip leading and trailing blank lines from a string."
287 (hg-replace-in-string (hg-replace-in-string str "[\r\n][ \t\r\n]*\\'" "")
287 (hg-replace-in-string (hg-replace-in-string str "[\r\n][ \t\r\n]*\\'" "")
288 "\\`[ \t\r\n]*[\r\n]" ""))
288 "\\`[ \t\r\n]*[\r\n]" ""))
289
289
290 (defsubst hg-chomp (str)
290 (defsubst hg-chomp (str)
291 "Strip trailing newlines from a string."
291 "Strip trailing newlines from a string."
292 (hg-replace-in-string str "[\r\n]+\\'" ""))
292 (hg-replace-in-string str "[\r\n]+\\'" ""))
293
293
294 (defun hg-run-command (command &rest args)
294 (defun hg-run-command (command &rest args)
295 "Run the shell command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT).
295 "Run the shell command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT).
296 The list ARGS contains a list of arguments to pass to the command."
296 The list ARGS contains a list of arguments to pass to the command."
297 (let* (exit-code
297 (let* (exit-code
298 (output
298 (output
299 (with-output-to-string
299 (with-output-to-string
300 (with-current-buffer
300 (with-current-buffer
301 standard-output
301 standard-output
302 (setq exit-code
302 (setq exit-code
303 (apply 'call-process command nil t nil args))))))
303 (apply 'call-process command nil t nil args))))))
304 (cons exit-code output)))
304 (cons exit-code output)))
305
305
306 (defun hg-run (command &rest args)
306 (defun hg-run (command &rest args)
307 "Run the Mercurial command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT)."
307 "Run the Mercurial command COMMAND, returning (EXIT-CODE . COMMAND-OUTPUT)."
308 (apply 'hg-run-command (hg-binary) command args))
308 (apply 'hg-run-command (hg-binary) command args))
309
309
310 (defun hg-run0 (command &rest args)
310 (defun hg-run0 (command &rest args)
311 "Run the Mercurial command COMMAND, returning its output.
311 "Run the Mercurial command COMMAND, returning its output.
312 If the command does not exit with a zero status code, raise an error."
312 If the command does not exit with a zero status code, raise an error."
313 (let ((res (apply 'hg-run-command (hg-binary) command args)))
313 (let ((res (apply 'hg-run-command (hg-binary) command args)))
314 (if (not (eq (car res) 0))
314 (if (not (eq (car res) 0))
315 (error "Mercurial command failed %s - exit code %s"
315 (error "Mercurial command failed %s - exit code %s"
316 (cons command args)
316 (cons command args)
317 (car res))
317 (car res))
318 (cdr res))))
318 (cdr res))))
319
319
320 (defun hg-sync-buffers (path)
320 (defun hg-sync-buffers (path)
321 "Sync buffers visiting PATH with their on-disk copies.
321 "Sync buffers visiting PATH with their on-disk copies.
322 If PATH is not being visited, but is under the repository root, sync
322 If PATH is not being visited, but is under the repository root, sync
323 all buffers visiting files in the repository."
323 all buffers visiting files in the repository."
324 (let ((buf (find-buffer-visiting path)))
324 (let ((buf (find-buffer-visiting path)))
325 (if buf
325 (if buf
326 (with-current-buffer buf
326 (with-current-buffer buf
327 (vc-buffer-sync))
327 (vc-buffer-sync))
328 (hg-do-across-repo path
328 (hg-do-across-repo path
329 (vc-buffer-sync)))))
329 (vc-buffer-sync)))))
330
330
331 (defun hg-buffer-commands (pnt)
331 (defun hg-buffer-commands (pnt)
332 "Use the properties of a character to do something sensible."
332 "Use the properties of a character to do something sensible."
333 (interactive "d")
333 (interactive "d")
334 (let ((rev (get-char-property pnt 'rev))
334 (let ((rev (get-char-property pnt 'rev))
335 (file (get-char-property pnt 'file))
335 (file (get-char-property pnt 'file))
336 (date (get-char-property pnt 'date))
336 (date (get-char-property pnt 'date))
337 (user (get-char-property pnt 'user))
337 (user (get-char-property pnt 'user))
338 (host (get-char-property pnt 'host))
338 (host (get-char-property pnt 'host))
339 (prev-buf (current-buffer)))
339 (prev-buf (current-buffer)))
340 (cond
340 (cond
341 (file
341 (file
342 (find-file-other-window file))
342 (find-file-other-window file))
343 (rev
343 (rev
344 (hg-diff hg-view-file-name rev rev prev-buf))
344 (hg-diff hg-view-file-name rev rev prev-buf))
345 ((message "I don't know how to do that yet")))))
345 ((message "I don't know how to do that yet")))))
346
346
347 (defsubst hg-event-point (event)
347 (defsubst hg-event-point (event)
348 "Return the character position of the mouse event EVENT."
348 "Return the character position of the mouse event EVENT."
349 (if hg-running-xemacs
349 (if hg-running-xemacs
350 (event-point event)
350 (event-point event)
351 (posn-point (event-start event))))
351 (posn-point (event-start event))))
352
352
353 (defsubst hg-event-window (event)
353 (defsubst hg-event-window (event)
354 "Return the window over which mouse event EVENT occurred."
354 "Return the window over which mouse event EVENT occurred."
355 (if hg-running-xemacs
355 (if hg-running-xemacs
356 (event-window event)
356 (event-window event)
357 (posn-window (event-start event))))
357 (posn-window (event-start event))))
358
358
359 (defun hg-buffer-mouse-clicked (event)
359 (defun hg-buffer-mouse-clicked (event)
360 "Translate the mouse clicks in a HG log buffer to character events.
360 "Translate the mouse clicks in a HG log buffer to character events.
361 These are then handed off to `hg-buffer-commands'.
361 These are then handed off to `hg-buffer-commands'.
362
362
363 Handle frickin' frackin' gratuitous event-related incompatibilities."
363 Handle frickin' frackin' gratuitous event-related incompatibilities."
364 (interactive "e")
364 (interactive "e")
365 (select-window (hg-event-window event))
365 (select-window (hg-event-window event))
366 (hg-buffer-commands (hg-event-point event)))
366 (hg-buffer-commands (hg-event-point event)))
367
367
368 (unless (fboundp 'view-minor-mode)
368 (unless (fboundp 'view-minor-mode)
369 (defun view-minor-mode (prev-buffer exit-func)
369 (defun view-minor-mode (prev-buffer exit-func)
370 (view-mode)))
370 (view-mode)))
371
371
372 (defsubst hg-abbrev-file-name (file)
372 (defsubst hg-abbrev-file-name (file)
373 "Portable wrapper around abbreviate-file-name."
373 "Portable wrapper around abbreviate-file-name."
374 (if hg-running-xemacs
374 (if hg-running-xemacs
375 (abbreviate-file-name file t)
375 (abbreviate-file-name file t)
376 (abbreviate-file-name file)))
376 (abbreviate-file-name file)))
377
377
378 (defun hg-read-file-name (&optional prompt default)
378 (defun hg-read-file-name (&optional prompt default)
379 "Read a file or directory name, or a pattern, to use with a command."
379 "Read a file or directory name, or a pattern, to use with a command."
380 (save-excursion
380 (save-excursion
381 (while hg-prev-buffer
381 (while hg-prev-buffer
382 (set-buffer hg-prev-buffer))
382 (set-buffer hg-prev-buffer))
383 (let ((path (or default
383 (let ((path (or default
384 (buffer-file-name)
384 (buffer-file-name)
385 (expand-file-name default-directory))))
385 (expand-file-name default-directory))))
386 (if (or (not path) current-prefix-arg)
386 (if (or (not path) current-prefix-arg)
387 (expand-file-name
387 (expand-file-name
388 (eval (list* 'read-file-name
388 (eval (list* 'read-file-name
389 (format "File, directory or pattern%s: "
389 (format "File, directory or pattern%s: "
390 (or prompt ""))
390 (or prompt ""))
391 (and path (file-name-directory path))
391 (and path (file-name-directory path))
392 nil nil
392 nil nil
393 (and path (file-name-nondirectory path))
393 (and path (file-name-nondirectory path))
394 (if hg-running-xemacs
394 (if hg-running-xemacs
395 (cons (quote 'hg-file-history) nil)
395 (cons (quote 'hg-file-history) nil)
396 nil))))
396 nil))))
397 path))))
397 path))))
398
398
399 (defun hg-read-number (&optional prompt default)
399 (defun hg-read-number (&optional prompt default)
400 "Read a integer value."
400 "Read a integer value."
401 (save-excursion
401 (save-excursion
402 (if (or (not default) current-prefix-arg)
402 (if (or (not default) current-prefix-arg)
403 (string-to-number
403 (string-to-number
404 (eval (list* 'read-string
404 (eval (list* 'read-string
405 (or prompt "")
405 (or prompt "")
406 (if default (cons (format "%d" default) nil) nil))))
406 (if default (cons (format "%d" default) nil) nil))))
407 default)))
407 default)))
408
408
409 (defun hg-read-config ()
409 (defun hg-read-config ()
410 "Return an alist of (key . value) pairs of Mercurial config data.
410 "Return an alist of (key . value) pairs of Mercurial config data.
411 Each key is of the form (section . name)."
411 Each key is of the form (section . name)."
412 (let (items)
412 (let (items)
413 (dolist (line (split-string (hg-chomp (hg-run0 "debugconfig")) "\n") items)
413 (dolist (line (split-string (hg-chomp (hg-run0 "debugconfig")) "\n") items)
414 (string-match "^\\([^=]*\\)=\\(.*\\)" line)
414 (string-match "^\\([^=]*\\)=\\(.*\\)" line)
415 (let* ((left (substring line (match-beginning 1) (match-end 1)))
415 (let* ((left (substring line (match-beginning 1) (match-end 1)))
416 (right (substring line (match-beginning 2) (match-end 2)))
416 (right (substring line (match-beginning 2) (match-end 2)))
417 (key (split-string left "\\."))
417 (key (split-string left "\\."))
418 (value (hg-replace-in-string right "\\\\n" "\n" t)))
418 (value (hg-replace-in-string right "\\\\n" "\n" t)))
419 (setq items (cons (cons (cons (car key) (cadr key)) value) items))))))
419 (setq items (cons (cons (cons (car key) (cadr key)) value) items))))))
420
420
421 (defun hg-config-section (section config)
421 (defun hg-config-section (section config)
422 "Return an alist of (name . value) pairs for SECTION of CONFIG."
422 "Return an alist of (name . value) pairs for SECTION of CONFIG."
423 (let (items)
423 (let (items)
424 (dolist (item config items)
424 (dolist (item config items)
425 (when (equal (caar item) section)
425 (when (equal (caar item) section)
426 (setq items (cons (cons (cdar item) (cdr item)) items))))))
426 (setq items (cons (cons (cdar item) (cdr item)) items))))))
427
427
428 (defun hg-string-starts-with (sub str)
428 (defun hg-string-starts-with (sub str)
429 "Indicate whether string STR starts with the substring or character SUB."
429 "Indicate whether string STR starts with the substring or character SUB."
430 (if (not (stringp sub))
430 (if (not (stringp sub))
431 (and (> (length str) 0) (equal (elt str 0) sub))
431 (and (> (length str) 0) (equal (elt str 0) sub))
432 (let ((sub-len (length sub)))
432 (let ((sub-len (length sub)))
433 (and (<= sub-len (length str))
433 (and (<= sub-len (length str))
434 (string= sub (substring str 0 sub-len))))))
434 (string= sub (substring str 0 sub-len))))))
435
435
436 (defun hg-complete-repo (string predicate all)
436 (defun hg-complete-repo (string predicate all)
437 "Attempt to complete a repository name.
437 "Attempt to complete a repository name.
438 We complete on either symbolic names from Mercurial's config or real
438 We complete on either symbolic names from Mercurial's config or real
439 directory names from the file system. We do not penalise URLs."
439 directory names from the file system. We do not penalise URLs."
440 (or (if all
440 (or (if all
441 (all-completions string hg-repo-completion-table predicate)
441 (all-completions string hg-repo-completion-table predicate)
442 (try-completion string hg-repo-completion-table predicate))
442 (try-completion string hg-repo-completion-table predicate))
443 (let* ((str (expand-file-name string))
443 (let* ((str (expand-file-name string))
444 (dir (file-name-directory str))
444 (dir (file-name-directory str))
445 (file (file-name-nondirectory str)))
445 (file (file-name-nondirectory str)))
446 (if all
446 (if all
447 (let (completions)
447 (let (completions)
448 (dolist (name (delete "./" (file-name-all-completions file dir))
448 (dolist (name (delete "./" (file-name-all-completions file dir))
449 completions)
449 completions)
450 (let ((path (concat dir name)))
450 (let ((path (concat dir name)))
451 (when (file-directory-p path)
451 (when (file-directory-p path)
452 (setq completions (cons name completions))))))
452 (setq completions (cons name completions))))))
453 (let ((comp (file-name-completion file dir)))
453 (let ((comp (file-name-completion file dir)))
454 (if comp
454 (if comp
455 (hg-abbrev-file-name (concat dir comp))))))))
455 (hg-abbrev-file-name (concat dir comp))))))))
456
456
457 (defun hg-read-repo-name (&optional prompt initial-contents default)
457 (defun hg-read-repo-name (&optional prompt initial-contents default)
458 "Read the location of a repository."
458 "Read the location of a repository."
459 (save-excursion
459 (save-excursion
460 (while hg-prev-buffer
460 (while hg-prev-buffer
461 (set-buffer hg-prev-buffer))
461 (set-buffer hg-prev-buffer))
462 (let (hg-repo-completion-table)
462 (let (hg-repo-completion-table)
463 (if current-prefix-arg
463 (if current-prefix-arg
464 (progn
464 (progn
465 (dolist (path (hg-config-section "paths" (hg-read-config)))
465 (dolist (path (hg-config-section "paths" (hg-read-config)))
466 (setq hg-repo-completion-table
466 (setq hg-repo-completion-table
467 (cons (cons (car path) t) hg-repo-completion-table))
467 (cons (cons (car path) t) hg-repo-completion-table))
468 (unless (hg-string-starts-with directory-sep-char (cdr path))
468 (unless (hg-string-starts-with directory-sep-char (cdr path))
469 (setq hg-repo-completion-table
469 (setq hg-repo-completion-table
470 (cons (cons (cdr path) t) hg-repo-completion-table))))
470 (cons (cons (cdr path) t) hg-repo-completion-table))))
471 (completing-read (format "Repository%s: " (or prompt ""))
471 (completing-read (format "Repository%s: " (or prompt ""))
472 'hg-complete-repo
472 'hg-complete-repo
473 nil
473 nil
474 nil
474 nil
475 initial-contents
475 initial-contents
476 'hg-repo-history
476 'hg-repo-history
477 default))
477 default))
478 default))))
478 default))))
479
479
480 (defun hg-read-rev (&optional prompt default)
480 (defun hg-read-rev (&optional prompt default)
481 "Read a revision or tag, offering completions."
481 "Read a revision or tag, offering completions."
482 (save-excursion
482 (save-excursion
483 (while hg-prev-buffer
483 (while hg-prev-buffer
484 (set-buffer hg-prev-buffer))
484 (set-buffer hg-prev-buffer))
485 (let ((rev (or default "tip")))
485 (let ((rev (or default "tip")))
486 (if current-prefix-arg
486 (if current-prefix-arg
487 (let ((revs (split-string
487 (let ((revs (split-string
488 (hg-chomp
488 (hg-chomp
489 (hg-run0 "-q" "log" "-r"
489 (hg-run0 "-q" "log" "-r"
490 (format "-%d:tip" hg-rev-completion-limit)))
490 (format "-%d:tip" hg-rev-completion-limit)))
491 "[\n:]")))
491 "[\n:]")))
492 (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n"))
492 (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n"))
493 (setq revs (cons (car (split-string line "\\s-")) revs)))
493 (setq revs (cons (car (split-string line "\\s-")) revs)))
494 (completing-read (format "Revision%s (%s): "
494 (completing-read (format "Revision%s (%s): "
495 (or prompt "")
495 (or prompt "")
496 (or default "tip"))
496 (or default "tip"))
497 (map 'list 'cons revs revs)
497 (map 'list 'cons revs revs)
498 nil
498 nil
499 nil
499 nil
500 nil
500 nil
501 'hg-rev-history
501 'hg-rev-history
502 (or default "tip")))
502 (or default "tip")))
503 rev))))
503 rev))))
504
504
505 (defun hg-parents-for-mode-line (root)
505 (defun hg-parents-for-mode-line (root)
506 "Format the parents of the working directory for the mode line."
506 "Format the parents of the working directory for the mode line."
507 (let ((parents (split-string (hg-chomp
507 (let ((parents (split-string (hg-chomp
508 (hg-run0 "--cwd" root "parents" "--template"
508 (hg-run0 "--cwd" root "parents" "--template"
509 "{rev}\n")) "\n")))
509 "{rev}\n")) "\n")))
510 (mapconcat 'identity parents "+")))
510 (mapconcat 'identity parents "+")))
511
511
512 (defun hg-buffers-visiting-repo (&optional path)
512 (defun hg-buffers-visiting-repo (&optional path)
513 "Return a list of buffers visiting the repository containing PATH."
513 "Return a list of buffers visiting the repository containing PATH."
514 (let ((root-name (hg-root (or path (buffer-file-name))))
514 (let ((root-name (hg-root (or path (buffer-file-name))))
515 bufs)
515 bufs)
516 (save-excursion
516 (save-excursion
517 (dolist (buf (buffer-list) bufs)
517 (dolist (buf (buffer-list) bufs)
518 (set-buffer buf)
518 (set-buffer buf)
519 (let ((name (buffer-file-name)))
519 (let ((name (buffer-file-name)))
520 (when (and hg-status name (equal (hg-root name) root-name))
520 (when (and hg-status name (equal (hg-root name) root-name))
521 (setq bufs (cons buf bufs))))))))
521 (setq bufs (cons buf bufs))))))))
522
522
523 (defun hg-update-mode-lines (path)
523 (defun hg-update-mode-lines (path)
524 "Update the mode lines of all buffers visiting the same repository as PATH."
524 "Update the mode lines of all buffers visiting the same repository as PATH."
525 (let* ((root (hg-root path))
525 (let* ((root (hg-root path))
526 (parents (hg-parents-for-mode-line root)))
526 (parents (hg-parents-for-mode-line root)))
527 (save-excursion
527 (save-excursion
528 (dolist (info (hg-path-status
528 (dolist (info (hg-path-status
529 root
529 root
530 (mapcar
530 (mapcar
531 (function
531 (function
532 (lambda (buf)
532 (lambda (buf)
533 (substring (buffer-file-name buf) (length root))))
533 (substring (buffer-file-name buf) (length root))))
534 (hg-buffers-visiting-repo root))))
534 (hg-buffers-visiting-repo root))))
535 (let* ((name (car info))
535 (let* ((name (car info))
536 (status (cdr info))
536 (status (cdr info))
537 (buf (find-buffer-visiting (concat root name))))
537 (buf (find-buffer-visiting (concat root name))))
538 (when buf
538 (when buf
539 (set-buffer buf)
539 (set-buffer buf)
540 (hg-mode-line-internal status parents)))))))
540 (hg-mode-line-internal status parents)))))))
541
541
542 (defmacro hg-do-across-repo (path &rest body)
542 (defmacro hg-do-across-repo (path &rest body)
543 (let ((root-name (gensym "root-"))
543 (let ((root-name (gensym "root-"))
544 (buf-name (gensym "buf-")))
544 (buf-name (gensym "buf-")))
545 `(let ((,root-name (hg-root ,path)))
545 `(let ((,root-name (hg-root ,path)))
546 (save-excursion
546 (save-excursion
547 (dolist (,buf-name (buffer-list))
547 (dolist (,buf-name (buffer-list))
548 (set-buffer ,buf-name)
548 (set-buffer ,buf-name)
549 (when (and hg-status (equal (hg-root buffer-file-name) ,root-name))
549 (when (and hg-status (equal (hg-root buffer-file-name) ,root-name))
550 ,@body))))))
550 ,@body))))))
551
551
552 (put 'hg-do-across-repo 'lisp-indent-function 1)
552 (put 'hg-do-across-repo 'lisp-indent-function 1)
553
553
554
554
555 ;;; View mode bits.
555 ;;; View mode bits.
556
556
557 (defun hg-exit-view-mode (buf)
557 (defun hg-exit-view-mode (buf)
558 "Exit from hg-view-mode.
558 "Exit from hg-view-mode.
559 We delete the current window if entering hg-view-mode split the
559 We delete the current window if entering hg-view-mode split the
560 current frame."
560 current frame."
561 (when (and (eq buf (current-buffer))
561 (when (and (eq buf (current-buffer))
562 (> (length (window-list)) 1))
562 (> (length (window-list)) 1))
563 (delete-window))
563 (delete-window))
564 (when (buffer-live-p buf)
564 (when (buffer-live-p buf)
565 (kill-buffer buf)))
565 (kill-buffer buf)))
566
566
567 (defun hg-view-mode (prev-buffer &optional file-name)
567 (defun hg-view-mode (prev-buffer &optional file-name)
568 (goto-char (point-min))
568 (goto-char (point-min))
569 (set-buffer-modified-p nil)
569 (set-buffer-modified-p nil)
570 (toggle-read-only t)
570 (toggle-read-only t)
571 (view-minor-mode prev-buffer 'hg-exit-view-mode)
571 (view-minor-mode prev-buffer 'hg-exit-view-mode)
572 (use-local-map hg-view-mode-map)
572 (use-local-map hg-view-mode-map)
573 (setq truncate-lines t)
573 (setq truncate-lines t)
574 (when file-name
574 (when file-name
575 (set (make-local-variable 'hg-view-file-name)
575 (set (make-local-variable 'hg-view-file-name)
576 (hg-abbrev-file-name file-name))))
576 (hg-abbrev-file-name file-name))))
577
577
578 (defun hg-file-status (file)
578 (defun hg-file-status (file)
579 "Return status of FILE, or nil if FILE does not exist or is unmanaged."
579 "Return status of FILE, or nil if FILE does not exist or is unmanaged."
580 (let* ((s (hg-run "status" file))
580 (let* ((s (hg-run "status" file))
581 (exit (car s))
581 (exit (car s))
582 (output (cdr s)))
582 (output (cdr s)))
583 (if (= exit 0)
583 (if (= exit 0)
584 (let ((state (assoc (substring output 0 (min (length output) 2))
584 (let ((state (assoc (substring output 0 (min (length output) 2))
585 '(("M " . modified)
585 '(("M " . modified)
586 ("A " . added)
586 ("A " . added)
587 ("R " . removed)
587 ("R " . removed)
588 ("! " . deleted)
588 ("! " . deleted)
589 ("? " . nil)))))
589 ("? " . nil)))))
590 (if state
590 (if state
591 (cdr state)
591 (cdr state)
592 'normal)))))
592 'normal)))))
593
593
594 (defun hg-path-status (root paths)
594 (defun hg-path-status (root paths)
595 "Return status of PATHS in repo ROOT as an alist.
595 "Return status of PATHS in repo ROOT as an alist.
596 Each entry is a pair (FILE-NAME . STATUS)."
596 Each entry is a pair (FILE-NAME . STATUS)."
597 (let ((s (apply 'hg-run "--cwd" root "status" "-marduc" paths))
597 (let ((s (apply 'hg-run "--cwd" root "status" "-marduc" paths))
598 result)
598 result)
599 (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result))
599 (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result))
600 (let (state name)
600 (let (state name)
601 (if (equal (substring entry 1 2) " ")
601 (if (equal (substring entry 1 2) " ")
602 (setq state (cdr (assoc (substring entry 0 2)
602 (setq state (cdr (assoc (substring entry 0 2)
603 '(("M " . modified)
603 '(("M " . modified)
604 ("A " . added)
604 ("A " . added)
605 ("R " . removed)
605 ("R " . removed)
606 ("! " . deleted)
606 ("! " . deleted)
607 ("C " . normal)
607 ("C " . normal)
608 ("I " . ignored)
608 ("I " . ignored)
609 ("? " . nil))))
609 ("? " . nil))))
610 name (substring entry 2))
610 name (substring entry 2))
611 (setq name (substring entry 0 (search ": " entry :from-end t))))
611 (setq name (substring entry 0 (search ": " entry :from-end t))))
612 (setq result (cons (cons name state) result))))))
612 (setq result (cons (cons name state) result))))))
613
613
614 (defmacro hg-view-output (args &rest body)
614 (defmacro hg-view-output (args &rest body)
615 "Execute BODY in a clean buffer, then quickly display that buffer.
615 "Execute BODY in a clean buffer, then quickly display that buffer.
616 If the buffer contains one line, its contents are displayed in the
616 If the buffer contains one line, its contents are displayed in the
617 minibuffer. Otherwise, the buffer is displayed in view-mode.
617 minibuffer. Otherwise, the buffer is displayed in view-mode.
618 ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is
618 ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is
619 the name of the buffer to create, and FILE is the name of the file
619 the name of the buffer to create, and FILE is the name of the file
620 being viewed."
620 being viewed."
621 (let ((prev-buf (gensym "prev-buf-"))
621 (let ((prev-buf (gensym "prev-buf-"))
622 (v-b-name (car args))
622 (v-b-name (car args))
623 (v-m-rest (cdr args)))
623 (v-m-rest (cdr args)))
624 `(let ((view-buf-name ,v-b-name)
624 `(let ((view-buf-name ,v-b-name)
625 (,prev-buf (current-buffer)))
625 (,prev-buf (current-buffer)))
626 (get-buffer-create view-buf-name)
626 (get-buffer-create view-buf-name)
627 (kill-buffer view-buf-name)
627 (kill-buffer view-buf-name)
628 (get-buffer-create view-buf-name)
628 (get-buffer-create view-buf-name)
629 (set-buffer view-buf-name)
629 (set-buffer view-buf-name)
630 (save-excursion
630 (save-excursion
631 ,@body)
631 ,@body)
632 (case (count-lines (point-min) (point-max))
632 (case (count-lines (point-min) (point-max))
633 ((0)
633 ((0)
634 (kill-buffer view-buf-name)
634 (kill-buffer view-buf-name)
635 (message "(No output)"))
635 (message "(No output)"))
636 ((1)
636 ((1)
637 (let ((msg (hg-chomp (buffer-substring (point-min) (point-max)))))
637 (let ((msg (hg-chomp (buffer-substring (point-min) (point-max)))))
638 (kill-buffer view-buf-name)
638 (kill-buffer view-buf-name)
639 (message "%s" msg)))
639 (message "%s" msg)))
640 (t
640 (t
641 (pop-to-buffer view-buf-name)
641 (pop-to-buffer view-buf-name)
642 (setq hg-prev-buffer ,prev-buf)
642 (setq hg-prev-buffer ,prev-buf)
643 (hg-view-mode ,prev-buf ,@v-m-rest))))))
643 (hg-view-mode ,prev-buf ,@v-m-rest))))))
644
644
645 (put 'hg-view-output 'lisp-indent-function 1)
645 (put 'hg-view-output 'lisp-indent-function 1)
646
646
647 ;;; Context save and restore across revert and other operations.
647 ;;; Context save and restore across revert and other operations.
648
648
649 (defun hg-position-context (pos)
649 (defun hg-position-context (pos)
650 "Return information to help find the given position again."
650 "Return information to help find the given position again."
651 (let* ((end (min (point-max) (+ pos 98))))
651 (let* ((end (min (point-max) (+ pos 98))))
652 (list pos
652 (list pos
653 (buffer-substring (max (point-min) (- pos 2)) end)
653 (buffer-substring (max (point-min) (- pos 2)) end)
654 (- end pos))))
654 (- end pos))))
655
655
656 (defun hg-buffer-context ()
656 (defun hg-buffer-context ()
657 "Return information to help restore a user's editing context.
657 "Return information to help restore a user's editing context.
658 This is useful across reverts and merges, where a context is likely
658 This is useful across reverts and merges, where a context is likely
659 to have moved a little, but not really changed."
659 to have moved a little, but not really changed."
660 (let ((point-context (hg-position-context (point)))
660 (let ((point-context (hg-position-context (point)))
661 (mark-context (let ((mark (mark-marker)))
661 (mark-context (let ((mark (mark-marker)))
662 (and mark (hg-position-context mark)))))
662 (and mark (hg-position-context mark)))))
663 (list point-context mark-context)))
663 (list point-context mark-context)))
664
664
665 (defun hg-find-context (ctx)
665 (defun hg-find-context (ctx)
666 "Attempt to find a context in the given buffer.
666 "Attempt to find a context in the given buffer.
667 Always returns a valid, hopefully sane, position."
667 Always returns a valid, hopefully sane, position."
668 (let ((pos (nth 0 ctx))
668 (let ((pos (nth 0 ctx))
669 (str (nth 1 ctx))
669 (str (nth 1 ctx))
670 (fixup (nth 2 ctx)))
670 (fixup (nth 2 ctx)))
671 (save-excursion
671 (save-excursion
672 (goto-char (max (point-min) (- pos 15000)))
672 (goto-char (max (point-min) (- pos 15000)))
673 (if (and (not (equal str ""))
673 (if (and (not (equal str ""))
674 (search-forward str nil t))
674 (search-forward str nil t))
675 (- (point) fixup)
675 (- (point) fixup)
676 (max pos (point-min))))))
676 (max pos (point-min))))))
677
677
678 (defun hg-restore-context (ctx)
678 (defun hg-restore-context (ctx)
679 "Attempt to restore the user's editing context."
679 "Attempt to restore the user's editing context."
680 (let ((point-context (nth 0 ctx))
680 (let ((point-context (nth 0 ctx))
681 (mark-context (nth 1 ctx)))
681 (mark-context (nth 1 ctx)))
682 (goto-char (hg-find-context point-context))
682 (goto-char (hg-find-context point-context))
683 (when mark-context
683 (when mark-context
684 (set-mark (hg-find-context mark-context)))))
684 (set-mark (hg-find-context mark-context)))))
685
685
686
686
687 ;;; Hooks.
687 ;;; Hooks.
688
688
689 (defun hg-mode-line-internal (status parents)
689 (defun hg-mode-line-internal (status parents)
690 (setq hg-status status
690 (setq hg-status status
691 hg-mode (and status (concat " Hg:"
691 hg-mode (and status (concat " Hg:"
692 parents
692 parents
693 (cdr (assq status
693 (cdr (assq status
694 '((normal . "")
694 '((normal . "")
695 (removed . "r")
695 (removed . "r")
696 (added . "a")
696 (added . "a")
697 (deleted . "!")
697 (deleted . "!")
698 (modified . "m"))))))))
698 (modified . "m"))))))))
699
699
700 (defun hg-mode-line (&optional force)
700 (defun hg-mode-line (&optional force)
701 "Update the modeline with the current status of a file.
701 "Update the modeline with the current status of a file.
702 An update occurs if optional argument FORCE is non-nil,
702 An update occurs if optional argument FORCE is non-nil,
703 hg-update-modeline is non-nil, or we have not yet checked the state of
703 hg-update-modeline is non-nil, or we have not yet checked the state of
704 the file."
704 the file."
705 (let ((root (hg-root)))
705 (let ((root (hg-root)))
706 (when (and root (or force hg-update-modeline (not hg-mode)))
706 (when (and root (or force hg-update-modeline (not hg-mode)))
707 (let ((status (hg-file-status buffer-file-name))
707 (let ((status (hg-file-status buffer-file-name))
708 (parents (hg-parents-for-mode-line root)))
708 (parents (hg-parents-for-mode-line root)))
709 (hg-mode-line-internal status parents)
709 (hg-mode-line-internal status parents)
710 status))))
710 status))))
711
711
712 (defun hg-mode (&optional toggle)
712 (defun hg-mode (&optional toggle)
713 "Minor mode for Mercurial distributed SCM integration.
713 "Minor mode for Mercurial distributed SCM integration.
714
714
715 The Mercurial mode user interface is based on that of VC mode, so if
715 The Mercurial mode user interface is based on that of VC mode, so if
716 you're already familiar with VC, the same keybindings and functions
716 you're already familiar with VC, the same keybindings and functions
717 will generally work.
717 will generally work.
718
718
719 Below is a list of many common SCM tasks. In the list, `G/L\'
719 Below is a list of many common SCM tasks. In the list, `G/L\'
720 indicates whether a key binding is global (G) to a repository or local
720 indicates whether a key binding is global (G) to a repository or
721 (L) to a file. Many commands take a prefix argument.
721 local (L) to a file. Many commands take a prefix argument.
722
722
723 SCM Task G/L Key Binding Command Name
723 SCM Task G/L Key Binding Command Name
724 -------- --- ----------- ------------
724 -------- --- ----------- ------------
725 Help overview (what you are reading) G C-c h h hg-help-overview
725 Help overview (what you are reading) G C-c h h hg-help-overview
726
726
727 Tell Mercurial to manage a file G C-c h a hg-add
727 Tell Mercurial to manage a file G C-c h a hg-add
728 Commit changes to current file only L C-x v n hg-commit-start
728 Commit changes to current file only L C-x v n hg-commit-start
729 Undo changes to file since commit L C-x v u hg-revert-buffer
729 Undo changes to file since commit L C-x v u hg-revert-buffer
730
730
731 Diff file vs last checkin L C-x v = hg-diff
731 Diff file vs last checkin L C-x v = hg-diff
732
732
733 View file change history L C-x v l hg-log
733 View file change history L C-x v l hg-log
734 View annotated file L C-x v a hg-annotate
734 View annotated file L C-x v a hg-annotate
735
735
736 Diff repo vs last checkin G C-c h = hg-diff-repo
736 Diff repo vs last checkin G C-c h = hg-diff-repo
737 View status of files in repo G C-c h s hg-status
737 View status of files in repo G C-c h s hg-status
738 Commit all changes G C-c h c hg-commit-start
738 Commit all changes G C-c h c hg-commit-start
739
739
740 Undo all changes since last commit G C-c h U hg-revert
740 Undo all changes since last commit G C-c h U hg-revert
741 View repo change history G C-c h l hg-log-repo
741 View repo change history G C-c h l hg-log-repo
742
742
743 See changes that can be pulled G C-c h , hg-incoming
743 See changes that can be pulled G C-c h , hg-incoming
744 Pull changes G C-c h < hg-pull
744 Pull changes G C-c h < hg-pull
745 Update working directory after pull G C-c h u hg-update
745 Update working directory after pull G C-c h u hg-update
746 See changes that can be pushed G C-c h . hg-outgoing
746 See changes that can be pushed G C-c h . hg-outgoing
747 Push changes G C-c h > hg-push"
747 Push changes G C-c h > hg-push"
748 (unless vc-make-backup-files
748 (unless vc-make-backup-files
749 (set (make-local-variable 'backup-inhibited) t))
749 (set (make-local-variable 'backup-inhibited) t))
750 (run-hooks 'hg-mode-hook))
750 (run-hooks 'hg-mode-hook))
751
751
752 (defun hg-find-file-hook ()
752 (defun hg-find-file-hook ()
753 (when (hg-mode-line)
753 (when (hg-mode-line)
754 (hg-mode)))
754 (hg-mode)))
755
755
756 (add-hook 'find-file-hooks 'hg-find-file-hook)
756 (add-hook 'find-file-hooks 'hg-find-file-hook)
757
757
758 (defun hg-after-save-hook ()
758 (defun hg-after-save-hook ()
759 (let ((old-status hg-status))
759 (let ((old-status hg-status))
760 (hg-mode-line)
760 (hg-mode-line)
761 (if (and (not old-status) hg-status)
761 (if (and (not old-status) hg-status)
762 (hg-mode))))
762 (hg-mode))))
763
763
764 (add-hook 'after-save-hook 'hg-after-save-hook)
764 (add-hook 'after-save-hook 'hg-after-save-hook)
765
765
766
766
767 ;;; User interface functions.
767 ;;; User interface functions.
768
768
769 (defun hg-help-overview ()
769 (defun hg-help-overview ()
770 "This is an overview of the Mercurial SCM mode for Emacs.
770 "This is an overview of the Mercurial SCM mode for Emacs.
771
771
772 You can find the source code, license (GPL v2), and credits for this
772 You can find the source code, license (GPL v2), and credits for this
773 code by typing `M-x find-library mercurial RET'."
773 code by typing `M-x find-library mercurial RET'."
774 (interactive)
774 (interactive)
775 (hg-view-output ("Mercurial Help Overview")
775 (hg-view-output ("Mercurial Help Overview")
776 (insert (documentation 'hg-help-overview))
776 (insert (documentation 'hg-help-overview))
777 (let ((pos (point)))
777 (let ((pos (point)))
778 (insert (documentation 'hg-mode))
778 (insert (documentation 'hg-mode))
779 (goto-char pos)
779 (goto-char pos)
780 (end-of-line 1)
780 (end-of-line 1)
781 (delete-region pos (point)))
781 (delete-region pos (point)))
782 (let ((hg-root-dir (hg-root)))
782 (let ((hg-root-dir (hg-root)))
783 (if (not hg-root-dir)
783 (if (not hg-root-dir)
784 (error "error: %s: directory is not part of a Mercurial repository."
784 (error "error: %s: directory is not part of a Mercurial repository."
785 default-directory)
785 default-directory)
786 (cd hg-root-dir)))))
786 (cd hg-root-dir)))))
787
787
788 (defun hg-fix-paths ()
788 (defun hg-fix-paths ()
789 "Fix paths reported by some Mercurial commands."
789 "Fix paths reported by some Mercurial commands."
790 (save-excursion
790 (save-excursion
791 (goto-char (point-min))
791 (goto-char (point-min))
792 (while (re-search-forward " \\.\\.." nil t)
792 (while (re-search-forward " \\.\\.." nil t)
793 (replace-match " " nil nil))))
793 (replace-match " " nil nil))))
794
794
795 (defun hg-add (path)
795 (defun hg-add (path)
796 "Add PATH to the Mercurial repository on the next commit.
796 "Add PATH to the Mercurial repository on the next commit.
797 With a prefix argument, prompt for the path to add."
797 With a prefix argument, prompt for the path to add."
798 (interactive (list (hg-read-file-name " to add")))
798 (interactive (list (hg-read-file-name " to add")))
799 (let ((buf (current-buffer))
799 (let ((buf (current-buffer))
800 (update (equal buffer-file-name path)))
800 (update (equal buffer-file-name path)))
801 (hg-view-output (hg-output-buffer-name)
801 (hg-view-output (hg-output-buffer-name)
802 (apply 'call-process (hg-binary) nil t nil (list "add" path))
802 (apply 'call-process (hg-binary) nil t nil (list "add" path))
803 (hg-fix-paths)
803 (hg-fix-paths)
804 (goto-char (point-min))
804 (goto-char (point-min))
805 (cd (hg-root path)))
805 (cd (hg-root path)))
806 (when update
806 (when update
807 (unless vc-make-backup-files
807 (unless vc-make-backup-files
808 (set (make-local-variable 'backup-inhibited) t))
808 (set (make-local-variable 'backup-inhibited) t))
809 (with-current-buffer buf
809 (with-current-buffer buf
810 (hg-mode-line)))))
810 (hg-mode-line)))))
811
811
812 (defun hg-addremove ()
812 (defun hg-addremove ()
813 (interactive)
813 (interactive)
814 (error "not implemented"))
814 (error "not implemented"))
815
815
816 (defun hg-annotate ()
816 (defun hg-annotate ()
817 (interactive)
817 (interactive)
818 (error "not implemented"))
818 (error "not implemented"))
819
819
820 (defun hg-commit-toggle-file (pos)
820 (defun hg-commit-toggle-file (pos)
821 "Toggle whether or not the file at POS will be committed."
821 "Toggle whether or not the file at POS will be committed."
822 (interactive "d")
822 (interactive "d")
823 (save-excursion
823 (save-excursion
824 (goto-char pos)
824 (goto-char pos)
825 (let ((face (get-text-property pos 'face))
825 (let ((face (get-text-property pos 'face))
826 (inhibit-read-only t)
826 (inhibit-read-only t)
827 bol)
827 bol)
828 (beginning-of-line)
828 (beginning-of-line)
829 (setq bol (+ (point) 4))
829 (setq bol (+ (point) 4))
830 (end-of-line)
830 (end-of-line)
831 (if (eq face 'bold)
831 (if (eq face 'bold)
832 (progn
832 (progn
833 (remove-text-properties bol (point) '(face nil))
833 (remove-text-properties bol (point) '(face nil))
834 (message "%s will not be committed"
834 (message "%s will not be committed"
835 (buffer-substring bol (point))))
835 (buffer-substring bol (point))))
836 (add-text-properties bol (point) '(face bold))
836 (add-text-properties bol (point) '(face bold))
837 (message "%s will be committed"
837 (message "%s will be committed"
838 (buffer-substring bol (point)))))))
838 (buffer-substring bol (point)))))))
839
839
840 (defun hg-commit-mouse-clicked (event)
840 (defun hg-commit-mouse-clicked (event)
841 "Toggle whether or not the file at POS will be committed."
841 "Toggle whether or not the file at POS will be committed."
842 (interactive "@e")
842 (interactive "@e")
843 (hg-commit-toggle-file (hg-event-point event)))
843 (hg-commit-toggle-file (hg-event-point event)))
844
844
845 (defun hg-commit-kill ()
845 (defun hg-commit-kill ()
846 "Kill the commit currently being prepared."
846 "Kill the commit currently being prepared."
847 (interactive)
847 (interactive)
848 (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this commit? "))
848 (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this commit? "))
849 (let ((buf hg-prev-buffer))
849 (let ((buf hg-prev-buffer))
850 (kill-buffer nil)
850 (kill-buffer nil)
851 (switch-to-buffer buf))))
851 (switch-to-buffer buf))))
852
852
853 (defun hg-commit-finish ()
853 (defun hg-commit-finish ()
854 "Finish preparing a commit, and perform the actual commit.
854 "Finish preparing a commit, and perform the actual commit.
855 The hook hg-pre-commit-hook is run before anything else is done. If
855 The hook hg-pre-commit-hook is run before anything else is done. If
856 the commit message is empty and hg-commit-allow-empty-message is nil,
856 the commit message is empty and hg-commit-allow-empty-message is nil,
857 an error is raised. If the list of files to commit is empty and
857 an error is raised. If the list of files to commit is empty and
858 hg-commit-allow-empty-file-list is nil, an error is raised."
858 hg-commit-allow-empty-file-list is nil, an error is raised."
859 (interactive)
859 (interactive)
860 (let ((root hg-root))
860 (let ((root hg-root))
861 (save-excursion
861 (save-excursion
862 (run-hooks 'hg-pre-commit-hook)
862 (run-hooks 'hg-pre-commit-hook)
863 (goto-char (point-min))
863 (goto-char (point-min))
864 (search-forward hg-commit-message-start)
864 (search-forward hg-commit-message-start)
865 (let (message files)
865 (let (message files)
866 (let ((start (point)))
866 (let ((start (point)))
867 (goto-char (point-max))
867 (goto-char (point-max))
868 (search-backward hg-commit-message-end)
868 (search-backward hg-commit-message-end)
869 (setq message (hg-strip (buffer-substring start (point)))))
869 (setq message (hg-strip (buffer-substring start (point)))))
870 (when (and (= (length message) 0)
870 (when (and (= (length message) 0)
871 (not hg-commit-allow-empty-message))
871 (not hg-commit-allow-empty-message))
872 (error "Cannot proceed - commit message is empty"))
872 (error "Cannot proceed - commit message is empty"))
873 (forward-line 1)
873 (forward-line 1)
874 (beginning-of-line)
874 (beginning-of-line)
875 (while (< (point) (point-max))
875 (while (< (point) (point-max))
876 (let ((pos (+ (point) 4)))
876 (let ((pos (+ (point) 4)))
877 (end-of-line)
877 (end-of-line)
878 (when (eq (get-text-property pos 'face) 'bold)
878 (when (eq (get-text-property pos 'face) 'bold)
879 (end-of-line)
879 (end-of-line)
880 (setq files (cons (buffer-substring pos (point)) files))))
880 (setq files (cons (buffer-substring pos (point)) files))))
881 (forward-line 1))
881 (forward-line 1))
882 (when (and (= (length files) 0)
882 (when (and (= (length files) 0)
883 (not hg-commit-allow-empty-file-list))
883 (not hg-commit-allow-empty-file-list))
884 (error "Cannot proceed - no files to commit"))
884 (error "Cannot proceed - no files to commit"))
885 (setq message (concat message "\n"))
885 (setq message (concat message "\n"))
886 (apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files))
886 (apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files))
887 (let ((buf hg-prev-buffer))
887 (let ((buf hg-prev-buffer))
888 (kill-buffer nil)
888 (kill-buffer nil)
889 (switch-to-buffer buf))
889 (switch-to-buffer buf))
890 (hg-update-mode-lines root))))
890 (hg-update-mode-lines root))))
891
891
892 (defun hg-commit-mode ()
892 (defun hg-commit-mode ()
893 "Mode for describing a commit of changes to a Mercurial repository.
893 "Mode for describing a commit of changes to a Mercurial repository.
894 This involves two actions: describing the changes with a commit
894 This involves two actions: describing the changes with a commit
895 message, and choosing the files to commit.
895 message, and choosing the files to commit.
896
896
897 To describe the commit, simply type some text in the designated area.
897 To describe the commit, simply type some text in the designated area.
898
898
899 By default, all modified, added and removed files are selected for
899 By default, all modified, added and removed files are selected for
900 committing. Files that will be committed are displayed in bold face\;
900 committing. Files that will be committed are displayed in bold face\;
901 those that will not are displayed in normal face.
901 those that will not are displayed in normal face.
902
902
903 To toggle whether a file will be committed, move the cursor over a
903 To toggle whether a file will be committed, move the cursor over a
904 particular file and hit space or return. Alternatively, middle click
904 particular file and hit space or return. Alternatively, middle click
905 on the file.
905 on the file.
906
906
907 Key bindings
907 Key bindings
908 ------------
908 ------------
909 \\[hg-commit-finish] proceed with commit
909 \\[hg-commit-finish] proceed with commit
910 \\[hg-commit-kill] kill commit
910 \\[hg-commit-kill] kill commit
911
911
912 \\[hg-diff-repo] view diff of pending changes"
912 \\[hg-diff-repo] view diff of pending changes"
913 (interactive)
913 (interactive)
914 (use-local-map hg-commit-mode-map)
914 (use-local-map hg-commit-mode-map)
915 (set-syntax-table text-mode-syntax-table)
915 (set-syntax-table text-mode-syntax-table)
916 (setq local-abbrev-table text-mode-abbrev-table
916 (setq local-abbrev-table text-mode-abbrev-table
917 major-mode 'hg-commit-mode
917 major-mode 'hg-commit-mode
918 mode-name "Hg-Commit")
918 mode-name "Hg-Commit")
919 (set-buffer-modified-p nil)
919 (set-buffer-modified-p nil)
920 (setq buffer-undo-list nil)
920 (setq buffer-undo-list nil)
921 (run-hooks 'text-mode-hook 'hg-commit-mode-hook))
921 (run-hooks 'text-mode-hook 'hg-commit-mode-hook))
922
922
923 (defun hg-commit-start ()
923 (defun hg-commit-start ()
924 "Prepare a commit of changes to the repository containing the current file."
924 "Prepare a commit of changes to the repository containing the current file."
925 (interactive)
925 (interactive)
926 (while hg-prev-buffer
926 (while hg-prev-buffer
927 (set-buffer hg-prev-buffer))
927 (set-buffer hg-prev-buffer))
928 (let ((root (hg-root))
928 (let ((root (hg-root))
929 (prev-buffer (current-buffer))
929 (prev-buffer (current-buffer))
930 modified-files)
930 modified-files)
931 (unless root
931 (unless root
932 (error "Cannot commit outside a repository!"))
932 (error "Cannot commit outside a repository!"))
933 (hg-sync-buffers root)
933 (hg-sync-buffers root)
934 (setq modified-files (hg-chomp (hg-run0 "--cwd" root "status" "-arm")))
934 (setq modified-files (hg-chomp (hg-run0 "--cwd" root "status" "-arm")))
935 (when (and (= (length modified-files) 0)
935 (when (and (= (length modified-files) 0)
936 (not hg-commit-allow-empty-file-list))
936 (not hg-commit-allow-empty-file-list))
937 (error "No pending changes to commit"))
937 (error "No pending changes to commit"))
938 (let* ((buf-name (format "*Mercurial: Commit %s*" root)))
938 (let* ((buf-name (format "*Mercurial: Commit %s*" root)))
939 (pop-to-buffer (get-buffer-create buf-name))
939 (pop-to-buffer (get-buffer-create buf-name))
940 (when (= (point-min) (point-max))
940 (when (= (point-min) (point-max))
941 (set (make-local-variable 'hg-root) root)
941 (set (make-local-variable 'hg-root) root)
942 (setq hg-prev-buffer prev-buffer)
942 (setq hg-prev-buffer prev-buffer)
943 (insert "\n")
943 (insert "\n")
944 (let ((bol (point)))
944 (let ((bol (point)))
945 (insert hg-commit-message-end)
945 (insert hg-commit-message-end)
946 (add-text-properties bol (point) '(face bold-italic)))
946 (add-text-properties bol (point) '(face bold-italic)))
947 (let ((file-area (point)))
947 (let ((file-area (point)))
948 (insert modified-files)
948 (insert modified-files)
949 (goto-char file-area)
949 (goto-char file-area)
950 (while (< (point) (point-max))
950 (while (< (point) (point-max))
951 (let ((bol (point)))
951 (let ((bol (point)))
952 (forward-char 1)
952 (forward-char 1)
953 (insert " ")
953 (insert " ")
954 (end-of-line)
954 (end-of-line)
955 (add-text-properties (+ bol 4) (point)
955 (add-text-properties (+ bol 4) (point)
956 '(face bold mouse-face highlight)))
956 '(face bold mouse-face highlight)))
957 (forward-line 1))
957 (forward-line 1))
958 (goto-char file-area)
958 (goto-char file-area)
959 (add-text-properties (point) (point-max)
959 (add-text-properties (point) (point-max)
960 `(keymap ,hg-commit-mode-file-map))
960 `(keymap ,hg-commit-mode-file-map))
961 (goto-char (point-min))
961 (goto-char (point-min))
962 (insert hg-commit-message-start)
962 (insert hg-commit-message-start)
963 (add-text-properties (point-min) (point) '(face bold-italic))
963 (add-text-properties (point-min) (point) '(face bold-italic))
964 (insert "\n\n")
964 (insert "\n\n")
965 (forward-line -1)
965 (forward-line -1)
966 (save-excursion
966 (save-excursion
967 (goto-char (point-max))
967 (goto-char (point-max))
968 (search-backward hg-commit-message-end)
968 (search-backward hg-commit-message-end)
969 (add-text-properties (match-beginning 0) (point-max)
969 (add-text-properties (match-beginning 0) (point-max)
970 '(read-only t))
970 '(read-only t))
971 (goto-char (point-min))
971 (goto-char (point-min))
972 (search-forward hg-commit-message-start)
972 (search-forward hg-commit-message-start)
973 (add-text-properties (match-beginning 0) (match-end 0)
973 (add-text-properties (match-beginning 0) (match-end 0)
974 '(read-only t)))
974 '(read-only t)))
975 (hg-commit-mode)
975 (hg-commit-mode)
976 (cd root))))))
976 (cd root))))))
977
977
978 (defun hg-diff (path &optional rev1 rev2)
978 (defun hg-diff (path &optional rev1 rev2)
979 "Show the differences between REV1 and REV2 of PATH.
979 "Show the differences between REV1 and REV2 of PATH.
980 When called interactively, the default behaviour is to treat REV1 as
980 When called interactively, the default behaviour is to treat REV1 as
981 the \"parent\" revision, REV2 as the current edited version of the file, and
981 the \"parent\" revision, REV2 as the current edited version of the file, and
982 PATH as the file edited in the current buffer.
982 PATH as the file edited in the current buffer.
983 With a prefix argument, prompt for all of these."
983 With a prefix argument, prompt for all of these."
984 (interactive (list (hg-read-file-name " to diff")
984 (interactive (list (hg-read-file-name " to diff")
985 (let ((rev1 (hg-read-rev " to start with" 'parent)))
985 (let ((rev1 (hg-read-rev " to start with" 'parent)))
986 (and (not (eq rev1 'parent)) rev1))
986 (and (not (eq rev1 'parent)) rev1))
987 (let ((rev2 (hg-read-rev " to end with" 'working-dir)))
987 (let ((rev2 (hg-read-rev " to end with" 'working-dir)))
988 (and (not (eq rev2 'working-dir)) rev2))))
988 (and (not (eq rev2 'working-dir)) rev2))))
989 (hg-sync-buffers path)
989 (hg-sync-buffers path)
990 (let ((a-path (hg-abbrev-file-name path))
990 (let ((a-path (hg-abbrev-file-name path))
991 ;; none revision is specified explicitly
991 ;; none revision is specified explicitly
992 (none (and (not rev1) (not rev2)))
992 (none (and (not rev1) (not rev2)))
993 ;; only one revision is specified explicitly
993 ;; only one revision is specified explicitly
994 (one (or (and (or (equal rev1 rev2) (not rev2)) rev1)
994 (one (or (and (or (equal rev1 rev2) (not rev2)) rev1)
995 (and (not rev1) rev2)))
995 (and (not rev1) rev2)))
996 diff)
996 diff)
997 (hg-view-output ((cond
997 (hg-view-output ((cond
998 (none
998 (none
999 (format "Mercurial: Diff against parent of %s" a-path))
999 (format "Mercurial: Diff against parent of %s" a-path))
1000 (one
1000 (one
1001 (format "Mercurial: Diff of rev %s of %s" one a-path))
1001 (format "Mercurial: Diff of rev %s of %s" one a-path))
1002 (t
1002 (t
1003 (format "Mercurial: Diff from rev %s to %s of %s"
1003 (format "Mercurial: Diff from rev %s to %s of %s"
1004 rev1 rev2 a-path))))
1004 rev1 rev2 a-path))))
1005 (cond
1005 (cond
1006 (none
1006 (none
1007 (call-process (hg-binary) nil t nil "diff" path))
1007 (call-process (hg-binary) nil t nil "diff" path))
1008 (one
1008 (one
1009 (call-process (hg-binary) nil t nil "diff" "-r" one path))
1009 (call-process (hg-binary) nil t nil "diff" "-r" one path))
1010 (t
1010 (t
1011 (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path)))
1011 (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path)))
1012 (diff-mode)
1012 (diff-mode)
1013 (setq diff (not (= (point-min) (point-max))))
1013 (setq diff (not (= (point-min) (point-max))))
1014 (font-lock-fontify-buffer)
1014 (font-lock-fontify-buffer)
1015 (cd (hg-root path)))
1015 (cd (hg-root path)))
1016 diff))
1016 diff))
1017
1017
1018 (defun hg-diff-repo (path &optional rev1 rev2)
1018 (defun hg-diff-repo (path &optional rev1 rev2)
1019 "Show the differences between REV1 and REV2 of repository containing PATH.
1019 "Show the differences between REV1 and REV2 of repository containing PATH.
1020 When called interactively, the default behaviour is to treat REV1 as
1020 When called interactively, the default behaviour is to treat REV1 as
1021 the \"parent\" revision, REV2 as the current edited version of the file, and
1021 the \"parent\" revision, REV2 as the current edited version of the file, and
1022 PATH as the `hg-root' of the current buffer.
1022 PATH as the `hg-root' of the current buffer.
1023 With a prefix argument, prompt for all of these."
1023 With a prefix argument, prompt for all of these."
1024 (interactive (list (hg-read-file-name " to diff")
1024 (interactive (list (hg-read-file-name " to diff")
1025 (let ((rev1 (hg-read-rev " to start with" 'parent)))
1025 (let ((rev1 (hg-read-rev " to start with" 'parent)))
1026 (and (not (eq rev1 'parent)) rev1))
1026 (and (not (eq rev1 'parent)) rev1))
1027 (let ((rev2 (hg-read-rev " to end with" 'working-dir)))
1027 (let ((rev2 (hg-read-rev " to end with" 'working-dir)))
1028 (and (not (eq rev2 'working-dir)) rev2))))
1028 (and (not (eq rev2 'working-dir)) rev2))))
1029 (hg-diff (hg-root path) rev1 rev2))
1029 (hg-diff (hg-root path) rev1 rev2))
1030
1030
1031 (defun hg-forget (path)
1031 (defun hg-forget (path)
1032 "Lose track of PATH, which has been added, but not yet committed.
1032 "Lose track of PATH, which has been added, but not yet committed.
1033 This will prevent the file from being incorporated into the Mercurial
1033 This will prevent the file from being incorporated into the Mercurial
1034 repository on the next commit.
1034 repository on the next commit.
1035 With a prefix argument, prompt for the path to forget."
1035 With a prefix argument, prompt for the path to forget."
1036 (interactive (list (hg-read-file-name " to forget")))
1036 (interactive (list (hg-read-file-name " to forget")))
1037 (let ((buf (current-buffer))
1037 (let ((buf (current-buffer))
1038 (update (equal buffer-file-name path)))
1038 (update (equal buffer-file-name path)))
1039 (hg-view-output (hg-output-buffer-name)
1039 (hg-view-output (hg-output-buffer-name)
1040 (apply 'call-process (hg-binary) nil t nil (list "forget" path))
1040 (apply 'call-process (hg-binary) nil t nil (list "forget" path))
1041 ;; "hg forget" shows pathes relative NOT TO ROOT BUT TO REPOSITORY
1041 ;; "hg forget" shows pathes relative NOT TO ROOT BUT TO REPOSITORY
1042 (hg-fix-paths)
1042 (hg-fix-paths)
1043 (goto-char (point-min))
1043 (goto-char (point-min))
1044 (cd (hg-root path)))
1044 (cd (hg-root path)))
1045 (when update
1045 (when update
1046 (with-current-buffer buf
1046 (with-current-buffer buf
1047 (when (local-variable-p 'backup-inhibited)
1047 (when (local-variable-p 'backup-inhibited)
1048 (kill-local-variable 'backup-inhibited))
1048 (kill-local-variable 'backup-inhibited))
1049 (hg-mode-line)))))
1049 (hg-mode-line)))))
1050
1050
1051 (defun hg-incoming (&optional repo)
1051 (defun hg-incoming (&optional repo)
1052 "Display changesets present in REPO that are not present locally."
1052 "Display changesets present in REPO that are not present locally."
1053 (interactive (list (hg-read-repo-name " where changes would come from")))
1053 (interactive (list (hg-read-repo-name " where changes would come from")))
1054 (hg-view-output ((format "Mercurial: Incoming from %s to %s"
1054 (hg-view-output ((format "Mercurial: Incoming from %s to %s"
1055 (hg-abbrev-file-name (hg-root))
1055 (hg-abbrev-file-name (hg-root))
1056 (hg-abbrev-file-name
1056 (hg-abbrev-file-name
1057 (or repo hg-incoming-repository))))
1057 (or repo hg-incoming-repository))))
1058 (call-process (hg-binary) nil t nil "incoming"
1058 (call-process (hg-binary) nil t nil "incoming"
1059 (or repo hg-incoming-repository))
1059 (or repo hg-incoming-repository))
1060 (hg-log-mode)
1060 (hg-log-mode)
1061 (cd (hg-root))))
1061 (cd (hg-root))))
1062
1062
1063 (defun hg-init ()
1063 (defun hg-init ()
1064 (interactive)
1064 (interactive)
1065 (error "not implemented"))
1065 (error "not implemented"))
1066
1066
1067 (defun hg-log-mode ()
1067 (defun hg-log-mode ()
1068 "Mode for viewing a Mercurial change log."
1068 "Mode for viewing a Mercurial change log."
1069 (goto-char (point-min))
1069 (goto-char (point-min))
1070 (when (looking-at "^searching for changes.*$")
1070 (when (looking-at "^searching for changes.*$")
1071 (delete-region (match-beginning 0) (match-end 0)))
1071 (delete-region (match-beginning 0) (match-end 0)))
1072 (run-hooks 'hg-log-mode-hook))
1072 (run-hooks 'hg-log-mode-hook))
1073
1073
1074 (defun hg-log (path &optional rev1 rev2 log-limit)
1074 (defun hg-log (path &optional rev1 rev2 log-limit)
1075 "Display the revision history of PATH.
1075 "Display the revision history of PATH.
1076 History is displayed between REV1 and REV2.
1076 History is displayed between REV1 and REV2.
1077 Number of displayed changesets is limited to LOG-LIMIT.
1077 Number of displayed changesets is limited to LOG-LIMIT.
1078 REV1 defaults to the tip, while
1078 REV1 defaults to the tip, while
1079 REV2 defaults to `hg-rev-completion-limit' changes from the tip revision.
1079 REV2 defaults to `hg-rev-completion-limit' changes from the tip revision.
1080 LOG-LIMIT defaults to `hg-log-limit'.
1080 LOG-LIMIT defaults to `hg-log-limit'.
1081 With a prefix argument, prompt for each parameter."
1081 With a prefix argument, prompt for each parameter."
1082 (interactive (list (hg-read-file-name " to log")
1082 (interactive (list (hg-read-file-name " to log")
1083 (hg-read-rev " to start with"
1083 (hg-read-rev " to start with"
1084 "tip")
1084 "tip")
1085 (hg-read-rev " to end with"
1085 (hg-read-rev " to end with"
1086 (format "%d" (- hg-rev-completion-limit)))
1086 (format "%d" (- hg-rev-completion-limit)))
1087 (hg-read-number "Output limited to: "
1087 (hg-read-number "Output limited to: "
1088 hg-log-limit)))
1088 hg-log-limit)))
1089 (let ((a-path (hg-abbrev-file-name path))
1089 (let ((a-path (hg-abbrev-file-name path))
1090 (r1 (or rev1 (format "-%d" hg-rev-completion-limit)))
1090 (r1 (or rev1 (format "-%d" hg-rev-completion-limit)))
1091 (r2 (or rev2 rev1 "tip"))
1091 (r2 (or rev2 rev1 "tip"))
1092 (limit (format "%d" (or log-limit hg-log-limit))))
1092 (limit (format "%d" (or log-limit hg-log-limit))))
1093 (hg-view-output ((if (equal r1 r2)
1093 (hg-view-output ((if (equal r1 r2)
1094 (format "Mercurial: Log of rev %s of %s" rev1 a-path)
1094 (format "Mercurial: Log of rev %s of %s" rev1 a-path)
1095 (format
1095 (format
1096 "Mercurial: at most %s log(s) from rev %s to %s of %s"
1096 "Mercurial: at most %s log(s) from rev %s to %s of %s"
1097 limit r1 r2 a-path)))
1097 limit r1 r2 a-path)))
1098 (eval (list* 'call-process (hg-binary) nil t nil
1098 (eval (list* 'call-process (hg-binary) nil t nil
1099 "log"
1099 "log"
1100 "-r" (format "%s:%s" r1 r2)
1100 "-r" (format "%s:%s" r1 r2)
1101 "-l" limit
1101 "-l" limit
1102 (if (> (length path) (length (hg-root path)))
1102 (if (> (length path) (length (hg-root path)))
1103 (cons path nil)
1103 (cons path nil)
1104 nil)))
1104 nil)))
1105 (hg-log-mode)
1105 (hg-log-mode)
1106 (cd (hg-root path)))))
1106 (cd (hg-root path)))))
1107
1107
1108 (defun hg-log-repo (path &optional rev1 rev2 log-limit)
1108 (defun hg-log-repo (path &optional rev1 rev2 log-limit)
1109 "Display the revision history of the repository containing PATH.
1109 "Display the revision history of the repository containing PATH.
1110 History is displayed between REV1 and REV2.
1110 History is displayed between REV1 and REV2.
1111 Number of displayed changesets is limited to LOG-LIMIT,
1111 Number of displayed changesets is limited to LOG-LIMIT,
1112 REV1 defaults to the tip, while
1112 REV1 defaults to the tip, while
1113 REV2 defaults to `hg-rev-completion-limit' changes from the tip revision.
1113 REV2 defaults to `hg-rev-completion-limit' changes from the tip revision.
1114 LOG-LIMIT defaults to `hg-log-limit'.
1114 LOG-LIMIT defaults to `hg-log-limit'.
1115 With a prefix argument, prompt for each parameter."
1115 With a prefix argument, prompt for each parameter."
1116 (interactive (list (hg-read-file-name " to log")
1116 (interactive (list (hg-read-file-name " to log")
1117 (hg-read-rev " to start with"
1117 (hg-read-rev " to start with"
1118 "tip")
1118 "tip")
1119 (hg-read-rev " to end with"
1119 (hg-read-rev " to end with"
1120 (format "%d" (- hg-rev-completion-limit)))
1120 (format "%d" (- hg-rev-completion-limit)))
1121 (hg-read-number "Output limited to: "
1121 (hg-read-number "Output limited to: "
1122 hg-log-limit)))
1122 hg-log-limit)))
1123 (hg-log (hg-root path) rev1 rev2 log-limit))
1123 (hg-log (hg-root path) rev1 rev2 log-limit))
1124
1124
1125 (defun hg-outgoing (&optional repo)
1125 (defun hg-outgoing (&optional repo)
1126 "Display changesets present locally that are not present in REPO."
1126 "Display changesets present locally that are not present in REPO."
1127 (interactive (list (hg-read-repo-name " where changes would go to" nil
1127 (interactive (list (hg-read-repo-name " where changes would go to" nil
1128 hg-outgoing-repository)))
1128 hg-outgoing-repository)))
1129 (hg-view-output ((format "Mercurial: Outgoing from %s to %s"
1129 (hg-view-output ((format "Mercurial: Outgoing from %s to %s"
1130 (hg-abbrev-file-name (hg-root))
1130 (hg-abbrev-file-name (hg-root))
1131 (hg-abbrev-file-name
1131 (hg-abbrev-file-name
1132 (or repo hg-outgoing-repository))))
1132 (or repo hg-outgoing-repository))))
1133 (call-process (hg-binary) nil t nil "outgoing"
1133 (call-process (hg-binary) nil t nil "outgoing"
1134 (or repo hg-outgoing-repository))
1134 (or repo hg-outgoing-repository))
1135 (hg-log-mode)
1135 (hg-log-mode)
1136 (cd (hg-root))))
1136 (cd (hg-root))))
1137
1137
1138 (defun hg-pull (&optional repo)
1138 (defun hg-pull (&optional repo)
1139 "Pull changes from repository REPO.
1139 "Pull changes from repository REPO.
1140 This does not update the working directory."
1140 This does not update the working directory."
1141 (interactive (list (hg-read-repo-name " to pull from")))
1141 (interactive (list (hg-read-repo-name " to pull from")))
1142 (hg-view-output ((format "Mercurial: Pull to %s from %s"
1142 (hg-view-output ((format "Mercurial: Pull to %s from %s"
1143 (hg-abbrev-file-name (hg-root))
1143 (hg-abbrev-file-name (hg-root))
1144 (hg-abbrev-file-name
1144 (hg-abbrev-file-name
1145 (or repo hg-incoming-repository))))
1145 (or repo hg-incoming-repository))))
1146 (call-process (hg-binary) nil t nil "pull"
1146 (call-process (hg-binary) nil t nil "pull"
1147 (or repo hg-incoming-repository))
1147 (or repo hg-incoming-repository))
1148 (cd (hg-root))))
1148 (cd (hg-root))))
1149
1149
1150 (defun hg-push (&optional repo)
1150 (defun hg-push (&optional repo)
1151 "Push changes to repository REPO."
1151 "Push changes to repository REPO."
1152 (interactive (list (hg-read-repo-name " to push to")))
1152 (interactive (list (hg-read-repo-name " to push to")))
1153 (hg-view-output ((format "Mercurial: Push from %s to %s"
1153 (hg-view-output ((format "Mercurial: Push from %s to %s"
1154 (hg-abbrev-file-name (hg-root))
1154 (hg-abbrev-file-name (hg-root))
1155 (hg-abbrev-file-name
1155 (hg-abbrev-file-name
1156 (or repo hg-outgoing-repository))))
1156 (or repo hg-outgoing-repository))))
1157 (call-process (hg-binary) nil t nil "push"
1157 (call-process (hg-binary) nil t nil "push"
1158 (or repo hg-outgoing-repository))
1158 (or repo hg-outgoing-repository))
1159 (cd (hg-root))))
1159 (cd (hg-root))))
1160
1160
1161 (defun hg-revert-buffer-internal ()
1161 (defun hg-revert-buffer-internal ()
1162 (let ((ctx (hg-buffer-context)))
1162 (let ((ctx (hg-buffer-context)))
1163 (message "Reverting %s..." buffer-file-name)
1163 (message "Reverting %s..." buffer-file-name)
1164 (hg-run0 "revert" buffer-file-name)
1164 (hg-run0 "revert" buffer-file-name)
1165 (revert-buffer t t t)
1165 (revert-buffer t t t)
1166 (hg-restore-context ctx)
1166 (hg-restore-context ctx)
1167 (hg-mode-line)
1167 (hg-mode-line)
1168 (message "Reverting %s...done" buffer-file-name)))
1168 (message "Reverting %s...done" buffer-file-name)))
1169
1169
1170 (defun hg-revert-buffer ()
1170 (defun hg-revert-buffer ()
1171 "Revert current buffer's file back to the latest committed version.
1171 "Revert current buffer's file back to the latest committed version.
1172 If the file has not changed, nothing happens. Otherwise, this
1172 If the file has not changed, nothing happens. Otherwise, this
1173 displays a diff and asks for confirmation before reverting."
1173 displays a diff and asks for confirmation before reverting."
1174 (interactive)
1174 (interactive)
1175 (let ((vc-suppress-confirm nil)
1175 (let ((vc-suppress-confirm nil)
1176 (obuf (current-buffer))
1176 (obuf (current-buffer))
1177 diff)
1177 diff)
1178 (vc-buffer-sync)
1178 (vc-buffer-sync)
1179 (unwind-protect
1179 (unwind-protect
1180 (setq diff (hg-diff buffer-file-name))
1180 (setq diff (hg-diff buffer-file-name))
1181 (when diff
1181 (when diff
1182 (unless (yes-or-no-p "Discard changes? ")
1182 (unless (yes-or-no-p "Discard changes? ")
1183 (error "Revert cancelled")))
1183 (error "Revert cancelled")))
1184 (when diff
1184 (when diff
1185 (let ((buf (current-buffer)))
1185 (let ((buf (current-buffer)))
1186 (delete-window (selected-window))
1186 (delete-window (selected-window))
1187 (kill-buffer buf))))
1187 (kill-buffer buf))))
1188 (set-buffer obuf)
1188 (set-buffer obuf)
1189 (when diff
1189 (when diff
1190 (hg-revert-buffer-internal))))
1190 (hg-revert-buffer-internal))))
1191
1191
1192 (defun hg-root (&optional path)
1192 (defun hg-root (&optional path)
1193 "Return the root of the repository that contains the given path.
1193 "Return the root of the repository that contains the given path.
1194 If the path is outside a repository, return nil.
1194 If the path is outside a repository, return nil.
1195 When called interactively, the root is printed. A prefix argument
1195 When called interactively, the root is printed. A prefix argument
1196 prompts for a path to check."
1196 prompts for a path to check."
1197 (interactive (list (hg-read-file-name)))
1197 (interactive (list (hg-read-file-name)))
1198 (if (or path (not hg-root))
1198 (if (or path (not hg-root))
1199 (let ((root (do ((prev nil dir)
1199 (let ((root (do ((prev nil dir)
1200 (dir (file-name-directory
1200 (dir (file-name-directory
1201 (or
1201 (or
1202 path
1202 path
1203 buffer-file-name
1203 buffer-file-name
1204 (expand-file-name default-directory)))
1204 (expand-file-name default-directory)))
1205 (file-name-directory (directory-file-name dir))))
1205 (file-name-directory (directory-file-name dir))))
1206 ((equal prev dir))
1206 ((equal prev dir))
1207 (when (file-directory-p (concat dir ".hg"))
1207 (when (file-directory-p (concat dir ".hg"))
1208 (return dir)))))
1208 (return dir)))))
1209 (when (interactive-p)
1209 (when (interactive-p)
1210 (if root
1210 (if root
1211 (message "The root of this repository is `%s'." root)
1211 (message "The root of this repository is `%s'." root)
1212 (message "The path `%s' is not in a Mercurial repository."
1212 (message "The path `%s' is not in a Mercurial repository."
1213 (hg-abbrev-file-name path))))
1213 (hg-abbrev-file-name path))))
1214 root)
1214 root)
1215 hg-root))
1215 hg-root))
1216
1216
1217 (defun hg-cwd (&optional path)
1217 (defun hg-cwd (&optional path)
1218 "Return the current directory of PATH within the repository."
1218 "Return the current directory of PATH within the repository."
1219 (do ((stack nil (cons (file-name-nondirectory
1219 (do ((stack nil (cons (file-name-nondirectory
1220 (directory-file-name dir))
1220 (directory-file-name dir))
1221 stack))
1221 stack))
1222 (prev nil dir)
1222 (prev nil dir)
1223 (dir (file-name-directory (or path buffer-file-name
1223 (dir (file-name-directory (or path buffer-file-name
1224 (expand-file-name default-directory)))
1224 (expand-file-name default-directory)))
1225 (file-name-directory (directory-file-name dir))))
1225 (file-name-directory (directory-file-name dir))))
1226 ((equal prev dir))
1226 ((equal prev dir))
1227 (when (file-directory-p (concat dir ".hg"))
1227 (when (file-directory-p (concat dir ".hg"))
1228 (let ((cwd (mapconcat 'identity stack "/")))
1228 (let ((cwd (mapconcat 'identity stack "/")))
1229 (unless (equal cwd "")
1229 (unless (equal cwd "")
1230 (return (file-name-as-directory cwd)))))))
1230 (return (file-name-as-directory cwd)))))))
1231
1231
1232 (defun hg-status (path)
1232 (defun hg-status (path)
1233 "Print revision control status of a file or directory.
1233 "Print revision control status of a file or directory.
1234 With prefix argument, prompt for the path to give status for.
1234 With prefix argument, prompt for the path to give status for.
1235 Names are displayed relative to the repository root."
1235 Names are displayed relative to the repository root."
1236 (interactive (list (hg-read-file-name " for status" (hg-root))))
1236 (interactive (list (hg-read-file-name " for status" (hg-root))))
1237 (let ((root (hg-root)))
1237 (let ((root (hg-root)))
1238 (hg-view-output ((format "Mercurial: Status of %s in %s"
1238 (hg-view-output ((format "Mercurial: Status of %s in %s"
1239 (let ((name (substring (expand-file-name path)
1239 (let ((name (substring (expand-file-name path)
1240 (length root))))
1240 (length root))))
1241 (if (> (length name) 0)
1241 (if (> (length name) 0)
1242 name
1242 name
1243 "*"))
1243 "*"))
1244 (hg-abbrev-file-name root)))
1244 (hg-abbrev-file-name root)))
1245 (apply 'call-process (hg-binary) nil t nil
1245 (apply 'call-process (hg-binary) nil t nil
1246 (list "--cwd" root "status" path))
1246 (list "--cwd" root "status" path))
1247 (cd (hg-root path)))))
1247 (cd (hg-root path)))))
1248
1248
1249 (defun hg-undo ()
1249 (defun hg-undo ()
1250 (interactive)
1250 (interactive)
1251 (error "not implemented"))
1251 (error "not implemented"))
1252
1252
1253 (defun hg-update ()
1253 (defun hg-update ()
1254 (interactive)
1254 (interactive)
1255 (error "not implemented"))
1255 (error "not implemented"))
1256
1256
1257 (defun hg-version-other-window ()
1257 (defun hg-version-other-window ()
1258 (interactive)
1258 (interactive)
1259 (error "not implemented"))
1259 (error "not implemented"))
1260
1260
1261
1261
1262 (provide 'mercurial)
1262 (provide 'mercurial)
1263
1263
1264
1264
1265 ;;; Local Variables:
1265 ;;; Local Variables:
1266 ;;; prompt-to-byte-compile: nil
1266 ;;; prompt-to-byte-compile: nil
1267 ;;; end:
1267 ;;; end:
General Comments 0
You need to be logged in to leave comments. Login now