diff options
Diffstat (limited to 'lisp/vc-hg.el')
| -rw-r--r-- | lisp/vc-hg.el | 196 |
1 files changed, 137 insertions, 59 deletions
diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el index a7c10eeb027..af2b4f133d2 100644 --- a/lisp/vc-hg.el +++ b/lisp/vc-hg.el @@ -38,42 +38,45 @@ ;; beginning of vc.el. The current status is: ;; FUNCTION NAME STATUS +;; BACKEND PROPERTIES +;; * revision-granularity OK +;; STATE-QUERYING FUNCTIONS ;; * registered (file) OK ;; * state (file) OK ;; - state-heuristic (file) ?? PROBABLY NOT NEEDED ;; - dir-state (dir) OK -;; * workfile-version (file) OK +;; * working-revision (file) OK ;; - latest-on-branch-p (file) ?? ;; * checkout-model (file) OK ;; - workfile-unchanged-p (file) OK ;; - mode-line-string (file) NOT NEEDED ;; - dired-state-info (file) OK ;; STATE-CHANGING FUNCTIONS -;; * register (file &optional rev comment) OK -;; - init-version () NOT NEEDED +;; * register (files &optional rev comment) OK +;; * create-repo () OK +;; - init-revision () NOT NEEDED ;; - responsible-p (file) OK ;; - could-register (file) OK ;; - receive-file (file rev) ?? PROBABLY NOT NEEDED ;; - unregister (file) COMMENTED OUT, MAY BE INCORRECT -;; * checkin (file rev comment) OK -;; * find-version (file rev buffer) OK +;; * checkin (files rev comment) OK +;; * find-revision (file rev buffer) OK ;; * checkout (file &optional editable rev) OK ;; * revert (file &optional contents-done) OK -;; - cancel-version (file editable) ?? PROBABLY NOT NEEDED +;; - rollback (files) ?? PROBABLY NOT NEEDED ;; - merge (file rev1 rev2) NEEDED ;; - merge-news (file) NEEDED -;; - steal-lock (file &optional version) NOT NEEDED +;; - steal-lock (file &optional revision) NOT NEEDED ;; HISTORY FUNCTIONS -;; * print-log (file &optional buffer) OK +;; * print-log (files &optional buffer) OK ;; - log-view-mode () OK -;; - show-log-entry (version) NOT NEEDED, DEFAULT IS GOOD +;; - show-log-entry (revision) NOT NEEDED, DEFAULT IS GOOD ;; - wash-log (file) ?? ;; - logentry-check () NOT NEEDED ;; - comment-history (file) NOT NEEDED ;; - update-changelog (files) NOT NEEDED -;; * diff (file &optional rev1 rev2 buffer) OK -;; - revision-completion-table (file) COMMENTED OUT AS A WORKAROUND FOR A BUG -;; - diff-tree (dir &optional rev1 rev2) TEST IT +;; * diff (files &optional rev1 rev2 buffer) OK +;; - revision-completion-table (files) OK? ;; - annotate-command (file buf &optional rev) OK ;; - annotate-time () OK ;; - annotate-current-time () ?? NOT NEEDED @@ -85,8 +88,8 @@ ;; MISCELLANEOUS ;; - make-version-backups-p (file) ?? ;; - repository-hostname (dirname) ?? -;; - previous-version (file rev) OK -;; - next-version (file rev) OK +;; - previous-revision (file rev) OK +;; - next-revision (file rev) OK ;; - check-headers () ?? ;; - clear-headers () ?? ;; - delete-file (file) TEST IT @@ -125,6 +128,12 @@ :version "22.2" :group 'vc) + +;;; Properties of the backend + +(defun vc-hg-revision-granularity () + 'repository) + ;;; State querying functions ;;;###autoload (defun vc-hg-registered (file) @@ -188,7 +197,7 @@ ;; should not show up in vc-dired, so don't deal with them ;; here. ((eq status-char ?A) - (vc-file-setprop file 'vc-workfile-version "0") + (vc-file-setprop file 'vc-working-revision "0") (vc-file-setprop file 'vc-state 'edited)) ((eq status-char ?M) (vc-file-setprop file 'vc-state 'edited)) @@ -197,8 +206,8 @@ (vc-file-setprop file 'vc-state 'nil))) (forward-line))))) -(defun vc-hg-workfile-version (file) - "Hg-specific version of `vc-workfile-version'." +(defun vc-hg-working-revision (file) + "Hg-specific version of `vc-working-revision'." (let* ((status nil) (out @@ -221,8 +230,8 @@ ;;; History functions -(defun vc-hg-print-log(file &optional buffer) - "Get change log associated with FILE." +(defun vc-hg-print-log(files &optional buffer) + "Get change log associated with FILES." ;; `log-view-mode' needs to have the file name in order to function ;; correctly. "hg log" does not print it, so we insert it here by ;; hand. @@ -233,21 +242,21 @@ ;; If the buffer exists from a previous invocation it might be ;; read-only. (let ((inhibit-read-only t)) - (with-current-buffer - buffer - (insert "File: " (file-name-nondirectory file) "\n"))) - (vc-hg-command - buffer - (if (and (vc-stay-local-p file) (fboundp 'start-process)) 'async 0) - file "log")) + ;; We need to loop and call "hg log" on each file separately. + ;; "hg log" with multiple file arguments mashes all the logs + ;; together. + (dolist (file files) + (with-current-buffer + buffer + (insert "File: " (file-name-nondirectory file) "\n")) + (vc-hg-command buffer 0 file "log")))) (defvar log-view-message-re) (defvar log-view-file-re) (defvar log-view-font-lock-keywords) (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View" - (require 'add-log) ;; we need the faces add-log - ;; Don't have file markers, so use impossible regexp. + (require 'add-log) ;; we need the add-log faces (set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)") (set (make-local-variable 'log-view-message-re) "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)") @@ -266,16 +275,16 @@ ("^date: \\(.+\\)" (1 'change-log-date)) ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))) -(defun vc-hg-diff (file &optional oldvers newvers buffer) - "Get a difference report using hg between two versions of FILE." - (let ((working (vc-workfile-version file))) +(defun vc-hg-diff (files &optional oldvers newvers buffer) + "Get a difference report using hg between two revisions of FILES." + (let ((working (vc-working-revision (car files)))) (if (and (equal oldvers working) (not newvers)) (setq oldvers nil)) (if (and (not oldvers) newvers) (setq oldvers working)) (apply #'vc-hg-command (or buffer "*vc-diff*") nil - (file-name-nondirectory file) - "--cwd" (file-name-directory file) + (mapcar (lambda (file) (file-name-nondirectory file)) files) + "--cwd" (file-name-directory (car files)) "diff" (append (if oldvers @@ -284,27 +293,25 @@ (list "-r" oldvers)) (list "")))))) -(defun vc-hg-revision-table (file) - (let ((default-directory (file-name-directory file))) +(defun vc-hg-revision-table (files) + (let ((default-directory (file-name-directory (car files)))) (with-temp-buffer - (vc-hg-command t nil file "log" "--template" "{rev} ") + (vc-hg-command t nil files "log" "--template" "{rev} ") (split-string (buffer-substring-no-properties (point-min) (point-max)))))) ;; Modelled after the similar function in vc-cvs.el -(defun vc-hg-revision-completion-table (file) - (lexical-let ((file file) +(defun vc-hg-revision-completion-table (files) + (lexical-let ((files files) table) (setq table (lazy-completion-table - table (lambda () (vc-hg-revision-table file)))) + table (lambda () (vc-hg-revision-table files)))) table)) -(defalias 'vc-hg-diff-tree 'vc-hg-diff) - -(defun vc-hg-annotate-command (file buffer &optional version) +(defun vc-hg-annotate-command (file buffer &optional revision) "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER. -Optional arg VERSION is a version to annotate from." - (vc-hg-command buffer 0 file "annotate" "-d" "-n" (if version (concat "-r" version))) +Optional arg REVISION is a revision to annotate from." + (vc-hg-command buffer 0 file "annotate" "-d" "-n" (if revision (concat "-r" revision))) (with-current-buffer buffer (goto-char (point-min)) (re-search-forward "^[0-9]") @@ -327,22 +334,22 @@ Optional arg VERSION is a version to annotate from." (beginning-of-line) (if (looking-at vc-hg-annotate-re) (match-string-no-properties 1)))) -(defun vc-hg-previous-version (file rev) +(defun vc-hg-previous-revision (file rev) (let ((newrev (1- (string-to-number rev)))) (when (>= newrev 0) (number-to-string newrev)))) -(defun vc-hg-next-version (file rev) +(defun vc-hg-next-revision (file rev) (let ((newrev (1+ (string-to-number rev))) - (tip-version + (tip-revision (with-temp-buffer (vc-hg-command t 0 nil "tip") (goto-char (point-min)) (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):") (string-to-number (match-string-no-properties 1))))) - ;; We don't want to exceed the maximum possible version number, ie - ;; the tip version. - (when (<= newrev tip-version) + ;; We don't want to exceed the maximum possible revision number, ie + ;; the tip revision. + (when (<= newrev tip-revision) (number-to-string newrev)))) ;; Modelled after the similar function in vc-bzr.el @@ -358,11 +365,15 @@ Optional arg VERSION is a version to annotate from." "Rename file from OLD to NEW using `hg mv'." (vc-hg-command nil 0 new old "mv")) -(defun vc-hg-register (file &optional rev comment) - "Register FILE under hg. +(defun vc-hg-register (files &optional rev comment) + "Register FILES under hg. REV is ignored. COMMENT is ignored." - (vc-hg-command nil 0 file "add")) + (vc-hg-command nil 0 files "add")) + +(defun vc-hg-create-repo () + "Create a new Mercurial repository." + (vc-hg-command nil 0 nil "init")) (defalias 'vc-hg-responsible-p 'vc-hg-root) @@ -382,12 +393,12 @@ COMMENT is ignored." ;; "Unregister FILE from hg." ;; (vc-hg-command nil nil file "remove")) -(defun vc-hg-checkin (file rev comment) +(defun vc-hg-checkin (files rev comment) "Hg-specific version of `vc-backend-checkin'. REV is ignored." - (vc-hg-command nil 0 file "commit" "-m" comment)) + (vc-hg-command nil 0 files "commit" "-m" comment)) -(defun vc-hg-find-version (file rev buffer) +(defun vc-hg-find-revision (file rev buffer) (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) (if rev @@ -417,7 +428,7 @@ REV is the revision to check out into WORKFILE." "Hg-specific version of `vc-dired-state-info'." (let ((hg-state (vc-state file))) (if (eq hg-state 'edited) - (if (equal (vc-workfile-version file) "0") + (if (equal (vc-working-revision file) "0") "(added)" "(modified)") ;; fall back to the default VC representation (vc-default-dired-state-info 'Hg file)))) @@ -427,13 +438,80 @@ REV is the revision to check out into WORKFILE." (unless contents-done (with-temp-buffer (vc-hg-command t 0 file "revert")))) +;;; Hg specific functionality. + +;;; XXX This functionality is experimental/work in progress. It might +;;; change without notice. +(defvar vc-hg-extra-menu-map + (let ((map (make-sparse-keymap))) + (define-key map [incoming] '(menu-item "Show incoming" vc-hg-incoming)) + (define-key map [outgoing] '(menu-item "Show outgoing" vc-hg-outgoing)) + map)) + +(defun vc-hg-extra-menu () vc-hg-extra-menu-map) + +(define-derived-mode vc-hg-outgoing-mode vc-hg-log-view-mode "Hg-Outgoing") + +(define-derived-mode vc-hg-incoming-mode vc-hg-log-view-mode "Hg-Incoming") + +;; XXX this adds another top level menu, instead figure out how to +;; replace the Log-View menu. +(easy-menu-define log-view-mode-menu vc-hg-outgoing-mode-map + "Hg-outgoing Display Menu" + `("Hg-outgoing" + ["Push selected" vc-hg-push])) + +(easy-menu-define log-view-mode-menu vc-hg-incoming-mode-map + "Hg-incoming Display Menu" + `("Hg-incoming" + ["Pull selected" vc-hg-pull])) + +(defun vc-hg-outgoing () + (interactive) + (let ((bname "*Hg outgoing*")) + (vc-hg-command bname 0 nil "outgoing" "-n") + (pop-to-buffer bname) + (vc-hg-outgoing-mode))) + +(defun vc-hg-incoming () + (interactive) + (let ((bname "*Hg incoming*")) + (vc-hg-command bname 0 nil "incoming" "-n") + (pop-to-buffer bname) + (vc-hg-incoming-mode))) + +(declare-function log-view-get-marked "log-view" ()) + +;; XXX maybe also add key bindings for these functions. +(defun vc-hg-push () + (interactive) + (let ((marked-list (log-view-get-marked))) + (if marked-list + (vc-hg-command + nil 0 nil + (cons "push" + (apply 'nconc + (mapcar (lambda (arg) (list "-r" arg)) marked-list)))) + (error "No log entries selected for push")))) + +(defun vc-hg-pull () + (interactive) + (let ((marked-list (log-view-get-marked))) + (if marked-list + (vc-hg-command + nil 0 nil + (cons "pull" + (apply 'nconc + (mapcar (lambda (arg) (list "-r" arg)) marked-list)))) + (error "No log entries selected for pull")))) + ;;; Internal functions -(defun vc-hg-command (buffer okstatus file &rest flags) +(defun vc-hg-command (buffer okstatus file-or-list &rest flags) "A wrapper around `vc-do-command' for use in vc-hg.el. The difference to vc-do-command is that this function always invokes `hg', and that it passes `vc-hg-global-switches' to it before FLAGS." - (apply 'vc-do-command buffer okstatus "hg" file + (apply 'vc-do-command buffer okstatus "hg" file-or-list (if (stringp vc-hg-global-switches) (cons vc-hg-global-switches flags) (append vc-hg-global-switches |