mercurial-crew-with-dirclash: contrib/mercurial.el comparison

comparison contrib/mercurial.el @ 1003:6dfc9cc71f42

Emacs support: numerous changes. Most SCM commands now work in derived buffers (e.g. diff viewing buffers) as well as buffers backed by files. diff and log now work properly on repositories and files. Commit support is more solid. Doc strings are better.

author	bos@serpentine.internal.keyresearch.com
date	Mon, 22 Aug 2005 15:08:20 -0700
parents	ab3939ccbf10
children	ad6fcceaf59b

comparison

equal deleted inserted replaced

-:254ab35709e6
+:6dfc9cc71f42
 (defcustom hg-mode-hook nil
 "Hook run when a buffer enters hg-mode."
 :type 'sexp
 :group 'mercurial)
+(defcustom hg-commit-mode-hook nil
+"Hook run when a buffer is created to prepare a commit."
+:type 'sexp
+:group 'mercurial)
+(defcustom hg-pre-commit-hook nil
+"Hook run before a commit is performed.
+If you want to prevent the commit from proceeding, raise an error."
+:type 'sexp
+:group 'mercurial)
 (defcustom hg-global-prefix "\C-ch"
 "The global prefix for Mercurial keymap bindings."
 :type 'sexp
 :group 'mercurial)
 (defvar hg-status nil)
 (make-variable-buffer-local 'hg-status)
 (put 'hg-status 'permanent-local t)
+(defvar hg-prev-buffer nil)
+(make-variable-buffer-local 'hg-prev-buffer)
+(put 'hg-prev-buffer 'permanent-local t)
+(defvar hg-root nil)
+(make-variable-buffer-local 'hg-root)
+(put 'hg-root 'permanent-local t)
 (defvar hg-output-buffer-name "*Hg*"
 "The name to use for Mercurial output buffers.")
 (defvar hg-file-history nil)
 (defvar hg-rev-history nil)
 (defconst hg-commit-message-end
 "--- Files in bold will be committed.  Click to toggle selection. ---\n")
 ;;; hg-mode keymap.
+(defvar hg-mode-map (make-sparse-keymap))
+(define-key hg-mode-map "\C-xv" 'hg-prefix-map)
 (defvar hg-prefix-map
 (let ((map (copy-keymap vc-prefix-map)))
 (if (functionp 'set-keymap-name)
 (set-keymap-name map 'hg-prefix-map)); XEmacs
 (fset 'hg-prefix-map hg-prefix-map)
 (define-key hg-prefix-map "=" 'hg-diff)
 (define-key hg-prefix-map "c" 'hg-undo)
 (define-key hg-prefix-map "g" 'hg-annotate)
 (define-key hg-prefix-map "l" 'hg-log)
-(define-key hg-prefix-map "n" 'hg-commit-file)
+(define-key hg-prefix-map "n" 'hg-commit-start)
 ;; (define-key hg-prefix-map "r" 'hg-update)
 (define-key hg-prefix-map "u" 'hg-revert-buffer)
 (define-key hg-prefix-map "~" 'hg-version-other-window)
-(defvar hg-mode-map (make-sparse-keymap))
-(define-key hg-mode-map "\C-xv" 'hg-prefix-map)
 (add-minor-mode 'hg-mode 'hg-mode hg-mode-map)
 ;;; Global keymap.
 (fset 'hg-global-map hg-global-map)
 (global-set-key hg-global-prefix 'hg-global-map)
 (define-key hg-global-map "," 'hg-incoming)
 (define-key hg-global-map "." 'hg-outgoing)
 (define-key hg-global-map "<" 'hg-pull)
-(define-key hg-global-map "=" 'hg-diff)
+(define-key hg-global-map "=" 'hg-diff-repo)
 (define-key hg-global-map ">" 'hg-push)
 (define-key hg-global-map "?" 'hg-help-overview)
 (define-key hg-global-map "A" 'hg-addremove)
 (define-key hg-global-map "U" 'hg-revert)
 (define-key hg-global-map "a" 'hg-add)
-(define-key hg-global-map "c" 'hg-commit)
+(define-key hg-global-map "c" 'hg-commit-start)
 (define-key hg-global-map "f" 'hg-forget)
 (define-key hg-global-map "h" 'hg-help-overview)
 (define-key hg-global-map "i" 'hg-init)
-(define-key hg-global-map "l" 'hg-log)
+(define-key hg-global-map "l" 'hg-log-repo)
 (define-key hg-global-map "r" 'hg-root)
 (define-key hg-global-map "s" 'hg-status)
 (define-key hg-global-map "u" 'hg-update)
 ;;; Commit mode keymaps.
 (defvar hg-commit-mode-map (make-sparse-keymap))
 (define-key hg-commit-mode-map "\C-c\C-c" 'hg-commit-finish)
-(define-key hg-commit-mode-map "\C-c\C-k" 'hg-commit-abort)
+(define-key hg-commit-mode-map "\C-c\C-k" 'hg-commit-kill)
 (defvar hg-commit-mode-file-map (make-sparse-keymap))
 (define-key hg-commit-mode-file-map
 (if hg-running-xemacs [button2] [mouse-2])
 'hg-commit-mouse-clicked)
 (abbreviate-file-name file t)
 (abbreviate-file-name file)))
 (defun hg-read-file-name (&optional prompt default)
 "Read a file or directory name, or a pattern, to use with a command."
-(let ((path (or default (buffer-file-name))))
+(save-excursion
-(if (or (not path) current-prefix-arg)
+(while hg-prev-buffer
-	(expand-file-name
+(set-buffer hg-prev-buffer))
-	 (read-file-name (format "File, directory or pattern%s: "
+(let ((path (or default (buffer-file-name))))
-				 (or prompt ""))
+(if (or (not path) current-prefix-arg)
-			 (and path (file-name-directory path))
+	  (expand-file-name
-			 nil nil
+	   (read-file-name (format "File, directory or pattern%s: "
-			 (and path (file-name-nondirectory path))
+				   (or prompt ""))
-			 'hg-file-history))
+			   (and path (file-name-directory path))
-path)))
+			   nil nil
+			   (and path (file-name-nondirectory path))
+			   'hg-file-history))
+	path))))
 (defun hg-read-rev (&optional prompt default)
 "Read a revision or tag, offering completions."
-(let ((rev (or default "tip")))
+(save-excursion
-(if (or (not rev) current-prefix-arg)
+(while hg-prev-buffer
-	(let ((revs (split-string (hg-chomp
+(set-buffer hg-prev-buffer))
-				   (hg-run0 "-q" "log" "-r"
+(let ((rev (or default "tip")))
-					    (format "-%d"
+(if (or (not rev) current-prefix-arg)
-						    hg-rev-completion-limit)
+	  (let ((revs (split-string (hg-chomp
-					    "-r" "tip"))
+				     (hg-run0 "-q" "log" "-r"
-				  "[\n:]")))
+					      (format "-%d"
-	  (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n"))
+						      hg-rev-completion-limit)
-	    (setq revs (cons (car (split-string line "\\s-")) revs)))
+					      "-r" "tip"))
-	  (completing-read (format "Revision%s (%s): "
+				    "[\n:]")))
-				   (or prompt "")
+	    (dolist (line (split-string (hg-chomp (hg-run0 "tags")) "\n"))
-				   (or default "tip"))
+	      (setq revs (cons (car (split-string line "\\s-")) revs)))
-			   (map 'list 'cons revs revs)
+	    (completing-read (format "Revision%s (%s): "
-			   nil
+				     (or prompt "")
-			   nil
+				     (or default "tip"))
-			   nil
+			     (map 'list 'cons revs revs)
-			   'hg-rev-history
+			     nil
-			   (or default "tip")))
+			     nil
-rev)))
+			     nil
+			     'hg-rev-history
+			     (or default "tip")))
+	rev))))
 (defmacro hg-do-across-repo (path &rest body)
 (let ((root-name (gensym "root-"))
 	(buf-name (gensym "buf-")))
 `(let ((,root-name (hg-root ,path)))
 	  (let ((msg (hg-chomp (buffer-substring (point-min) (point-max)))))
 	    (kill-buffer view-buf-name)
 	    (message "%s" msg)))
 	 (t
 	  (pop-to-buffer view-buf-name)
+	  (setq hg-prev-buffer ,prev-buf)
 	  (hg-view-mode ,prev-buf ,@v-m-rest))))))
 (put 'hg-view-output 'lisp-indent-function 1)
 ;;; Context save and restore across revert.
 						     (removed . "r")
 						     (added . "a")
 						     (modified . "m")))))))
 status)))
-(defun hg-find-file-hook ()
+(defun hg-mode ()
-(when (hg-mode-line)
+"Minor mode for Mercurial distributed SCM integration.
-(run-hooks 'hg-mode-hook)))
+The Mercurial mode user interface is based on that of VC mode, so if
-(add-hook 'find-file-hooks 'hg-find-file-hook)
+you're already familiar with VC, the same keybindings and functions
+will generally work.
-(defun hg-after-save-hook ()
-(let ((old-status hg-status))
+Below is a list of many common SCM tasks.  In the list, `G/L'
-(hg-mode-line)
+indicates whether a key binding is global (G) to a repository or local
-(if (and (not old-status) hg-status)
+(L) to a file.  Many commands take a prefix argument.
-	(run-hooks 'hg-mode-hook))))
-(add-hook 'after-save-hook 'hg-after-save-hook)
-;;; User interface functions.
-(defun hg-help-overview ()
-"This is an overview of the Mercurial SCM mode for Emacs.
-You can find the source code, license (GPL v2), and credits for this
-code by typing `M-x find-library mercurial RET'.
-The Mercurial mode user interface is based on that of the older VC
-mode, so if you're already familiar with VC, the same keybindings and
-functions will generally work.
-Below is a list of common SCM tasks, with the key bindings needed to
-perform them, and the command names.  This list is not exhaustive.
-In the list below, `G/L' indicates whether a key binding is global (G)
-or local (L).  Global keybindings work on any file inside a Mercurial
-repository.  Local keybindings only apply to files under the control
-of Mercurial.  Many commands take a prefix argument.
 SCM Task                              G/L  Key Binding  Command Name
 --------                              ---  -----------  ------------
 Help overview (what you are reading)  G    C-c h h      hg-help-overview
 Diff file vs last checkin             L    C-x v =      hg-diff
 View file change history              L    C-x v l      hg-log
 View annotated file                   L    C-x v a      hg-annotate
-Diff repo vs last checkin             G    C-c h =      hg-diff
+Diff repo vs last checkin             G    C-c h =      hg-diff-repo
 View status of files in repo          G    C-c h s      hg-status
 Commit all changes                    G    C-c h c      hg-commit
 Undo all changes since last commit    G    C-c h U      hg-revert
 View repo change history              G    C-c h l      hg-log
 See changes that can be pulled        G    C-c h ,      hg-incoming
 Pull changes                          G    C-c h <      hg-pull
 Update working directory after pull   G    C-c h u      hg-update
 See changes that can be pushed        G    C-c h .      hg-outgoing
 Push changes                          G    C-c h >      hg-push"
+(run-hooks 'hg-mode-hook))
+(defun hg-find-file-hook ()
+(when (hg-mode-line)
+(hg-mode)))
+(add-hook 'find-file-hooks 'hg-find-file-hook)
+(defun hg-after-save-hook ()
+(let ((old-status hg-status))
+(hg-mode-line)
+(if (and (not old-status) hg-status)
+	(hg-mode))))
+(add-hook 'after-save-hook 'hg-after-save-hook)
+;;; User interface functions.
+(defun hg-help-overview ()
+"This is an overview of the Mercurial SCM mode for Emacs.
+You can find the source code, license (GPL v2), and credits for this
+code by typing `M-x find-library mercurial RET'."
 (interactive)
 (hg-view-output ("Mercurial Help Overview")
-(insert (documentation 'hg-help-overview))))
+(insert (documentation 'hg-help-overview))
+(let ((pos (point)))
+(insert (documentation 'hg-mode))
+(goto-char pos)
+(kill-line))))
 (defun hg-add (path)
 "Add PATH to the Mercurial repository on the next commit.
 With a prefix argument, prompt for the path to add."
 (interactive (list (hg-read-file-name " to add")))
 (defun hg-commit-mouse-clicked (event)
 "Toggle whether or not the file at POS will be committed."
 (interactive "@e")
 (hg-commit-toggle-file (event-point event)))
-(defun hg-commit-abort ()
+(defun hg-commit-kill ()
-(interactive)
+"Kill the commit currently being prepared."
-(let ((buf hg-prev-buffer))
+(interactive)
-(kill-buffer nil)
+(when (or (not (buffer-modified-p)) (y-or-n-p "Really kill this commit? "))
-(switch-to-buffer buf)))
-(defun hg-commit-finish ()
-(interactive)
-(goto-char (point-min))
-(search-forward hg-commit-message-start)
-(let ((root hg-root)
-	message files)
-(let ((start (point)))
-(goto-char (point-max))
-(search-backward hg-commit-message-end)
-(setq message (hg-strip (buffer-substring start (point)))))
-(when (and (= (length message) 0)
-	       (not hg-commit-allow-empty-message))
-(error "Cannot proceed - commit message is empty"))
-(forward-line 1)
-(beginning-of-line)
-(while (< (point) (point-max))
-(let ((pos (+ (point) 4)))
-	(end-of-line)
-	(when (eq (get-text-property pos 'face) 'bold)
-	  (end-of-line)
-	  (setq files (cons (buffer-substring pos (point)) files))))
-(forward-line 1))
-(when (and (= (length files) 0)
-	       (not hg-commit-allow-empty-file-list))
-(error "Cannot proceed - no files to commit"))
-(setq message (concat message "\n"))
-(apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files)
 (let ((buf hg-prev-buffer))
 (kill-buffer nil)
-(switch-to-buffer buf))
+(switch-to-buffer buf))))
-(hg-do-across-repo root
-(hg-mode-line))))
+(defun hg-commit-finish ()
+"Finish preparing a commit, and perform the actual commit.
+The hook hg-pre-commit-hook is run before anything else is done.  If
+the commit message is empty and hg-commit-allow-empty-message is nil,
+an error is raised.  If the list of files to commit is empty and
+hg-commit-allow-empty-file-list is nil, an error is raised."
+(interactive)
+(let ((root hg-root))
+(save-excursion
+(run-hooks 'hg-pre-commit-hook)
+(goto-char (point-min))
+(search-forward hg-commit-message-start)
+(let (message files)
+	(let ((start (point)))
+	  (goto-char (point-max))
+	  (search-backward hg-commit-message-end)
+	  (setq message (hg-strip (buffer-substring start (point)))))
+	(when (and (= (length message) 0)
+		   (not hg-commit-allow-empty-message))
+	  (error "Cannot proceed - commit message is empty"))
+	(forward-line 1)
+	(beginning-of-line)
+	(while (< (point) (point-max))
+	  (let ((pos (+ (point) 4)))
+	    (end-of-line)
+	    (when (eq (get-text-property pos 'face) 'bold)
+	      (end-of-line)
+	      (setq files (cons (buffer-substring pos (point)) files))))
+	  (forward-line 1))
+	(when (and (= (length files) 0)
+		   (not hg-commit-allow-empty-file-list))
+	  (error "Cannot proceed - no files to commit"))
+	(setq message (concat message "\n"))
+	(apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files))
+(let ((buf hg-prev-buffer))
+	(kill-buffer nil)
+	(switch-to-buffer buf))
+(hg-do-across-repo root
+	(hg-mode-line)))))
 (defun hg-commit-mode ()
 "Mode for describing a commit of changes to a Mercurial repository.
 This involves two actions: describing the changes with a commit
 message, and choosing the files to commit.
 To toggle whether a file will be committed, move the cursor over a
 particular file and hit space or return.  Alternatively, middle click
 on the file.
-When you are finished with preparations, type \\[hg-commit-finish] to
+Key bindings
-proceed with the commit."
+------------
+\\[hg-commit-finish]		proceed with commit
+\\[hg-commit-kill]		kill commit
+\\[hg-diff-repo]		view diff of pending changes"
 (interactive)
 (use-local-map hg-commit-mode-map)
 (set-syntax-table text-mode-syntax-table)
 (setq local-abbrev-table text-mode-abbrev-table
 	major-mode 'hg-commit-mode
 	mode-name "Hg-Commit")
 (set-buffer-modified-p nil)
 (setq buffer-undo-list nil)
 (run-hooks 'text-mode-hook 'hg-commit-mode-hook))
-(defun hg-commit ()
+(defun hg-commit-start ()
-(interactive)
+"Prepare a commit of changes to the repository containing the current file."
+(interactive)
+(while hg-prev-buffer
+(set-buffer hg-prev-buffer))
 (let ((root (hg-root))
-	(prev-buffer (current-buffer)))
+	(prev-buffer (current-buffer))
+	modified-files)
 (unless root
 (error "Cannot commit outside a repository!"))
 (hg-do-across-repo
 	(vc-buffer-sync))
+(setq modified-files (hg-chomp (hg-run0 "--cwd" root "status" "-arm")))
+(when (and (= (length modified-files) 0)
+	       (not hg-commit-allow-empty-file-list))
+(error "No pending changes to commit"))
 (let* ((buf-name (format "*Mercurial: Commit %s*" root)))
 (pop-to-buffer (get-buffer-create buf-name))
 (when (= (point-min) (point-max))
 	(set (make-local-variable 'hg-root) root)
-	(set (make-local-variable 'hg-prev-buffer) prev-buffer)
+	(setq hg-prev-buffer prev-buffer)
 	(insert "\n")
 	(let ((bol (point)))
 	  (insert hg-commit-message-end)
 	  (add-text-properties bol (point) '(read-only t face bold-italic)))
 	(let ((file-area (point)))
-	  (insert (hg-chomp (hg-run0 "--cwd" root "status" "-arm")))
+	  (insert modified-files)
 	  (goto-char file-area)
 	  (while (< (point) (point-max))
 	    (let ((bol (point)))
 	      (forward-char 1)
 	      (insert "  ")
 (diff-mode)
 (setq diff (not (= (point-min) (point-max))))
 (font-lock-fontify-buffer))
 diff))
+(defun hg-diff-repo ()
+"Show the differences between the working copy and the tip revision."
+(interactive)
+(hg-diff (hg-root)))
 (defun hg-forget (path)
 "Lose track of PATH, which has been added, but not yet committed.
 This will prevent the file from being incorporated into the Mercurial
 repository on the next commit.
 With a prefix argument, prompt for the path to forget."
 (error "not implemented"))
 (defun hg-log (path &optional rev1 rev2)
 "Display the revision history of PATH, between REV1 and REV2.
 REV1 defaults to the initial revision, while REV2 defaults to the tip.
-With a prefix argument, prompt for each parameter."
+With a prefix argument, prompt for each parameter.
+Variable hg-log-limit controls the number of log entries displayed."
 (interactive (list (hg-read-file-name " to log")
 		     (hg-read-rev " to start with" "-1")
 		     (hg-read-rev " to end with" (format "-%d" hg-log-limit))))
 (let ((a-path (hg-abbrev-file-name path)))
 (hg-view-output ((if (equal rev1 rev2)
 			 (format "Mercurial: Rev %s of %s" rev1 a-path)
 		       (format "Mercurial: Rev %s to %s of %s"
 			       rev1 (or rev2 "Current") a-path)))
-(call-process (hg-binary) nil t nil "log" "-r" rev1 "-r" rev2 path)
+(if (> (length path) (length (hg-root path)))
+	  (call-process (hg-binary) nil t nil "log" "-r" rev1 "-r" rev2 path)
+	(call-process (hg-binary) nil t nil "log" "-r" rev1 "-r" rev2))
 (diff-mode)
 (font-lock-fontify-buffer))))
+(defun hg-log-repo (path &optional rev1 rev2)
+"Display the revision history of the repository containing PATH.
+History is displayed between REV1, which defaults to the tip, and
+REV2, which defaults to the initial revision.
+Variable hg-log-limit controls the number of log entries displayed."
+(interactive (list (hg-read-file-name " to log")
+		     (hg-read-rev " to start with" "tip")
+		     (hg-read-rev " to end with" (format "-%d" hg-log-limit))))
+(hg-log (hg-root path) rev1 rev2))
 (defun hg-outgoing ()
 (interactive)
 (error "not implemented"))
 "Return the root of the repository that contains the given path.
 If the path is outside a repository, return nil.
 When called interactively, the root is printed.  A prefix argument
 prompts for a path to check."
 (interactive (list (hg-read-file-name)))
-(let ((root (do ((prev nil dir)
+(if (or path (not hg-root))
-		   (dir (file-name-directory (or path buffer-file-name ""))
+(let ((root (do ((prev nil dir)
-			(file-name-directory (directory-file-name dir))))
+		       (dir (file-name-directory (or path buffer-file-name ""))
-		  ((equal prev dir))
+			    (file-name-directory (directory-file-name dir))))
-		(when (file-directory-p (concat dir ".hg"))
+		      ((equal prev dir))
-		  (return dir)))))
+		    (when (file-directory-p (concat dir ".hg"))
-(when (interactive-p)
+		      (return dir)))))
-(if root
+	(when (interactive-p)
-	  (message "The root of this repository is `%s'." root)
+	  (if root
-	(message "The path `%s' is not in a Mercurial repository."
+	      (message "The root of this repository is `%s'." root)
-		 (abbreviate-file-name path t))))
+	    (message "The path `%s' is not in a Mercurial repository."
-root))
+		     (abbreviate-file-name path t))))
+	root)
+hg-root))
 (defun hg-status (path)
 "Print revision control status of a file or directory.
 With prefix argument, prompt for the path to give status for.
 Names are displayed relative to the repository root."

Mercurial > hg > mercurial-crew-with-dirclash

comparison contrib/mercurial.el @ 1003:6dfc9cc71f42