diff options
Diffstat (limited to 'lisp/vc-hg.el')
| -rw-r--r-- | lisp/vc-hg.el | 273 |
1 files changed, 201 insertions, 72 deletions
diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el index 9e76a67e8ae..597c49aaa3f 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) @@ -138,7 +147,9 @@ (defun vc-hg-registered (file) "Return non-nil if FILE is registered with hg." (when (vc-hg-root file) ; short cut - (vc-file-setprop file 'vc-state (vc-hg-state file)))) ; expensive + (let ((state (vc-hg-state file))) ; expensive + (vc-file-setprop file 'vc-state state) + (not (memq state '(ignored unregistered)))))) (defun vc-hg-state (file) "Hg-specific version of `vc-state'." @@ -153,24 +164,27 @@ ;; Ignore all errors. (call-process "hg" nil t nil "--cwd" (file-name-directory file) - "status" (file-name-nondirectory file)) + "status" "-A" (file-name-nondirectory file)) ;; Some problem happened. E.g. We can't find an `hg' ;; executable. (error nil))))))) (when (eq 0 status) - (if (eq 0 (length out)) 'up-to-date (when (null (string-match ".*: No such file or directory$" out)) (let ((state (aref out 0))) (cond + ((eq state ?=) 'up-to-date) ((eq state ?A) 'edited) ((eq state ?M) 'edited) - ((eq state ?R) nil) - ((eq state ??) nil) - (t 'up-to-date)))))))) + ((eq state ?I) 'ignored) + ((eq state ?R) 'unregistered) + ((eq state ??) 'unregistered) + ((eq state ?C) 'up-to-date) ;; Older mercurials use this + (t 'up-to-date))))))) (defun vc-hg-dir-state (dir) (with-temp-buffer - (vc-hg-command (current-buffer) nil dir "status") + (buffer-disable-undo) ;; Because these buffers can get huge + (vc-hg-command (current-buffer) nil dir "status" "-A") (goto-char (point-min)) (let ((status-char nil) (file nil)) @@ -181,26 +195,41 @@ (buffer-substring-no-properties (+ (point) 2) (line-end-position)))) (cond + ;; State flag for a clean file is now C, might change to =. ;; The rest of the possible states in "hg status" output: - ;; R = removed ;; ! = deleted, but still tracked - ;; ? = not tracked ;; should not show up in vc-dired, so don't deal with them ;; here. + + ;; Mercurial up to 0.9.5 used C, = is used now. + ((or (eq status-char ?=) (eq status-char ?C)) + (vc-file-setprop file 'vc-backend 'Hg) + (vc-file-setprop file 'vc-state 'up-to-date)) ((eq status-char ?A) (vc-file-setprop file 'vc-backend 'Hg) - (vc-file-setprop file 'vc-workfile-version "0") - (vc-file-setprop file 'vc-state 'edited)) + (vc-file-setprop file 'vc-working-revision "0") + (vc-file-setprop file 'vc-state 'added)) + ((eq status-char ?R) + (vc-file-setprop file 'vc-backend 'Hg) + (vc-file-setprop file 'vc-state 'removed)) ((eq status-char ?M) (vc-file-setprop file 'vc-backend 'Hg) (vc-file-setprop file 'vc-state 'edited)) + ((eq status-char ?I) + (vc-file-setprop file 'vc-backend 'Hg) + (vc-file-setprop file 'vc-state 'ignored)) ((eq status-char ??) (vc-file-setprop file 'vc-backend 'none) - (vc-file-setprop file 'vc-state 'nil))) + (vc-file-setprop file 'vc-state 'unregistered)) + ((eq status-char ?!) + nil) + (t ;; Presently C, might change to = in 0.9.6 + (vc-file-setprop file 'vc-backend 'Hg) + (vc-file-setprop file 'vc-state 'up-to-date))) (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 @@ -223,9 +252,9 @@ ;;; History functions -(defun vc-hg-print-log(file &optional buffer) - "Get change log associated with FILE." - ;; `log-view-mode' needs to have the file name in order to function +(defun vc-hg-print-log (files &optional buffer) + "Get change log associated with FILES." + ;; `log-view-mode' needs to have the file names in order to function ;; correctly. "hg log" does not print it, so we insert it here by ;; hand. @@ -235,22 +264,23 @@ ;; 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. Ironically enough, this puts us back near CVS + ;; which can't generate proper fileset logs either. + (dolist (file files) + (with-current-buffer + buffer + (insert "Working file: " file "\n")) ;; Like RCS/CVS. + (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. - (set (make-local-variable 'log-view-file-re) "^File:[ \t]+\\(.+\\)") + (require 'add-log) ;; we need the add-log faces + (set (make-local-variable 'log-view-file-re) "^Working file:[ \t]+\\(.+\\)") (set (make-local-variable 'log-view-message-re) "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)") (set (make-local-variable 'log-view-font-lock-keywords) @@ -271,16 +301,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 @@ -289,27 +319,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]") @@ -332,22 +360,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 @@ -363,11 +391,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) @@ -387,12 +419,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 @@ -422,7 +454,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)))) @@ -432,13 +464,110 @@ 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 Experimental function for the vc-dired replacement. +(defun vc-hg-dir-status (dir) + "Return a list of conses (file . state) for DIR." + (with-temp-buffer + (vc-hg-command (current-buffer) nil dir "status" "-A") + (goto-char (point-min)) + (let ((status-char nil) + (file nil) + (translation '((?= . up-to-date) + (?C . up-to-date) + (?A . added) + (?R . removed) + (?M . edited) + (?I . ignored) + (?! . deleted) + (?? . unregistered))) + (translated nil) + (result nil)) + (while (not (eobp)) + (setq status-char (char-after)) + (setq file + (buffer-substring-no-properties (+ (point) 2) + (line-end-position))) + (setq translated (assoc status-char translation)) + (when (and translated (not (eq (cdr translated) 'up-to-date))) + (push (cons file (cdr translated)) result)) + (forward-line)) + result))) + +;; 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 |