Mercurial > hg

changeset 1029:b5f0ccad8917

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Emacs: implement hg-incoming, hg-outgoing and hg-push.
author Bryan O'Sullivan <bos@serpentine.com>
date Tue, 23 Aug 2005 21:53:13 -0700
parents 25e7ea0f2cff
children 28e2f13ca7c4
files contrib/mercurial.el
diffstat 1 files changed, 132 insertions(+), 12 deletions(-) [+]
line wrap: on
line diff
--- a/contrib/mercurial.el	Tue Aug 23 21:30:12 2005 -0700
+++ b/contrib/mercurial.el	Tue Aug 23 21:53:13 2005 -0700
@@ -92,6 +92,11 @@
   :type 'sexp
   :group 'mercurial)
 
+(defcustom hg-log-mode-hook nil
+  "Hook run after a buffer is filled with log information."
+  :type 'sexp
+  :group 'mercurial)
+
 (defcustom hg-global-prefix "\C-ch"
   "The global prefix for Mercurial keymap bindings."
   :type 'sexp
@@ -125,6 +130,20 @@
   :type 'boolean
   :group 'mercurial)
 
+(defcustom hg-incoming-repository "default"
+  "The repository from which changes are pulled from by default.
+This should be a symbolic repository name, since it is used for all
+repository-related commands."
+  :type 'string
+  :group 'mercurial)
+
+(defcustom hg-outgoing-repository "default-push"
+  "The repository to which changes are pushed to by default.
+This should be a symbolic repository name, since it is used for all
+repository-related commands."
+  :type 'string
+  :group 'mercurial)
+
 
 ;;; Other variables.
 
@@ -152,6 +171,7 @@
   "The name to use for Mercurial output buffers.")
 
 (defvar hg-file-history nil)
+(defvar hg-repo-history nil)
 (defvar hg-rev-history nil)
 
 
@@ -234,6 +254,7 @@
 (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-kill)
+(define-key hg-commit-mode-map "\C-xv=" 'hg-diff-repo)
 
 (defvar hg-commit-mode-file-map (make-sparse-keymap))
 (define-key hg-commit-mode-file-map
@@ -370,13 +391,84 @@
 			   'hg-file-history))
 	path))))
 
+(defun hg-read-config ()
+  "Return an alist of (key . value) pairs of Mercurial config data.
+Each key is of the form (section . name)."
+  (let (items)
+    (dolist (line (split-string (hg-chomp (hg-run0 "debugconfig")) "\n") items)
+      (string-match "^\\([^=]*\\)=\\(.*\\)" line)
+      (let* ((left (substring line (match-beginning 1) (match-end 1)))
+	     (right (substring line (match-beginning 2) (match-end 2)))
+	     (key (split-string left "\\."))
+	     (value (hg-replace-in-string right "\\\\n" "\n" t)))
+	(setq items (cons (cons (cons (car key) (cadr key)) value) items))))))
+  
+(defun hg-config-section (section config)
+  "Return an alist of (name . value) pairs for SECTION of CONFIG."
+  (let (items)
+    (dolist (item config items)
+      (when (equal (caar item) section)
+	(setq items (cons (cons (cdar item) (cdr item)) items))))))
+
+(defun hg-string-starts-with (sub str)
+  "Indicate whether string STR starts with the substring or character SUB."
+  (if (not (stringp sub))
+      (and (> (length str) 0) (equal (elt str 0) sub))
+    (let ((sub-len (length sub)))
+      (and (<= sub-len (length str))
+	   (string= sub (substring str 0 sub-len))))))
+
+(defun hg-complete-repo (string predicate all)
+  "Attempt to complete a repository name.
+We complete on either symbolic names from Mercurial's config or real
+directory names from the file system.  We do not penalise URLs."
+  (or (if all
+	  (all-completions string hg-repo-completion-table predicate)
+	(try-completion string hg-repo-completion-table predicate))
+      (let* ((str (expand-file-name string))
+	     (dir (file-name-directory str))
+	     (file (file-name-nondirectory str)))
+	(if all
+	    (let (completions)
+	      (dolist (name (delete "./" (file-name-all-completions file dir))
+			    completions)
+		(let ((path (concat dir name)))
+		  (when (file-directory-p path)
+		    (setq completions (cons name completions))))))
+	  (let ((comp (file-name-completion file dir)))
+	    (if comp
+		(hg-abbrev-file-name (concat dir comp))))))))
+
+(defun hg-read-repo-name (&optional prompt initial-contents default)
+  "Read the location of a repository."
+  (save-excursion
+    (while hg-prev-buffer
+      (set-buffer hg-prev-buffer))
+    (let (hg-repo-completion-table)
+      (if current-prefix-arg
+	  (progn
+	    (dolist (path (hg-config-section "paths" (hg-read-config)))
+	      (setq hg-repo-completion-table
+		    (cons (cons (car path) t) hg-repo-completion-table))
+	      (unless (hg-string-starts-with directory-sep-char (cdr path))
+		(setq hg-repo-completion-table
+		      (cons (cons (cdr path) t) hg-repo-completion-table))))
+	    (completing-read (format "Repository%s: " (or prompt ""))
+			     'hg-complete-repo
+			     nil
+			     nil
+			     initial-contents
+			     'hg-repo-history
+			     default))
+	default))))
+
 (defun hg-read-rev (&optional prompt default)
   "Read a revision or tag, offering completions."
   (save-excursion
     (while hg-prev-buffer
       (set-buffer hg-prev-buffer))
     (let ((rev (or default "tip")))
-      (if (or (not rev) current-prefix-arg)
+      (if current-prefix-arg
 	  (let ((revs (split-string (hg-chomp
 				     (hg-run0 "-q" "log" "-r"
 					      (format "-%d"
@@ -837,14 +929,28 @@
       (with-current-buffer buf
 	(hg-mode-line)))))
   
-(defun hg-incoming ()
-  (interactive)
-  (error "not implemented"))
+(defun hg-incoming (&optional repo)
+  "Display changesets present in REPO that are not present locally."
+  (interactive (list (hg-read-repo-name " where changes would come from")))
+  (hg-view-output ((format "Mercurial: Incoming from %s to %s"
+			   (hg-abbrev-file-name (hg-root))
+			   (hg-abbrev-file-name
+			    (or repo hg-incoming-repository))))
+    (call-process (hg-binary) nil t nil "incoming"
+		  (or repo hg-incoming-repository))
+    (hg-log-mode)))
 
 (defun hg-init ()
   (interactive)
   (error "not implemented"))
 
+(defun hg-log-mode ()
+  "Mode for viewing a Mercurial change log."
+  (goto-char (point-min))
+  (when (looking-at "^searching for changes")
+    (kill-entire-line))
+  (run-hooks 'hg-log-mode-hook))
+
 (defun hg-log (path &optional rev1 rev2)
   "Display the revision history of PATH, between REV1 and REV2.
 REV1 defaults to hg-log-limit changes from the tip revision, while
@@ -863,7 +969,7 @@
       (if (> (length path) (length (hg-root path)))
 	  (call-process (hg-binary) nil t nil "log" "-r" r1 "-r" r2 path)
 	(call-process (hg-binary) nil t nil "log" "-r" r1 "-r" r2))
-      (font-lock-fontify-buffer))))
+      (hg-log-mode))))
 
 (defun hg-log-repo (path &optional rev1 rev2)
   "Display the revision history of the repository containing PATH.
@@ -875,17 +981,31 @@
 		     (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"))
+(defun hg-outgoing (&optional repo)
+  "Display changesets present locally that are not present in REPO."
+  (interactive (list (hg-read-repo-name " where changes would go to" nil
+					hg-outgoing-repository)))
+  (hg-view-output ((format "Mercurial: Outgoing from %s to %s"
+			   (hg-abbrev-file-name (hg-root))
+			   (hg-abbrev-file-name
+			    (or repo hg-outgoing-repository))))
+    (call-process (hg-binary) nil t nil "outgoing"
+		  (or repo hg-outgoing-repository))
+    (hg-log-mode)))
 
 (defun hg-pull ()
   (interactive)
   (error "not implemented"))
 
-(defun hg-push ()
-  (interactive)
-  (error "not implemented"))
+(defun hg-push (&optional repo)
+  "Push changes to repository REPO."
+  (interactive (list (hg-read-repo-name " to push to")))
+  (hg-view-output ((format "Mercurial: Push from %s to %s"
+			   (hg-abbrev-file-name (hg-root))
+			   (hg-abbrev-file-name
+			    (or repo hg-outgoing-repository))))
+    (call-process (hg-binary) nil t nil "push"
+		  (or repo hg-outgoing-repository))))
 
 (defun hg-revert-buffer-internal ()
   (let ((ctx (hg-buffer-context)))
@@ -935,7 +1055,7 @@
 	  (if root
 	      (message "The root of this repository is `%s'." root)
 	    (message "The path `%s' is not in a Mercurial repository."
-		     (abbreviate-file-name path t))))
+		     (hg-abbrev-file-name path))))
 	root)
     hg-root))