# HG changeset patch
# User pavv@xxxxxxxxxxxxx
# Node ID 1868b5eb703e62db0f8ba30fa4cdbc3e7e039604
# Parent 7414a2e7128822da0bbed82973374a35c6012200
First pass at making more of a "real" VC mode.
The advantage of this is that hg commands no longer override VC ones,
so if you go to a file managed by another VC system e.g.
C-x v i still works.
diff -r 7414a2e71288 -r 1868b5eb703e contrib/mercurial.el
--- a/contrib/mercurial.el Wed Aug 31 06:22:11 2005
+++ b/contrib/mercurial.el Wed Aug 31 22:24:34 2005
@@ -1,4 +1,4 @@
-;;; mercurial.el --- Emacs support for the Mercurial distributed SCM
+;;; vc-hg.el --- Emacs support for the Mercurial distributed SCM
;; Copyright (C) 2005 Bryan O'Sullivan
@@ -92,11 +92,6 @@
: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
@@ -130,20 +125,6 @@
: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.
@@ -171,8 +152,9 @@
"The name to use for Mercurial output buffers.")
(defvar hg-file-history nil)
-(defvar hg-repo-history nil)
(defvar hg-rev-history nil)
+
+(add-to-list 'vc-handled-backends 'Hg)
;;; Random constants.
@@ -187,30 +169,10 @@
;;; 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
- map)
- "This keymap overrides some default vc-mode bindings.")
-(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-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)
-
(add-minor-mode 'hg-mode 'hg-mode hg-mode-map)
;;; Global keymap.
-
-(global-set-key "\C-xvi" 'hg-add)
(defvar hg-global-map (make-sparse-keymap))
(fset 'hg-global-map hg-global-map)
@@ -254,7 +216,6 @@
(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
@@ -262,7 +223,7 @@
'hg-commit-mouse-clicked)
(define-key hg-commit-mode-file-map " " 'hg-commit-toggle-file)
(define-key hg-commit-mode-file-map "\r" 'hg-commit-toggle-file)
-
+
;;; Convenience functions.
@@ -327,7 +288,7 @@
(vc-buffer-sync))
(hg-do-across-repo path
(vc-buffer-sync)))))
-
+
(defun hg-buffer-commands (pnt)
"Use the properties of a character to do something sensible."
(interactive "d")
@@ -391,84 +352,13 @@
'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 current-prefix-arg
+ (if (or (not rev) current-prefix-arg)
(let ((revs (split-string (hg-chomp
(hg-run0 "-q" "log" "-r"
(format "-%d"
@@ -523,7 +413,7 @@
(when file-name
(set (make-local-variable 'hg-view-file-name)
(hg-abbrev-file-name file-name))))
-
+
(defun hg-file-status (file)
"Return status of FILE, or nil if FILE does not exist or is unmanaged."
(let* ((s (hg-run "status" file))
@@ -592,7 +482,7 @@
(mark-context (let ((mark (mark-marker)))
(and mark (hg-position-context mark)))))
(list point-context mark-context)))
-
+
(defun hg-find-context (ctx)
"Attempt to find a context in the given buffer.
Always returns a valid, hopefully sane, position."
@@ -615,6 +505,57 @@
(set-mark (hg-find-context mark-context)))))
+;;; VC integration
+
+(defalias 'vc-hg-diff 'hg-diff)
+(defalias 'vc-hg-cancel-version 'hg-undo)
+(defalias 'vc-hg-annotate 'hg-annotate)
+(defalias 'vc-hg-retrieve-snapshot 'hg-update)
+(defalias 'vc-hg-version-other-window 'hg-version-other-window)
+
+(defmacro vc-hg-with-cd (file &rest body)
+ `(let (default-directory)
+ (cd (file-name-directory ,file))
+ ,@body))
+(put 'vc-hg-with-cd 'lisp-indent-function 1)
+
+(defun vc-hg-registered (file)
+ "Check if FILE is registered in Mercurial."
+ (hg-find-file-hook)
+ (eq 'Hg (vc-file-getprop file 'vc-backend)))
+
+(defun vc-hg-could-register (file)
+ "Return non-nil if FILE could be registered in Mercurial.
+This is only possible if Mercurial is responsible for FILE's directory."
+ (vc-hg-with-cd file
+ (hg-root)))
+
+(defun vc-hg-state (file &optional localp)
+ "Mercurial-specific version of `vc-state'."
+ (let ((state (vc-file-getprop file 'vc-state))
+ status)
+ (unless state
+ (setq status (hg-file-status file)
+ state (if (eq status 'normal)
+ 'up-to-date
+ 'edited))
+ (vc-file-setprop file 'vc-state state))
+ state))
+
+(defun vc-hg-workfile-version (file)
+ "Mercurial-specific version of `vc-workfile-version'."
+ (vc-hg-with-cd file
+ (concat (first (hg-tip)) (cdr (assq (hg-file-status file)
+ '((normal . "")
+ (removed . "r")
+ (added . "a")
+ (modified . "m")))))))
+
+(defun vc-hg-checkout-model (file)
+ "Mercurial-specific version of `vc-checkout-model'."
+ 'implicit)
+
+
;;; Hooks.
(defun hg-mode-line (&optional force)
@@ -622,16 +563,9 @@
An update occurs if optional argument FORCE is non-nil,
hg-update-modeline is non-nil, or we have not yet checked the state of
the file."
- (when (and (hg-root) (or force hg-update-modeline (not hg-mode)))
+ (when (vc-hg-could-register buffer-file-name)
(let ((status (hg-file-status buffer-file-name)))
- (setq hg-status status
- hg-mode (and status (concat " Hg:"
- (car (hg-tip))
- (cdr (assq status
- '((normal . "")
- (removed . "r")
- (added . "a")
- (modified . "m")))))))
+ (setq hg-status status)
status)))
(defun hg-mode ()
@@ -643,7 +577,7 @@
Below is a list of many common SCM tasks. In the list, `G/L'
indicates whether a key binding is global (G) to a repository or local
-(L) to a file. Many commands take a prefix argument.
+\(L) to a file. Many commands take a prefix argument.
SCM Task G/L Key Binding Command Name
-------- --- ----------- ------------
@@ -670,6 +604,7 @@
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"
+ (vc-file-setprop buffer-file-name 'vc-backend 'Hg)
(run-hooks 'hg-mode-hook))
(defun hg-find-file-hook ()
@@ -706,13 +641,9 @@
"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")))
- (let ((buf (current-buffer))
- (update (equal buffer-file-name path)))
+ (let ((buf (current-buffer)))
(hg-view-output (hg-output-buffer-name)
- (apply 'call-process (hg-binary) nil t nil (list "add" path)))
- (when update
- (with-current-buffer buf
- (hg-mode-line)))))
+ (apply 'call-process (hg-binary) nil t nil (list "add" path)))))
(defun hg-addremove ()
(interactive)
@@ -741,7 +672,7 @@
(add-text-properties bol (point) '(face bold))
(message "%s will be committed"
(buffer-substring bol (point)))))))
-
+
(defun hg-commit-mouse-clicked (event)
"Toggle whether or not the file at POS will be committed."
(interactive "@e")
@@ -890,21 +821,18 @@
(hg-read-rev " to start with")
(let ((rev2 (hg-read-rev " to end with" 'working-dir)))
(and (not (eq rev2 'working-dir)) rev2))))
+ (unless rev1
+ (setq rev1 "-1"))
(hg-sync-buffers path)
(let ((a-path (hg-abbrev-file-name path))
- (r1 (or rev1 "tip"))
diff)
- (hg-view-output ((cond
- ((and (equal r1 "tip") (not rev2))
- (format "Mercurial: Diff against tip of %s" a-path))
- ((equal r1 rev2)
- (format "Mercurial: Diff of rev %s of %s" r1 a-path))
- (t
- (format "Mercurial: Diff from rev %s to %s of %s"
- r1 (or rev2 "Current") a-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)))
(if rev2
- (call-process (hg-binary) nil t nil "diff" "-r" r1 "-r" rev2 path)
- (call-process (hg-binary) nil t nil "diff" "-r" r1 path))
+ (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path)
+ (call-process (hg-binary) nil t nil "diff" "-r" rev1 path))
(diff-mode)
(setq diff (not (= (point-min) (point-max))))
(font-lock-fontify-buffer))
@@ -921,55 +849,35 @@
repository on the next commit.
With a prefix argument, prompt for the path to forget."
(interactive (list (hg-read-file-name " to forget")))
- (let ((buf (current-buffer))
- (update (equal buffer-file-name path)))
+ (let ((buf (current-buffer)))
(hg-view-output (hg-output-buffer-name)
- (apply 'call-process (hg-binary) nil t nil (list "forget" path)))
- (when update
- (with-current-buffer buf
- (hg-mode-line)))))
-
-(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)))
+ (apply 'call-process (hg-binary) nil t nil (list "forget" path)))))
+
+(defun hg-incoming ()
+ (interactive)
+ (error "not implemented"))
(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
-REV2 defaults to the tip.
-With a prefix argument, prompt for each parameter."
+REV1 defaults to the initial revision, while REV2 defaults to the tip.
+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))
- (r1 (or rev1 (format "-%d" hg-log-limit)))
- (r2 (or rev2 rev1 "-1")))
- (hg-view-output ((if (equal r1 r2)
- (format "Mercurial: Log of rev %s of %s" rev1 a-path)
- (format "Mercurial: Log from rev %s to %s of %s"
- r1 r2 a-path)))
+ (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)))
(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))
- (hg-log-mode))))
+ (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))
+ (font-lock-fontify-buffer))))
(defun hg-log-repo (path &optional rev1 rev2)
"Display the revision history of the repository containing PATH.
@@ -981,31 +889,17 @@
(hg-read-rev " to end with" (format "-%d" hg-log-limit))))
(hg-log (hg-root path) rev1 rev2))
-(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-outgoing ()
+ (interactive)
+ (error "not implemented"))
(defun hg-pull ()
(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-push ()
+ (interactive)
+ (error "not implemented"))
(defun hg-revert-buffer-internal ()
(let ((ctx (hg-buffer-context)))
@@ -1013,7 +907,6 @@
(hg-run0 "revert" buffer-file-name)
(revert-buffer t t t)
(hg-restore-context ctx)
- (hg-mode-line)
(message "Reverting %s...done" buffer-file-name)))
(defun hg-revert-buffer ()
@@ -1055,7 +948,7 @@
(if root
(message "The root of this repository is `%s'." root)
(message "The path `%s' is not in a Mercurial repository."
- (hg-abbrev-file-name path))))
+ (abbreviate-file-name path t))))
root)
hg-root))
@@ -1084,7 +977,7 @@
(error "not implemented"))
-(provide 'mercurial)
+(provide 'vc-hg)
;;; Local Variables:
--
_______________________________________________
Surf the Web in a faster, safer and easier way:
Download Opera 8 at http://www.opera.com
Powered by Outblaze
vc-hg.patch
Description: Binary data
_______________________________________________
Mercurial mailing list
Mercurial@xxxxxxxxxxx
http://selenic.com/mailman/listinfo/mercurial
|
