diff -r 25e7ea0f2cff -r b5f0ccad8917 contrib/mercurial.el --- 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))