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