4 |
4 |
5 ;; Author: Bryan O'Sullivan <bos@serpentine.com> |
5 ;; Author: Bryan O'Sullivan <bos@serpentine.com> |
6 |
6 |
7 ;; $Id$ |
7 ;; $Id$ |
8 |
8 |
9 ;; mercurial.el ("this file") is free software; you can redistribute |
9 ;; mercurial.el is free software; you can redistribute it and/or |
10 ;; it and/or modify it under the terms of version 2 of the GNU General |
10 ;; modify it under the terms of version 2 of the GNU General Public |
11 ;; Public License as published by the Free Software Foundation. |
11 ;; License as published by the Free Software Foundation. |
12 |
12 |
13 ;; This file is distributed in the hope that it will be useful, but |
13 ;; mercurial.el is distributed in the hope that it will be useful, but |
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
16 ;; General Public License for more details. |
16 ;; General Public License for more details. |
17 |
17 |
18 ;; You should have received a copy of the GNU General Public License |
18 ;; You should have received a copy of the GNU General Public License |
19 ;; along with this file, GNU Emacs, or XEmacs; see the file COPYING |
19 ;; along with mercurial.el, GNU Emacs, or XEmacs; see the file COPYING |
20 ;; (`C-h C-l'). If not, write to the Free Software Foundation, Inc., |
20 ;; (`C-h C-l'). If not, write to the Free Software Foundation, Inc., |
21 ;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
21 ;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
22 |
22 |
23 ;;; Commentary: |
23 ;;; Commentary: |
24 |
24 |
25 ;; This mode builds upon Emacs's VC mode to provide flexible |
25 ;; This mode builds upon Emacs's VC mode to provide flexible |
26 ;; integration with the Mercurial distributed SCM tool. |
26 ;; integration with the Mercurial distributed SCM tool. |
27 |
27 |
28 ;; To get going as quickly as possible, load this file into Emacs and |
28 ;; To get going as quickly as possible, load mercurial.el into Emacs and |
29 ;; type `C-c h h'; this runs hg-help-overview, which prints a helpful |
29 ;; type `C-c h h'; this runs hg-help-overview, which prints a helpful |
30 ;; usage overview. |
30 ;; usage overview. |
31 |
31 |
32 ;; Much of the inspiration for mercurial.el comes from Rajesh |
32 ;; Much of the inspiration for mercurial.el comes from Rajesh |
33 ;; Vaidheeswarran's excellent p4.el, which does an admirably thorough |
33 ;; Vaidheeswarran's excellent p4.el, which does an admirably thorough |
74 "/usr/local/bin/hg")) |
74 "/usr/local/bin/hg")) |
75 (when (file-executable-p path) |
75 (when (file-executable-p path) |
76 (return path))) |
76 (return path))) |
77 "The path to Mercurial's hg executable." |
77 "The path to Mercurial's hg executable." |
78 :type '(file :must-match t) |
78 :type '(file :must-match t) |
79 :group 'hg) |
79 :group 'mercurial) |
80 |
80 |
81 (defcustom hg-mode-hook nil |
81 (defcustom hg-mode-hook nil |
82 "Hook run when a buffer enters hg-mode." |
82 "Hook run when a buffer enters hg-mode." |
83 :type 'sexp |
83 :type 'sexp |
84 :group 'hg) |
84 :group 'mercurial) |
85 |
85 |
86 (defcustom hg-global-prefix "\C-ch" |
86 (defcustom hg-global-prefix "\C-ch" |
87 "The global prefix for Mercurial keymap bindings." |
87 "The global prefix for Mercurial keymap bindings." |
88 :type 'sexp |
88 :type 'sexp |
89 :group 'hg) |
89 :group 'mercurial) |
|
90 |
|
91 (defcustom hg-rev-completion-limit 100 |
|
92 "The maximum number of revisions that hg-read-rev will offer to complete. |
|
93 This affects memory usage and performance when prompting for revisions |
|
94 in a repository with a lot of history." |
|
95 :type 'integer |
|
96 :group 'mercurial) |
|
97 |
|
98 (defcustom hg-log-limit 50 |
|
99 "The maximum number of revisions that hg-log will display." |
|
100 :type 'integer |
|
101 :group 'mercurial) |
90 |
102 |
91 |
103 |
92 ;;; Other variables. |
104 ;;; Other variables. |
93 |
105 |
94 (defconst hg-running-xemacs (string-match "XEmacs" emacs-version) |
106 (defconst hg-running-xemacs (string-match "XEmacs" emacs-version) |
95 "Is mercurial.el running under XEmacs?") |
107 "Is mercurial.el running under XEmacs?") |
96 |
108 |
97 (defvar hg-mode nil |
109 (defvar hg-mode nil |
98 "Is this file managed by Mercurial?") |
110 "Is this file managed by Mercurial?") |
|
111 (make-variable-buffer-local 'hg-mode) |
|
112 (put 'hg-mode 'permanent-local t) |
|
113 |
|
114 (defvar hg-status nil) |
|
115 (make-variable-buffer-local 'hg-status) |
|
116 (put 'hg-status 'permanent-local t) |
99 |
117 |
100 (defvar hg-output-buffer-name "*Hg*" |
118 (defvar hg-output-buffer-name "*Hg*" |
101 "The name to use for Mercurial output buffers.") |
119 "The name to use for Mercurial output buffers.") |
102 |
120 |
103 (defvar hg-file-name-history nil) |
121 (defvar hg-file-history nil) |
|
122 (defvar hg-rev-history nil) |
104 |
123 |
105 |
124 |
106 ;;; hg-mode keymap. |
125 ;;; hg-mode keymap. |
107 |
126 |
108 (defvar hg-prefix-map |
127 (defvar hg-prefix-map |
109 (let ((map (copy-keymap vc-prefix-map))) |
128 (let ((map (copy-keymap vc-prefix-map))) |
110 (set-keymap-name map 'hg-prefix-map) |
129 (set-keymap-name map 'hg-prefix-map) |
111 map) |
130 map) |
112 "This keymap overrides some default vc-mode bindings.") |
131 "This keymap overrides some default vc-mode bindings.") |
113 (fset 'hg-prefix-map hg-prefix-map) |
132 (fset 'hg-prefix-map hg-prefix-map) |
114 (define-key hg-prefix-map "=" 'hg-diff-file) |
133 (define-key hg-prefix-map "=" 'hg-diff) |
115 (define-key hg-prefix-map "c" 'hg-undo) |
134 (define-key hg-prefix-map "c" 'hg-undo) |
116 (define-key hg-prefix-map "g" 'hg-annotate) |
135 (define-key hg-prefix-map "g" 'hg-annotate) |
117 (define-key hg-prefix-map "l" 'hg-log-file) |
136 (define-key hg-prefix-map "l" 'hg-log) |
|
137 (define-key hg-prefix-map "n" 'hg-commit-file) |
118 ;; (define-key hg-prefix-map "r" 'hg-update) |
138 ;; (define-key hg-prefix-map "r" 'hg-update) |
119 (define-key hg-prefix-map "u" 'hg-revert-file) |
139 (define-key hg-prefix-map "u" 'hg-revert-file) |
120 (define-key hg-prefix-map "~" 'hg-version-other-window) |
140 (define-key hg-prefix-map "~" 'hg-version-other-window) |
121 |
141 |
122 (defvar hg-mode-map (make-sparse-keymap)) |
142 (defvar hg-mode-map (make-sparse-keymap)) |
123 (define-key hg-mode-map "\C-xv" 'hg-prefix-map) |
143 (define-key hg-mode-map "\C-xv" 'hg-prefix-map) |
124 |
144 |
|
145 (add-minor-mode 'hg-mode 'hg-mode hg-mode-map) |
|
146 |
125 |
147 |
126 ;;; Global keymap. |
148 ;;; Global keymap. |
127 |
149 |
128 (global-set-key "\C-xvi" 'hg-add-file) |
150 (global-set-key "\C-xvi" 'hg-add) |
129 |
151 |
130 (defvar hg-global-map (make-sparse-keymap)) |
152 (defvar hg-global-map (make-sparse-keymap)) |
131 (fset 'hg-global-map hg-global-map) |
153 (fset 'hg-global-map hg-global-map) |
132 (global-set-key hg-global-prefix 'hg-global-map) |
154 (global-set-key hg-global-prefix 'hg-global-map) |
133 (define-key hg-global-map "," 'hg-incoming) |
155 (define-key hg-global-map "," 'hg-incoming) |
138 (define-key hg-global-map "?" 'hg-help-overview) |
160 (define-key hg-global-map "?" 'hg-help-overview) |
139 (define-key hg-global-map "A" 'hg-addremove) |
161 (define-key hg-global-map "A" 'hg-addremove) |
140 (define-key hg-global-map "U" 'hg-revert) |
162 (define-key hg-global-map "U" 'hg-revert) |
141 (define-key hg-global-map "a" 'hg-add) |
163 (define-key hg-global-map "a" 'hg-add) |
142 (define-key hg-global-map "c" 'hg-commit) |
164 (define-key hg-global-map "c" 'hg-commit) |
|
165 (define-key hg-global-map "f" 'hg-forget) |
143 (define-key hg-global-map "h" 'hg-help-overview) |
166 (define-key hg-global-map "h" 'hg-help-overview) |
144 (define-key hg-global-map "i" 'hg-init) |
167 (define-key hg-global-map "i" 'hg-init) |
145 (define-key hg-global-map "l" 'hg-log) |
168 (define-key hg-global-map "l" 'hg-log) |
146 (define-key hg-global-map "r" 'hg-root) |
169 (define-key hg-global-map "r" 'hg-root) |
147 (define-key hg-global-map "s" 'hg-status) |
170 (define-key hg-global-map "s" 'hg-status) |
246 (defun hg-abbrev-file-name (file) |
269 (defun hg-abbrev-file-name (file) |
247 (if hg-running-xemacs |
270 (if hg-running-xemacs |
248 (abbreviate-file-name file t) |
271 (abbreviate-file-name file t) |
249 (abbreviate-file-name file))) |
272 (abbreviate-file-name file))) |
250 |
273 |
|
274 (defun hg-read-file-name (&optional prompt default) |
|
275 "Read a file or directory name, or a pattern, to use with a command." |
|
276 (let ((path (or default (buffer-file-name)))) |
|
277 (if (or (not path) current-prefix-arg) |
|
278 (expand-file-name |
|
279 (read-file-name (format "File, directory or pattern%s: " |
|
280 (or prompt "")) |
|
281 (and path (file-name-directory path)) |
|
282 nil nil |
|
283 (and path (file-name-nondirectory path)) |
|
284 'hg-file-history)) |
|
285 path))) |
|
286 |
|
287 (defun hg-read-rev (&optional prompt default) |
|
288 "Read a revision or tag, offering completions." |
|
289 (let ((rev (or default "tip"))) |
|
290 (if (or (not rev) current-prefix-arg) |
|
291 (let ((revs (split-string (hg-chomp |
|
292 (hg-run0 "-q" "log" "-r" |
|
293 (format "-%d" |
|
294 hg-rev-completion-limit) |
|
295 "-r" "tip")) |
|
296 "[\n:]"))) |
|
297 (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n")) |
|
298 (setq revs (cons (car (split-string line "\\s-")) revs))) |
|
299 (completing-read (format "Revision%s (%s): " |
|
300 (or prompt "") |
|
301 (or default "tip")) |
|
302 (map 'list 'cons revs revs) |
|
303 nil |
|
304 nil |
|
305 nil |
|
306 'hg-rev-history |
|
307 (or default "tip"))) |
|
308 rev))) |
251 |
309 |
252 ;;; View mode bits. |
310 ;;; View mode bits. |
253 |
311 |
254 (defun hg-exit-view-mode (buf) |
312 (defun hg-exit-view-mode (buf) |
255 "Exit from hg-view-mode. |
313 "Exit from hg-view-mode. |
270 (setq truncate-lines t) |
328 (setq truncate-lines t) |
271 (when file-name |
329 (when file-name |
272 (set (make-local-variable 'hg-view-file-name) |
330 (set (make-local-variable 'hg-view-file-name) |
273 (hg-abbrev-file-name file-name)))) |
331 (hg-abbrev-file-name file-name)))) |
274 |
332 |
|
333 (defun hg-file-status (file) |
|
334 "Return status of FILE, or nil if FILE does not exist or is unmanaged." |
|
335 (let* ((s (hg-run "status" file)) |
|
336 (exit (car s)) |
|
337 (output (cdr s))) |
|
338 (if (= exit 0) |
|
339 (let ((state (assoc (substring output 0 (min (length output) 2)) |
|
340 '(("M " . modified) |
|
341 ("A " . added) |
|
342 ("R " . removed))))) |
|
343 (if state |
|
344 (cdr state) |
|
345 'normal))))) |
|
346 |
|
347 (defun hg-tip () |
|
348 (split-string (hg-chomp (hg-run0 "-q" "tip")) ":")) |
|
349 |
275 (defmacro hg-view-output (args &rest body) |
350 (defmacro hg-view-output (args &rest body) |
276 "Execute BODY in a clean buffer, then switch that buffer to view-mode. |
351 "Execute BODY in a clean buffer, then quickly display that buffer. |
|
352 If the buffer contains one line, its contents are displayed in the |
|
353 minibuffer. Otherwise, the buffer is displayed in view-mode. |
277 ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is |
354 ARGS is of the form (BUFFER-NAME &optional FILE), where BUFFER-NAME is |
278 the name of the buffer to create, and FILE is the name of the file |
355 the name of the buffer to create, and FILE is the name of the file |
279 being viewed." |
356 being viewed." |
280 (let ((prev-buf (gensym "prev-buf-")) |
357 (let ((prev-buf (gensym "prev-buf-")) |
281 (v-b-name (car args)) |
358 (v-b-name (car args)) |
282 (v-m-rest (cdr args))) |
359 (v-m-rest (cdr args))) |
283 `(let ((view-buf-name ,v-b-name) |
360 `(let ((view-buf-name ,v-b-name) |
284 (,prev-buf (current-buffer))) |
361 (,prev-buf (current-buffer))) |
285 (get-buffer-create view-buf-name) |
362 (get-buffer-create view-buf-name) |
286 (kill-buffer view-buf-name) |
363 (kill-buffer view-buf-name) |
287 (pop-to-buffer view-buf-name) |
364 (get-buffer-create view-buf-name) |
|
365 (set-buffer view-buf-name) |
288 (save-excursion |
366 (save-excursion |
289 ,@body) |
367 ,@body) |
290 (hg-view-mode ,prev-buf ,@v-m-rest)))) |
368 (case (count-lines (point-min) (point-max)) |
|
369 ((0) |
|
370 (kill-buffer view-buf-name) |
|
371 (message "(No output)")) |
|
372 ((1) |
|
373 (let ((msg (hg-chomp (buffer-substring (point-min) (point-max))))) |
|
374 (kill-buffer view-buf-name) |
|
375 (message "%s" msg))) |
|
376 (t |
|
377 (pop-to-buffer view-buf-name) |
|
378 (hg-view-mode ,prev-buf ,@v-m-rest)))))) |
291 |
379 |
292 (put 'hg-view-output 'lisp-indent-function 1) |
380 (put 'hg-view-output 'lisp-indent-function 1) |
|
381 |
|
382 ;;; Hooks. |
|
383 |
|
384 (defun hg-mode-line () |
|
385 (when (hg-root) |
|
386 (let ((status (hg-file-status buffer-file-name))) |
|
387 (setq hg-status status |
|
388 hg-mode (and status (concat " Hg:" |
|
389 (car (hg-tip)) |
|
390 (cdr (assq status |
|
391 '((normal . "") |
|
392 (removed . "r") |
|
393 (added . "a") |
|
394 (modified . "m"))))))) |
|
395 status))) |
|
396 |
|
397 (defun hg-find-file-hook () |
|
398 (when (hg-mode-line) |
|
399 (run-hooks 'hg-mode-hook))) |
|
400 |
|
401 (add-hook 'find-file-hooks 'hg-find-file-hook) |
|
402 |
|
403 (defun hg-after-save-hook () |
|
404 (let ((old-status hg-status)) |
|
405 (hg-mode-line) |
|
406 (if (and (not old-status) hg-status) |
|
407 (run-hooks 'hg-mode-hook)))) |
|
408 |
|
409 (add-hook 'after-save-hook 'hg-after-save-hook) |
293 |
410 |
294 |
411 |
295 ;;; User interface functions. |
412 ;;; User interface functions. |
296 |
413 |
297 (defun hg-help-overview () |
414 (defun hg-help-overview () |
315 |
432 |
316 SCM Task G/L Key Binding Command Name |
433 SCM Task G/L Key Binding Command Name |
317 -------- --- ----------- ------------ |
434 -------- --- ----------- ------------ |
318 Help overview (what you are reading) G C-c h h hg-help-overview |
435 Help overview (what you are reading) G C-c h h hg-help-overview |
319 |
436 |
320 Tell Mercurial to manage a file G C-x v i hg-add-file |
437 Tell Mercurial to manage a file G C-c h a hg-add |
321 Commit changes to current file only L C-x C-q vc-toggle-read-only |
438 Commit changes to current file only L C-x v n hg-commit |
322 Undo changes to file since commit L C-x v u hg-revert-file |
439 Undo changes to file since commit L C-x v u hg-revert-file |
323 |
440 |
324 Diff file vs last checkin L C-x v = hg-diff-file |
441 Diff file vs last checkin L C-x v = hg-diff |
325 |
442 |
326 View file change history L C-x v l hg-log-file |
443 View file change history L C-x v l hg-log |
327 View annotated file L C-x v a hg-annotate |
444 View annotated file L C-x v a hg-annotate |
328 |
445 |
329 Diff repo vs last checkin G C-c h = hg-diff |
446 Diff repo vs last checkin G C-c h = hg-diff |
330 View status of files in repo G C-c h s hg-status |
447 View status of files in repo G C-c h s hg-status |
331 Commit all changes G C-c h c hg-commit |
448 Commit all changes G C-c h c hg-commit |
340 Push changes G C-c h > hg-push" |
457 Push changes G C-c h > hg-push" |
341 (interactive) |
458 (interactive) |
342 (hg-view-output ("Mercurial Help Overview") |
459 (hg-view-output ("Mercurial Help Overview") |
343 (insert (documentation 'hg-help-overview)))) |
460 (insert (documentation 'hg-help-overview)))) |
344 |
461 |
345 (defun hg-add () |
462 (defun hg-add (path) |
346 (interactive) |
463 (interactive (list (hg-read-file-name " to add"))) |
347 (error "not implemented")) |
464 (let ((buf (current-buffer)) |
348 |
465 (update (equal buffer-file-name path))) |
349 (defun hg-add-file () |
466 (hg-view-output (hg-output-buffer-name) |
350 (interactive) |
467 (apply 'call-process (hg-binary) nil t nil (list "add" path))) |
351 (error "not implemented")) |
468 (when update |
|
469 (with-current-buffer buf |
|
470 (hg-mode-line))))) |
352 |
471 |
353 (defun hg-addremove () |
472 (defun hg-addremove () |
354 (interactive) |
473 (interactive) |
355 (error "not implemented")) |
474 (error "not implemented")) |
356 |
475 |
360 |
479 |
361 (defun hg-commit () |
480 (defun hg-commit () |
362 (interactive) |
481 (interactive) |
363 (error "not implemented")) |
482 (error "not implemented")) |
364 |
483 |
365 (defun hg-diff () |
484 (defun hg-diff (path &optional rev1 rev2) |
366 (interactive) |
485 (interactive (list (hg-read-file-name " to diff") |
367 (error "not implemented")) |
486 (hg-read-rev " to start with") |
368 |
487 (let ((rev2 (hg-read-rev " to end with" 'working-dir))) |
369 (defun hg-diff-file () |
488 (and (not (eq rev2 'working-dir)) rev2)))) |
370 (interactive) |
489 (let ((a-path (hg-abbrev-file-name path))) |
371 (error "not implemented")) |
490 (hg-view-output ((if (equal rev1 rev2) |
372 |
491 (format "Mercurial: Rev %s of %s" rev1 a-path) |
|
492 (format "Mercurial: Rev %s to %s of %s" |
|
493 rev1 (or rev2 "Current") a-path))) |
|
494 (if rev2 |
|
495 (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path) |
|
496 (call-process (hg-binary) nil t nil "diff" "-r" rev1 path)) |
|
497 (diff-mode) |
|
498 (font-lock-fontify-buffer)))) |
|
499 |
|
500 (defun hg-forget (path) |
|
501 (interactive (list (hg-read-file-name " to forget"))) |
|
502 (let ((buf (current-buffer)) |
|
503 (update (equal buffer-file-name path))) |
|
504 (hg-view-output (hg-output-buffer-name) |
|
505 (apply 'call-process (hg-binary) nil t nil (list "forget" path))) |
|
506 (when update |
|
507 (with-current-buffer buf |
|
508 (hg-mode-line))))) |
|
509 |
373 (defun hg-incoming () |
510 (defun hg-incoming () |
374 (interactive) |
511 (interactive) |
375 (error "not implemented")) |
512 (error "not implemented")) |
376 |
513 |
377 (defun hg-init () |
514 (defun hg-init () |
378 (interactive) |
515 (interactive) |
379 (error "not implemented")) |
516 (error "not implemented")) |
380 |
517 |
381 (defun hg-log-file () |
518 (defun hg-log (path &optional rev1 rev2) |
382 (interactive) |
519 (interactive (list (hg-read-file-name " to log") |
383 (error "not implemented")) |
520 (hg-read-rev " to start with" "-1") |
384 |
521 (hg-read-rev " to end with" (format "-%d" hg-log-limit)))) |
385 (defun hg-log () |
522 (message "log %s %s" rev1 rev2) |
386 (interactive) |
523 (sit-for 1) |
387 (error "not implemented")) |
524 (let ((a-path (hg-abbrev-file-name path))) |
|
525 (hg-view-output ((if (equal rev1 rev2) |
|
526 (format "Mercurial: Rev %s of %s" rev1 a-path) |
|
527 (format "Mercurial: Rev %s to %s of %s" |
|
528 rev1 (or rev2 "Current") a-path))) |
|
529 (call-process (hg-binary) nil t nil "log" "-r" rev1 "-r" rev2 path) |
|
530 (diff-mode) |
|
531 (font-lock-fontify-buffer)))) |
388 |
532 |
389 (defun hg-outgoing () |
533 (defun hg-outgoing () |
390 (interactive) |
534 (interactive) |
391 (error "not implemented")) |
535 (error "not implemented")) |
392 |
536 |
405 (defun hg-revert-file () |
549 (defun hg-revert-file () |
406 (interactive) |
550 (interactive) |
407 (error "not implemented")) |
551 (error "not implemented")) |
408 |
552 |
409 (defun hg-root (&optional path) |
553 (defun hg-root (&optional path) |
410 (interactive) |
554 (interactive (list (hg-read-file-name))) |
411 (unless path |
|
412 (setq path (if (and (interactive-p) current-prefix-arg) |
|
413 (expand-file-name (read-file-name "Path name: ")) |
|
414 (or (buffer-file-name) "(none)")))) |
|
415 (let ((root (do ((prev nil dir) |
555 (let ((root (do ((prev nil dir) |
416 (dir (file-name-directory path) |
556 (dir (file-name-directory (or path (buffer-file-name))) |
417 (file-name-directory (directory-file-name dir)))) |
557 (file-name-directory (directory-file-name dir)))) |
418 ((equal prev dir)) |
558 ((equal prev dir)) |
419 (when (file-directory-p (concat dir ".hg")) |
559 (when (file-directory-p (concat dir ".hg")) |
420 (return dir))))) |
560 (return dir))))) |
421 (when (interactive-p) |
561 (when (interactive-p) |