Mercurial > hg > mercurial-crew-with-dirclash

comparison contrib/mercurial.el @ 1004:ad6fcceaf59b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Emacs: improved GNU Emacs support.
author bos@serpentine.internal.keyresearch.com
date Mon, 22 Aug 2005 15:29:55 -0700
parents 6dfc9cc71f42
children d06420c90d8b
comparison
equal deleted inserted replaced
1003:6dfc9cc71f42 1004:ad6fcceaf59b
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 Bryan O'Sullivan 3 ;; Copyright (C) 2005 Bryan O'Sullivan
4 4
5 ;; Author: Bryan O'Sullivan <bos@serpentine.com> 5 ;; Author: Bryan O'Sullivan <bos@serpentine.com>
6
7 ;; $Id$
8 6
9 ;; mercurial.el is free software; you can redistribute it and/or 7 ;; mercurial.el is free software; you can redistribute it and/or
10 ;; 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
11 ;; License as published by the Free Software Foundation. 9 ;; License as published by the Free Software Foundation.
12 10
20 ;; (`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.,
21 ;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 ;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
22 20
23 ;;; Commentary: 21 ;;; Commentary:
24 22
25 ;; This mode builds upon Emacs's VC mode to provide flexible 23 ;; mercurial.el builds upon Emacs's VC mode to provide flexible
26 ;; integration with the Mercurial distributed SCM tool. 24 ;; integration with the Mercurial distributed SCM tool.
27 25
28 ;; 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
29 ;; 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
30 ;; usage overview. 28 ;; usage overview.
32 ;; Much of the inspiration for mercurial.el comes from Rajesh 30 ;; Much of the inspiration for mercurial.el comes from Rajesh
33 ;; Vaidheeswarran's excellent p4.el, which does an admirably thorough 31 ;; Vaidheeswarran's excellent p4.el, which does an admirably thorough
34 ;; job for the commercial Perforce SCM product. In fact, substantial 32 ;; job for the commercial Perforce SCM product. In fact, substantial
35 ;; chunks of code are adapted from p4.el. 33 ;; chunks of code are adapted from p4.el.
36 34
37 ;; This code has been developed under XEmacs 21.5, and may will not 35 ;; This code has been developed under XEmacs 21.5, and may not work as
38 ;; work as well under GNU Emacs (albeit tested under 21.2). Patches 36 ;; well under GNU Emacs (albeit tested under 21.4). Patches to
39 ;; to enhance the portability of this code, fix bugs, and add features 37 ;; enhance the portability of this code, fix bugs, and add features
40 ;; are most welcome. You can clone a Mercurial repository for this 38 ;; are most welcome. You can clone a Mercurial repository for this
41 ;; package from http://www.serpentine.com/hg/hg-emacs 39 ;; package from http://www.serpentine.com/hg/hg-emacs
42 40
43 ;; Please send problem reports and suggestions to bos@serpentine.com. 41 ;; Please send problem reports and suggestions to bos@serpentine.com.
44 42
312 (find-file-other-window file)) 310 (find-file-other-window file))
313 (rev 311 (rev
314 (hg-diff hg-view-file-name rev rev prev-buf)) 312 (hg-diff hg-view-file-name rev rev prev-buf))
315 ((message "I don't know how to do that yet"))))) 313 ((message "I don't know how to do that yet")))))
316 314
315 (defsubst hg-event-point (event)
316 "Return the character position of the mouse event EVENT."
317 (if hg-running-xemacs
318 (event-point event)
319 (posn-point (event-start event))))
320
321 (defsubst hg-event-window (event)
322 "Return the window over which mouse event EVENT occurred."
323 (if hg-running-xemacs
324 (event-window event)
325 (posn-window (event-start event))))
326
317 (defun hg-buffer-mouse-clicked (event) 327 (defun hg-buffer-mouse-clicked (event)
318 "Translate the mouse clicks in a HG log buffer to character events. 328 "Translate the mouse clicks in a HG log buffer to character events.
319 These are then handed off to `hg-buffer-commands'. 329 These are then handed off to `hg-buffer-commands'.
320 330
321 Handle frickin' frackin' gratuitous event-related incompatibilities." 331 Handle frickin' frackin' gratuitous event-related incompatibilities."
322 (interactive "e") 332 (interactive "e")
323 (if hg-running-xemacs 333 (select-window (hg-event-window event))
324 (progn 334 (hg-buffer-commands (hg-event-point event)))
325 (select-window (event-window event))
326 (hg-buffer-commands (event-point event)))
327 (select-window (posn-window (event-end event)))
328 (hg-buffer-commands (posn-point (event-start event)))))
329 335
330 (unless (fboundp 'view-minor-mode) 336 (unless (fboundp 'view-minor-mode)
331 (defun view-minor-mode (prev-buffer exit-func) 337 (defun view-minor-mode (prev-buffer exit-func)
332 (view-mode))) 338 (view-mode)))
333 339
617 "Toggle whether or not the file at POS will be committed." 623 "Toggle whether or not the file at POS will be committed."
618 (interactive "d") 624 (interactive "d")
619 (save-excursion 625 (save-excursion
620 (goto-char pos) 626 (goto-char pos)
621 (let ((face (get-text-property pos 'face)) 627 (let ((face (get-text-property pos 'face))
628 (inhibit-read-only t)
622 bol) 629 bol)
623 (beginning-of-line) 630 (beginning-of-line)
624 (setq bol (+ (point) 4)) 631 (setq bol (+ (point) 4))
625 (end-of-line) 632 (end-of-line)
626 (if (eq face 'bold) 633 (if (eq face 'bold)
633 (buffer-substring bol (point))))))) 640 (buffer-substring bol (point)))))))
634 641
635 (defun hg-commit-mouse-clicked (event) 642 (defun hg-commit-mouse-clicked (event)
636 "Toggle whether or not the file at POS will be committed." 643 "Toggle whether or not the file at POS will be committed."
637 (interactive "@e") 644 (interactive "@e")
638 (hg-commit-toggle-file (event-point event))) 645 (hg-commit-toggle-file (hg-event-point event)))
639 646
640 (defun hg-commit-kill () 647 (defun hg-commit-kill ()
641 "Kill the commit currently being prepared." 648 "Kill the commit currently being prepared."
642 (interactive) 649 (interactive)
643 (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this commit? ")) 650 (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this commit? "))
738 (set (make-local-variable 'hg-root) root) 745 (set (make-local-variable 'hg-root) root)
739 (setq hg-prev-buffer prev-buffer) 746 (setq hg-prev-buffer prev-buffer)
740 (insert "\n") 747 (insert "\n")
741 (let ((bol (point))) 748 (let ((bol (point)))
742 (insert hg-commit-message-end) 749 (insert hg-commit-message-end)
743 (add-text-properties bol (point) '(read-only t face bold-italic))) 750 (add-text-properties bol (point) '(face bold-italic)))
744 (let ((file-area (point))) 751 (let ((file-area (point)))
745 (insert modified-files) 752 (insert modified-files)
746 (goto-char file-area) 753 (goto-char file-area)
747 (while (< (point) (point-max)) 754 (while (< (point) (point-max))
748 (let ((bol (point))) 755 (let ((bol (point)))
752 (add-text-properties (+ bol 4) (point) 759 (add-text-properties (+ bol 4) (point)
753 '(face bold mouse-face highlight))) 760 '(face bold mouse-face highlight)))
754 (forward-line 1)) 761 (forward-line 1))
755 (goto-char file-area) 762 (goto-char file-area)
756 (add-text-properties (point) (point-max) 763 (add-text-properties (point) (point-max)
757 `(read-only t keymap ,hg-commit-mode-file-map)) 764 `(keymap ,hg-commit-mode-file-map))
758 (goto-char (point-min)) 765 (goto-char (point-min))
759 (insert hg-commit-message-start) 766 (insert hg-commit-message-start)
760 (add-text-properties (point-min) (point) 767 (add-text-properties (point-min) (point) '(face bold-italic))
761 '(read-only t face bold-italic))
762 (insert "\n\n") 768 (insert "\n\n")
763 (forward-line -1) 769 (forward-line -1)
770 (save-excursion
771 (goto-char (point-max))
772 (search-backward hg-commit-message-end)
773 (add-text-properties (match-beginning 0) (point-max)
774 '(read-only t))
775 (goto-char (point-min))
776 (search-forward hg-commit-message-start)
777 (add-text-properties (match-beginning 0) (match-end 0)
778 '(read-only t)))
764 (hg-commit-mode)))))) 779 (hg-commit-mode))))))
765 780
766 (defun hg-diff (path &optional rev1 rev2) 781 (defun hg-diff (path &optional rev1 rev2)
767 "Show the differences between REV1 and REV2 of PATH. 782 "Show the differences between REV1 and REV2 of PATH.
768 When called interactively, the default behaviour is to treat REV1 as 783 When called interactively, the default behaviour is to treat REV1 as