Mercurial > hg > mercurial-crew-with-dirclash

comparison contrib/mercurial.el @ 947:4cabedfab66e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
In-progress Emacs snapshot.
author Bryan O'Sullivan <bos@serpentine.com>
date Fri, 19 Aug 2005 06:41:29 -0800
parents f15901d053e1
children ffb0665028f0
comparison
equal deleted inserted replaced
946:6d21a3488df9 947:4cabedfab66e
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
62 (error nil)) 62 (error nil))
63 63
64 64
65 ;;; Variables accessible through the custom system. 65 ;;; Variables accessible through the custom system.
66 66
67 (defgroup hg nil 67 (defgroup mercurial nil
68 "Mercurial distributed SCM." 68 "Mercurial distributed SCM."
69 :group 'tools) 69 :group 'tools)
70 70
71 (defcustom hg-binary 71 (defcustom hg-binary
72 (dolist (path '("~/bin/hg" 72 (dolist (path '("~/bin/hg"
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)
423 (message "The root of this repository is `%s'." root) 563 (message "The root of this repository is `%s'." root)
424 (message "The path `%s' is not in a Mercurial repository." 564 (message "The path `%s' is not in a Mercurial repository."
425 (abbreviate-file-name path t)))) 565 (abbreviate-file-name path t))))
426 root)) 566 root))
427 567
428 (defun hg-status () 568 (defun hg-status (path)
429 (interactive) 569 (interactive (list (hg-read-file-name " for status" (hg-root))))
430 (error "not implemented")) 570 (let ((root (hg-root)))
571 (hg-view-output (hg-output-buffer-name)
572 (apply 'call-process (hg-binary) nil t nil
573 (list "-C" root "status" path)))))
431 574
432 (defun hg-undo () 575 (defun hg-undo ()
433 (interactive) 576 (interactive)
434 (error "not implemented")) 577 (error "not implemented"))
435 578