contrib/mercurial.el
changeset 1003 6dfc9cc71f42
parent 1001 ab3939ccbf10
child 1004 ad6fcceaf59b
equal deleted inserted replaced
1002:254ab35709e6 1003:6dfc9cc71f42
    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 'mercurial)
    84   :group 'mercurial)
    85 
    85 
       
    86 (defcustom hg-commit-mode-hook nil
       
    87   "Hook run when a buffer is created to prepare a commit."
       
    88   :type 'sexp
       
    89   :group 'mercurial)
       
    90 
       
    91 (defcustom hg-pre-commit-hook nil
       
    92   "Hook run before a commit is performed.
       
    93 If you want to prevent the commit from proceeding, raise an error."
       
    94   :type 'sexp
       
    95   :group 'mercurial)
       
    96 
    86 (defcustom hg-global-prefix "\C-ch"
    97 (defcustom hg-global-prefix "\C-ch"
    87   "The global prefix for Mercurial keymap bindings."
    98   "The global prefix for Mercurial keymap bindings."
    88   :type 'sexp
    99   :type 'sexp
    89   :group 'mercurial)
   100   :group 'mercurial)
    90 
   101 
   129 
   140 
   130 (defvar hg-status nil)
   141 (defvar hg-status nil)
   131 (make-variable-buffer-local 'hg-status)
   142 (make-variable-buffer-local 'hg-status)
   132 (put 'hg-status 'permanent-local t)
   143 (put 'hg-status 'permanent-local t)
   133 
   144 
       
   145 (defvar hg-prev-buffer nil)
       
   146 (make-variable-buffer-local 'hg-prev-buffer)
       
   147 (put 'hg-prev-buffer 'permanent-local t)
       
   148 
       
   149 (defvar hg-root nil)
       
   150 (make-variable-buffer-local 'hg-root)
       
   151 (put 'hg-root 'permanent-local t)
       
   152 
   134 (defvar hg-output-buffer-name "*Hg*"
   153 (defvar hg-output-buffer-name "*Hg*"
   135   "The name to use for Mercurial output buffers.")
   154   "The name to use for Mercurial output buffers.")
   136 
   155 
   137 (defvar hg-file-history nil)
   156 (defvar hg-file-history nil)
   138 (defvar hg-rev-history nil)
   157 (defvar hg-rev-history nil)
   146 (defconst hg-commit-message-end
   165 (defconst hg-commit-message-end
   147   "--- Files in bold will be committed.  Click to toggle selection. ---\n")
   166   "--- Files in bold will be committed.  Click to toggle selection. ---\n")
   148 
   167 
   149 
   168 
   150 ;;; hg-mode keymap.
   169 ;;; hg-mode keymap.
       
   170 
       
   171 (defvar hg-mode-map (make-sparse-keymap))
       
   172 (define-key hg-mode-map "\C-xv" 'hg-prefix-map)
   151 
   173 
   152 (defvar hg-prefix-map
   174 (defvar hg-prefix-map
   153   (let ((map (copy-keymap vc-prefix-map)))
   175   (let ((map (copy-keymap vc-prefix-map)))
   154     (if (functionp 'set-keymap-name)
   176     (if (functionp 'set-keymap-name)
   155       (set-keymap-name map 'hg-prefix-map)); XEmacs
   177       (set-keymap-name map 'hg-prefix-map)); XEmacs
   158 (fset 'hg-prefix-map hg-prefix-map)
   180 (fset 'hg-prefix-map hg-prefix-map)
   159 (define-key hg-prefix-map "=" 'hg-diff)
   181 (define-key hg-prefix-map "=" 'hg-diff)
   160 (define-key hg-prefix-map "c" 'hg-undo)
   182 (define-key hg-prefix-map "c" 'hg-undo)
   161 (define-key hg-prefix-map "g" 'hg-annotate)
   183 (define-key hg-prefix-map "g" 'hg-annotate)
   162 (define-key hg-prefix-map "l" 'hg-log)
   184 (define-key hg-prefix-map "l" 'hg-log)
   163 (define-key hg-prefix-map "n" 'hg-commit-file)
   185 (define-key hg-prefix-map "n" 'hg-commit-start)
   164 ;; (define-key hg-prefix-map "r" 'hg-update)
   186 ;; (define-key hg-prefix-map "r" 'hg-update)
   165 (define-key hg-prefix-map "u" 'hg-revert-buffer)
   187 (define-key hg-prefix-map "u" 'hg-revert-buffer)
   166 (define-key hg-prefix-map "~" 'hg-version-other-window)
   188 (define-key hg-prefix-map "~" 'hg-version-other-window)
   167 
       
   168 (defvar hg-mode-map (make-sparse-keymap))
       
   169 (define-key hg-mode-map "\C-xv" 'hg-prefix-map)
       
   170 
   189 
   171 (add-minor-mode 'hg-mode 'hg-mode hg-mode-map)
   190 (add-minor-mode 'hg-mode 'hg-mode hg-mode-map)
   172 
   191 
   173 
   192 
   174 ;;; Global keymap.
   193 ;;; Global keymap.
   179 (fset 'hg-global-map hg-global-map)
   198 (fset 'hg-global-map hg-global-map)
   180 (global-set-key hg-global-prefix 'hg-global-map)
   199 (global-set-key hg-global-prefix 'hg-global-map)
   181 (define-key hg-global-map "," 'hg-incoming)
   200 (define-key hg-global-map "," 'hg-incoming)
   182 (define-key hg-global-map "." 'hg-outgoing)
   201 (define-key hg-global-map "." 'hg-outgoing)
   183 (define-key hg-global-map "<" 'hg-pull)
   202 (define-key hg-global-map "<" 'hg-pull)
   184 (define-key hg-global-map "=" 'hg-diff)
   203 (define-key hg-global-map "=" 'hg-diff-repo)
   185 (define-key hg-global-map ">" 'hg-push)
   204 (define-key hg-global-map ">" 'hg-push)
   186 (define-key hg-global-map "?" 'hg-help-overview)
   205 (define-key hg-global-map "?" 'hg-help-overview)
   187 (define-key hg-global-map "A" 'hg-addremove)
   206 (define-key hg-global-map "A" 'hg-addremove)
   188 (define-key hg-global-map "U" 'hg-revert)
   207 (define-key hg-global-map "U" 'hg-revert)
   189 (define-key hg-global-map "a" 'hg-add)
   208 (define-key hg-global-map "a" 'hg-add)
   190 (define-key hg-global-map "c" 'hg-commit)
   209 (define-key hg-global-map "c" 'hg-commit-start)
   191 (define-key hg-global-map "f" 'hg-forget)
   210 (define-key hg-global-map "f" 'hg-forget)
   192 (define-key hg-global-map "h" 'hg-help-overview)
   211 (define-key hg-global-map "h" 'hg-help-overview)
   193 (define-key hg-global-map "i" 'hg-init)
   212 (define-key hg-global-map "i" 'hg-init)
   194 (define-key hg-global-map "l" 'hg-log)
   213 (define-key hg-global-map "l" 'hg-log-repo)
   195 (define-key hg-global-map "r" 'hg-root)
   214 (define-key hg-global-map "r" 'hg-root)
   196 (define-key hg-global-map "s" 'hg-status)
   215 (define-key hg-global-map "s" 'hg-status)
   197 (define-key hg-global-map "u" 'hg-update)
   216 (define-key hg-global-map "u" 'hg-update)
   198 
   217 
   199 
   218 
   214 
   233 
   215 ;;; Commit mode keymaps.
   234 ;;; Commit mode keymaps.
   216 
   235 
   217 (defvar hg-commit-mode-map (make-sparse-keymap))
   236 (defvar hg-commit-mode-map (make-sparse-keymap))
   218 (define-key hg-commit-mode-map "\C-c\C-c" 'hg-commit-finish)
   237 (define-key hg-commit-mode-map "\C-c\C-c" 'hg-commit-finish)
   219 (define-key hg-commit-mode-map "\C-c\C-k" 'hg-commit-abort)
   238 (define-key hg-commit-mode-map "\C-c\C-k" 'hg-commit-kill)
   220 
   239 
   221 (defvar hg-commit-mode-file-map (make-sparse-keymap))
   240 (defvar hg-commit-mode-file-map (make-sparse-keymap))
   222 (define-key hg-commit-mode-file-map
   241 (define-key hg-commit-mode-file-map
   223   (if hg-running-xemacs [button2] [mouse-2])
   242   (if hg-running-xemacs [button2] [mouse-2])
   224   'hg-commit-mouse-clicked)
   243   'hg-commit-mouse-clicked)
   318       (abbreviate-file-name file t)
   337       (abbreviate-file-name file t)
   319     (abbreviate-file-name file)))
   338     (abbreviate-file-name file)))
   320 
   339 
   321 (defun hg-read-file-name (&optional prompt default)
   340 (defun hg-read-file-name (&optional prompt default)
   322   "Read a file or directory name, or a pattern, to use with a command."
   341   "Read a file or directory name, or a pattern, to use with a command."
   323   (let ((path (or default (buffer-file-name))))
   342   (save-excursion
   324     (if (or (not path) current-prefix-arg)
   343     (while hg-prev-buffer
   325 	(expand-file-name
   344       (set-buffer hg-prev-buffer))
   326 	 (read-file-name (format "File, directory or pattern%s: "
   345     (let ((path (or default (buffer-file-name))))
   327 				 (or prompt ""))
   346       (if (or (not path) current-prefix-arg)
   328 			 (and path (file-name-directory path))
   347 	  (expand-file-name
   329 			 nil nil
   348 	   (read-file-name (format "File, directory or pattern%s: "
   330 			 (and path (file-name-nondirectory path))
   349 				   (or prompt ""))
   331 			 'hg-file-history))
   350 			   (and path (file-name-directory path))
   332       path)))
   351 			   nil nil
       
   352 			   (and path (file-name-nondirectory path))
       
   353 			   'hg-file-history))
       
   354 	path))))
   333 
   355 
   334 (defun hg-read-rev (&optional prompt default)
   356 (defun hg-read-rev (&optional prompt default)
   335   "Read a revision or tag, offering completions."
   357   "Read a revision or tag, offering completions."
   336   (let ((rev (or default "tip")))
   358   (save-excursion
   337     (if (or (not rev) current-prefix-arg)
   359     (while hg-prev-buffer
   338 	(let ((revs (split-string (hg-chomp
   360       (set-buffer hg-prev-buffer))
   339 				   (hg-run0 "-q" "log" "-r"
   361     (let ((rev (or default "tip")))
   340 					    (format "-%d"
   362       (if (or (not rev) current-prefix-arg)
   341 						    hg-rev-completion-limit)
   363 	  (let ((revs (split-string (hg-chomp
   342 					    "-r" "tip"))
   364 				     (hg-run0 "-q" "log" "-r"
   343 				  "[\n:]")))
   365 					      (format "-%d"
   344 	  (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n"))
   366 						      hg-rev-completion-limit)
   345 	    (setq revs (cons (car (split-string line "\\s-")) revs)))
   367 					      "-r" "tip"))
   346 	  (completing-read (format "Revision%s (%s): "
   368 				    "[\n:]")))
   347 				   (or prompt "")
   369 	    (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n"))
   348 				   (or default "tip"))
   370 	      (setq revs (cons (car (split-string line "\\s-")) revs)))
   349 			   (map 'list 'cons revs revs)
   371 	    (completing-read (format "Revision%s (%s): "
   350 			   nil
   372 				     (or prompt "")
   351 			   nil
   373 				     (or default "tip"))
   352 			   nil
   374 			     (map 'list 'cons revs revs)
   353 			   'hg-rev-history
   375 			     nil
   354 			   (or default "tip")))
   376 			     nil
   355       rev)))
   377 			     nil
       
   378 			     'hg-rev-history
       
   379 			     (or default "tip")))
       
   380 	rev))))
   356 
   381 
   357 (defmacro hg-do-across-repo (path &rest body)
   382 (defmacro hg-do-across-repo (path &rest body)
   358   (let ((root-name (gensym "root-"))
   383   (let ((root-name (gensym "root-"))
   359 	(buf-name (gensym "buf-")))
   384 	(buf-name (gensym "buf-")))
   360     `(let ((,root-name (hg-root ,path)))
   385     `(let ((,root-name (hg-root ,path)))
   434 	  (let ((msg (hg-chomp (buffer-substring (point-min) (point-max)))))
   459 	  (let ((msg (hg-chomp (buffer-substring (point-min) (point-max)))))
   435 	    (kill-buffer view-buf-name)
   460 	    (kill-buffer view-buf-name)
   436 	    (message "%s" msg)))
   461 	    (message "%s" msg)))
   437 	 (t
   462 	 (t
   438 	  (pop-to-buffer view-buf-name)
   463 	  (pop-to-buffer view-buf-name)
       
   464 	  (setq hg-prev-buffer ,prev-buf)
   439 	  (hg-view-mode ,prev-buf ,@v-m-rest))))))
   465 	  (hg-view-mode ,prev-buf ,@v-m-rest))))))
   440 
   466 
   441 (put 'hg-view-output 'lisp-indent-function 1)
   467 (put 'hg-view-output 'lisp-indent-function 1)
   442 
   468 
   443 ;;; Context save and restore across revert.
   469 ;;; Context save and restore across revert.
   497 						     (removed . "r")
   523 						     (removed . "r")
   498 						     (added . "a")
   524 						     (added . "a")
   499 						     (modified . "m")))))))
   525 						     (modified . "m")))))))
   500       status)))
   526       status)))
   501 
   527 
   502 (defun hg-find-file-hook ()
   528 (defun hg-mode ()
   503   (when (hg-mode-line)
   529   "Minor mode for Mercurial distributed SCM integration.
   504     (run-hooks 'hg-mode-hook)))
   530 
   505 
   531 The Mercurial mode user interface is based on that of VC mode, so if
   506 (add-hook 'find-file-hooks 'hg-find-file-hook)
   532 you're already familiar with VC, the same keybindings and functions
   507 
   533 will generally work.
   508 (defun hg-after-save-hook ()
   534 
   509   (let ((old-status hg-status))
   535 Below is a list of many common SCM tasks.  In the list, `G/L'
   510     (hg-mode-line)
   536 indicates whether a key binding is global (G) to a repository or local
   511     (if (and (not old-status) hg-status)
   537 (L) to a file.  Many commands take a prefix argument.
   512 	(run-hooks 'hg-mode-hook))))
       
   513 
       
   514 (add-hook 'after-save-hook 'hg-after-save-hook)
       
   515 
       
   516 
       
   517 ;;; User interface functions.
       
   518 
       
   519 (defun hg-help-overview ()
       
   520   "This is an overview of the Mercurial SCM mode for Emacs.
       
   521 
       
   522 You can find the source code, license (GPL v2), and credits for this
       
   523 code by typing `M-x find-library mercurial RET'.
       
   524 
       
   525 The Mercurial mode user interface is based on that of the older VC
       
   526 mode, so if you're already familiar with VC, the same keybindings and
       
   527 functions will generally work.
       
   528 
       
   529 Below is a list of common SCM tasks, with the key bindings needed to
       
   530 perform them, and the command names.  This list is not exhaustive.
       
   531 
       
   532 In the list below, `G/L' indicates whether a key binding is global (G)
       
   533 or local (L).  Global keybindings work on any file inside a Mercurial
       
   534 repository.  Local keybindings only apply to files under the control
       
   535 of Mercurial.  Many commands take a prefix argument.
       
   536 
       
   537 
   538 
   538 SCM Task                              G/L  Key Binding  Command Name
   539 SCM Task                              G/L  Key Binding  Command Name
   539 --------                              ---  -----------  ------------
   540 --------                              ---  -----------  ------------
   540 Help overview (what you are reading)  G    C-c h h      hg-help-overview
   541 Help overview (what you are reading)  G    C-c h h      hg-help-overview
   541 
   542 
   546 Diff file vs last checkin             L    C-x v =      hg-diff
   547 Diff file vs last checkin             L    C-x v =      hg-diff
   547 
   548 
   548 View file change history              L    C-x v l      hg-log
   549 View file change history              L    C-x v l      hg-log
   549 View annotated file                   L    C-x v a      hg-annotate
   550 View annotated file                   L    C-x v a      hg-annotate
   550 
   551 
   551 Diff repo vs last checkin             G    C-c h =      hg-diff
   552 Diff repo vs last checkin             G    C-c h =      hg-diff-repo
   552 View status of files in repo          G    C-c h s      hg-status
   553 View status of files in repo          G    C-c h s      hg-status
   553 Commit all changes                    G    C-c h c      hg-commit
   554 Commit all changes                    G    C-c h c      hg-commit
   554 
   555 
   555 Undo all changes since last commit    G    C-c h U      hg-revert
   556 Undo all changes since last commit    G    C-c h U      hg-revert
   556 View repo change history              G    C-c h l      hg-log
   557 View repo change history              G    C-c h l      hg-log
   558 See changes that can be pulled        G    C-c h ,      hg-incoming
   559 See changes that can be pulled        G    C-c h ,      hg-incoming
   559 Pull changes                          G    C-c h <      hg-pull
   560 Pull changes                          G    C-c h <      hg-pull
   560 Update working directory after pull   G    C-c h u      hg-update
   561 Update working directory after pull   G    C-c h u      hg-update
   561 See changes that can be pushed        G    C-c h .      hg-outgoing
   562 See changes that can be pushed        G    C-c h .      hg-outgoing
   562 Push changes                          G    C-c h >      hg-push"
   563 Push changes                          G    C-c h >      hg-push"
       
   564   (run-hooks 'hg-mode-hook))
       
   565 
       
   566 (defun hg-find-file-hook ()
       
   567   (when (hg-mode-line)
       
   568     (hg-mode)))
       
   569 
       
   570 (add-hook 'find-file-hooks 'hg-find-file-hook)
       
   571 
       
   572 (defun hg-after-save-hook ()
       
   573   (let ((old-status hg-status))
       
   574     (hg-mode-line)
       
   575     (if (and (not old-status) hg-status)
       
   576 	(hg-mode))))
       
   577 
       
   578 (add-hook 'after-save-hook 'hg-after-save-hook)
       
   579 
       
   580 
       
   581 ;;; User interface functions.
       
   582 
       
   583 (defun hg-help-overview ()
       
   584   "This is an overview of the Mercurial SCM mode for Emacs.
       
   585 
       
   586 You can find the source code, license (GPL v2), and credits for this
       
   587 code by typing `M-x find-library mercurial RET'."
   563   (interactive)
   588   (interactive)
   564   (hg-view-output ("Mercurial Help Overview")
   589   (hg-view-output ("Mercurial Help Overview")
   565     (insert (documentation 'hg-help-overview))))
   590     (insert (documentation 'hg-help-overview))
       
   591     (let ((pos (point)))
       
   592       (insert (documentation 'hg-mode))
       
   593       (goto-char pos)
       
   594       (kill-line))))
   566 
   595 
   567 (defun hg-add (path)
   596 (defun hg-add (path)
   568   "Add PATH to the Mercurial repository on the next commit.
   597   "Add PATH to the Mercurial repository on the next commit.
   569 With a prefix argument, prompt for the path to add."
   598 With a prefix argument, prompt for the path to add."
   570   (interactive (list (hg-read-file-name " to add")))
   599   (interactive (list (hg-read-file-name " to add")))
   606 (defun hg-commit-mouse-clicked (event)
   635 (defun hg-commit-mouse-clicked (event)
   607   "Toggle whether or not the file at POS will be committed."
   636   "Toggle whether or not the file at POS will be committed."
   608   (interactive "@e")
   637   (interactive "@e")
   609   (hg-commit-toggle-file (event-point event)))
   638   (hg-commit-toggle-file (event-point event)))
   610 
   639 
   611 (defun hg-commit-abort ()
   640 (defun hg-commit-kill ()
   612   (interactive)
   641   "Kill the commit currently being prepared."
   613   (let ((buf hg-prev-buffer))
   642   (interactive)
   614     (kill-buffer nil)
   643   (when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this commit? "))
   615     (switch-to-buffer buf)))
       
   616 
       
   617 (defun hg-commit-finish ()
       
   618   (interactive)
       
   619   (goto-char (point-min))
       
   620   (search-forward hg-commit-message-start)
       
   621   (let ((root hg-root)
       
   622 	message files)
       
   623     (let ((start (point)))
       
   624       (goto-char (point-max))
       
   625       (search-backward hg-commit-message-end)
       
   626       (setq message (hg-strip (buffer-substring start (point)))))
       
   627     (when (and (= (length message) 0)
       
   628 	       (not hg-commit-allow-empty-message))
       
   629       (error "Cannot proceed - commit message is empty"))
       
   630     (forward-line 1)
       
   631     (beginning-of-line)
       
   632     (while (< (point) (point-max))
       
   633       (let ((pos (+ (point) 4)))
       
   634 	(end-of-line)
       
   635 	(when (eq (get-text-property pos 'face) 'bold)
       
   636 	  (end-of-line)
       
   637 	  (setq files (cons (buffer-substring pos (point)) files))))
       
   638       (forward-line 1))
       
   639     (when (and (= (length files) 0)
       
   640 	       (not hg-commit-allow-empty-file-list))
       
   641       (error "Cannot proceed - no files to commit"))
       
   642     (setq message (concat message "\n"))
       
   643     (apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files)
       
   644     (let ((buf hg-prev-buffer))
   644     (let ((buf hg-prev-buffer))
   645       (kill-buffer nil)
   645       (kill-buffer nil)
   646       (switch-to-buffer buf))
   646       (switch-to-buffer buf))))
   647     (hg-do-across-repo root
   647 
   648       (hg-mode-line))))
   648 (defun hg-commit-finish ()
       
   649   "Finish preparing a commit, and perform the actual commit.
       
   650 The hook hg-pre-commit-hook is run before anything else is done.  If
       
   651 the commit message is empty and hg-commit-allow-empty-message is nil,
       
   652 an error is raised.  If the list of files to commit is empty and
       
   653 hg-commit-allow-empty-file-list is nil, an error is raised."
       
   654   (interactive)
       
   655   (let ((root hg-root))
       
   656     (save-excursion
       
   657       (run-hooks 'hg-pre-commit-hook)
       
   658       (goto-char (point-min))
       
   659       (search-forward hg-commit-message-start)
       
   660       (let (message files)
       
   661 	(let ((start (point)))
       
   662 	  (goto-char (point-max))
       
   663 	  (search-backward hg-commit-message-end)
       
   664 	  (setq message (hg-strip (buffer-substring start (point)))))
       
   665 	(when (and (= (length message) 0)
       
   666 		   (not hg-commit-allow-empty-message))
       
   667 	  (error "Cannot proceed - commit message is empty"))
       
   668 	(forward-line 1)
       
   669 	(beginning-of-line)
       
   670 	(while (< (point) (point-max))
       
   671 	  (let ((pos (+ (point) 4)))
       
   672 	    (end-of-line)
       
   673 	    (when (eq (get-text-property pos 'face) 'bold)
       
   674 	      (end-of-line)
       
   675 	      (setq files (cons (buffer-substring pos (point)) files))))
       
   676 	  (forward-line 1))
       
   677 	(when (and (= (length files) 0)
       
   678 		   (not hg-commit-allow-empty-file-list))
       
   679 	  (error "Cannot proceed - no files to commit"))
       
   680 	(setq message (concat message "\n"))
       
   681 	(apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files))
       
   682       (let ((buf hg-prev-buffer))
       
   683 	(kill-buffer nil)
       
   684 	(switch-to-buffer buf))
       
   685       (hg-do-across-repo root
       
   686 	(hg-mode-line)))))
   649 
   687 
   650 (defun hg-commit-mode ()
   688 (defun hg-commit-mode ()
   651   "Mode for describing a commit of changes to a Mercurial repository.
   689   "Mode for describing a commit of changes to a Mercurial repository.
   652 This involves two actions: describing the changes with a commit
   690 This involves two actions: describing the changes with a commit
   653 message, and choosing the files to commit.
   691 message, and choosing the files to commit.
   660 
   698 
   661 To toggle whether a file will be committed, move the cursor over a
   699 To toggle whether a file will be committed, move the cursor over a
   662 particular file and hit space or return.  Alternatively, middle click
   700 particular file and hit space or return.  Alternatively, middle click
   663 on the file.
   701 on the file.
   664 
   702 
   665 When you are finished with preparations, type \\[hg-commit-finish] to
   703 Key bindings
   666 proceed with the commit."
   704 ------------
       
   705 \\[hg-commit-finish]		proceed with commit
       
   706 \\[hg-commit-kill]		kill commit
       
   707 
       
   708 \\[hg-diff-repo]		view diff of pending changes"
   667   (interactive)
   709   (interactive)
   668   (use-local-map hg-commit-mode-map)
   710   (use-local-map hg-commit-mode-map)
   669   (set-syntax-table text-mode-syntax-table)
   711   (set-syntax-table text-mode-syntax-table)
   670   (setq local-abbrev-table text-mode-abbrev-table
   712   (setq local-abbrev-table text-mode-abbrev-table
   671 	major-mode 'hg-commit-mode
   713 	major-mode 'hg-commit-mode
   672 	mode-name "Hg-Commit")
   714 	mode-name "Hg-Commit")
   673   (set-buffer-modified-p nil)
   715   (set-buffer-modified-p nil)
   674   (setq buffer-undo-list nil)
   716   (setq buffer-undo-list nil)
   675   (run-hooks 'text-mode-hook 'hg-commit-mode-hook))
   717   (run-hooks 'text-mode-hook 'hg-commit-mode-hook))
   676 
   718 
   677 (defun hg-commit ()
   719 (defun hg-commit-start ()
   678   (interactive)
   720   "Prepare a commit of changes to the repository containing the current file."
       
   721   (interactive)
       
   722   (while hg-prev-buffer
       
   723     (set-buffer hg-prev-buffer))
   679   (let ((root (hg-root))
   724   (let ((root (hg-root))
   680 	(prev-buffer (current-buffer)))
   725 	(prev-buffer (current-buffer))
       
   726 	modified-files)
   681     (unless root
   727     (unless root
   682       (error "Cannot commit outside a repository!"))
   728       (error "Cannot commit outside a repository!"))
   683     (hg-do-across-repo
   729     (hg-do-across-repo
   684 	(vc-buffer-sync))
   730 	(vc-buffer-sync))
       
   731     (setq modified-files (hg-chomp (hg-run0 "--cwd" root "status" "-arm")))
       
   732     (when (and (= (length modified-files) 0)
       
   733 	       (not hg-commit-allow-empty-file-list))
       
   734       (error "No pending changes to commit"))
   685     (let* ((buf-name (format "*Mercurial: Commit %s*" root)))
   735     (let* ((buf-name (format "*Mercurial: Commit %s*" root)))
   686       (pop-to-buffer (get-buffer-create buf-name))
   736       (pop-to-buffer (get-buffer-create buf-name))
   687       (when (= (point-min) (point-max))
   737       (when (= (point-min) (point-max))
   688 	(set (make-local-variable 'hg-root) root)
   738 	(set (make-local-variable 'hg-root) root)
   689 	(set (make-local-variable 'hg-prev-buffer) prev-buffer)
   739 	(setq hg-prev-buffer prev-buffer)
   690 	(insert "\n")
   740 	(insert "\n")
   691 	(let ((bol (point)))
   741 	(let ((bol (point)))
   692 	  (insert hg-commit-message-end)
   742 	  (insert hg-commit-message-end)
   693 	  (add-text-properties bol (point) '(read-only t face bold-italic)))
   743 	  (add-text-properties bol (point) '(read-only t face bold-italic)))
   694 	(let ((file-area (point)))
   744 	(let ((file-area (point)))
   695 	  (insert (hg-chomp (hg-run0 "--cwd" root "status" "-arm")))
   745 	  (insert modified-files)
   696 	  (goto-char file-area)
   746 	  (goto-char file-area)
   697 	  (while (< (point) (point-max))
   747 	  (while (< (point) (point-max))
   698 	    (let ((bol (point)))
   748 	    (let ((bol (point)))
   699 	      (forward-char 1)
   749 	      (forward-char 1)
   700 	      (insert "  ")
   750 	      (insert "  ")
   737       (diff-mode)
   787       (diff-mode)
   738       (setq diff (not (= (point-min) (point-max))))
   788       (setq diff (not (= (point-min) (point-max))))
   739       (font-lock-fontify-buffer))
   789       (font-lock-fontify-buffer))
   740     diff))
   790     diff))
   741 
   791 
       
   792 (defun hg-diff-repo ()
       
   793   "Show the differences between the working copy and the tip revision."
       
   794   (interactive)
       
   795   (hg-diff (hg-root)))
       
   796 
   742 (defun hg-forget (path)
   797 (defun hg-forget (path)
   743   "Lose track of PATH, which has been added, but not yet committed.
   798   "Lose track of PATH, which has been added, but not yet committed.
   744 This will prevent the file from being incorporated into the Mercurial
   799 This will prevent the file from being incorporated into the Mercurial
   745 repository on the next commit.
   800 repository on the next commit.
   746 With a prefix argument, prompt for the path to forget."
   801 With a prefix argument, prompt for the path to forget."
   762   (error "not implemented"))
   817   (error "not implemented"))
   763 
   818 
   764 (defun hg-log (path &optional rev1 rev2)
   819 (defun hg-log (path &optional rev1 rev2)
   765   "Display the revision history of PATH, between REV1 and REV2.
   820   "Display the revision history of PATH, between REV1 and REV2.
   766 REV1 defaults to the initial revision, while REV2 defaults to the tip.
   821 REV1 defaults to the initial revision, while REV2 defaults to the tip.
   767 With a prefix argument, prompt for each parameter."
   822 With a prefix argument, prompt for each parameter.
       
   823 Variable hg-log-limit controls the number of log entries displayed."
   768   (interactive (list (hg-read-file-name " to log")
   824   (interactive (list (hg-read-file-name " to log")
   769 		     (hg-read-rev " to start with" "-1")
   825 		     (hg-read-rev " to start with" "-1")
   770 		     (hg-read-rev " to end with" (format "-%d" hg-log-limit))))
   826 		     (hg-read-rev " to end with" (format "-%d" hg-log-limit))))
   771   (let ((a-path (hg-abbrev-file-name path)))
   827   (let ((a-path (hg-abbrev-file-name path)))
   772     (hg-view-output ((if (equal rev1 rev2)
   828     (hg-view-output ((if (equal rev1 rev2)
   773 			 (format "Mercurial: Rev %s of %s" rev1 a-path)
   829 			 (format "Mercurial: Rev %s of %s" rev1 a-path)
   774 		       (format "Mercurial: Rev %s to %s of %s"
   830 		       (format "Mercurial: Rev %s to %s of %s"
   775 			       rev1 (or rev2 "Current") a-path)))
   831 			       rev1 (or rev2 "Current") a-path)))
   776       (call-process (hg-binary) nil t nil "log" "-r" rev1 "-r" rev2 path)
   832       (if (> (length path) (length (hg-root path)))
       
   833 	  (call-process (hg-binary) nil t nil "log" "-r" rev1 "-r" rev2 path)
       
   834 	(call-process (hg-binary) nil t nil "log" "-r" rev1 "-r" rev2))
   777       (diff-mode)
   835       (diff-mode)
   778       (font-lock-fontify-buffer))))
   836       (font-lock-fontify-buffer))))
       
   837 
       
   838 (defun hg-log-repo (path &optional rev1 rev2)
       
   839   "Display the revision history of the repository containing PATH.
       
   840 History is displayed between REV1, which defaults to the tip, and
       
   841 REV2, which defaults to the initial revision.
       
   842 Variable hg-log-limit controls the number of log entries displayed."
       
   843   (interactive (list (hg-read-file-name " to log")
       
   844 		     (hg-read-rev " to start with" "tip")
       
   845 		     (hg-read-rev " to end with" (format "-%d" hg-log-limit))))
       
   846   (hg-log (hg-root path) rev1 rev2))
   779 
   847 
   780 (defun hg-outgoing ()
   848 (defun hg-outgoing ()
   781   (interactive)
   849   (interactive)
   782   (error "not implemented"))
   850   (error "not implemented"))
   783 
   851 
   824   "Return the root of the repository that contains the given path.
   892   "Return the root of the repository that contains the given path.
   825 If the path is outside a repository, return nil.
   893 If the path is outside a repository, return nil.
   826 When called interactively, the root is printed.  A prefix argument
   894 When called interactively, the root is printed.  A prefix argument
   827 prompts for a path to check."
   895 prompts for a path to check."
   828   (interactive (list (hg-read-file-name)))
   896   (interactive (list (hg-read-file-name)))
   829   (let ((root (do ((prev nil dir)
   897   (if (or path (not hg-root))
   830 		   (dir (file-name-directory (or path buffer-file-name ""))
   898       (let ((root (do ((prev nil dir)
   831 			(file-name-directory (directory-file-name dir))))
   899 		       (dir (file-name-directory (or path buffer-file-name ""))
   832 		  ((equal prev dir))
   900 			    (file-name-directory (directory-file-name dir))))
   833 		(when (file-directory-p (concat dir ".hg"))
   901 		      ((equal prev dir))
   834 		  (return dir)))))
   902 		    (when (file-directory-p (concat dir ".hg"))
   835     (when (interactive-p)
   903 		      (return dir)))))
   836       (if root
   904 	(when (interactive-p)
   837 	  (message "The root of this repository is `%s'." root)
   905 	  (if root
   838 	(message "The path `%s' is not in a Mercurial repository."
   906 	      (message "The root of this repository is `%s'." root)
   839 		 (abbreviate-file-name path t))))
   907 	    (message "The path `%s' is not in a Mercurial repository."
   840     root))
   908 		     (abbreviate-file-name path t))))
       
   909 	root)
       
   910     hg-root))
   841 
   911 
   842 (defun hg-status (path)
   912 (defun hg-status (path)
   843   "Print revision control status of a file or directory.
   913   "Print revision control status of a file or directory.
   844 With prefix argument, prompt for the path to give status for.
   914 With prefix argument, prompt for the path to give status for.
   845 Names are displayed relative to the repository root."
   915 Names are displayed relative to the repository root."