X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ec4149ff60687d7acba5435e33cc0365e0c5738a..d0fc47eda0459c486dd114eee8674df1a6e4bc6a:/lisp/vc-hg.el diff --git a/lisp/vc-hg.el b/lisp/vc-hg.el index baa60589f9..bfc4846a5d 100644 --- a/lisp/vc-hg.el +++ b/lisp/vc-hg.el @@ -42,12 +42,15 @@ ;; * registered (file) OK ;; * state (file) OK ;; - state-heuristic (file) NOT NEEDED +;; - dir-status (dir update-function) OK +;; - dir-status-files (dir files ds uf) OK +;; - status-extra-headers (dir) OK +;; - status-printer (fileinfo) OK ;; * working-revision (file) OK ;; - latest-on-branch-p (file) ?? ;; * checkout-model (files) OK ;; - workfile-unchanged-p (file) OK ;; - mode-line-string (file) NOT NEEDED -;; - prettify-state-info (file) OK ;; STATE-CHANGING FUNCTIONS ;; * register (files &optional rev comment) OK ;; * create-repo () OK @@ -76,10 +79,9 @@ ;; - annotate-time () OK ;; - annotate-current-time () NOT NEEDED ;; - annotate-extract-revision-at-line () OK -;; SNAPSHOT SYSTEM -;; - create-snapshot (dir name branchp) NEEDED (probably branch?) -;; - assign-name (file name) NOT NEEDED -;; - retrieve-snapshot (dir name update) ?? NEEDED?? +;; TAG SYSTEM +;; - create-tag (dir name branchp) NEEDED +;; - retrieve-tag (dir name update) NEEDED ;; MISCELLANEOUS ;; - make-version-backups-p (file) ?? ;; - repository-hostname (dirname) ?? @@ -109,7 +111,8 @@ (eval-when-compile (require 'cl) - (require 'vc)) + (require 'vc) + (require 'vc-dir)) ;;; Customization options @@ -138,12 +141,11 @@ ;;;###autoload (load "vc-hg") ;;;###autoload (vc-hg-registered file)))) -;; Modelled after the similar function in vc-bzr.el +;; Modeled after the similar function in vc-bzr.el (defun vc-hg-registered (file) "Return non-nil if FILE is registered with hg." (when (vc-hg-root file) ; short cut (let ((state (vc-hg-state file))) ; expensive - (vc-file-setprop file 'vc-state state) (and state (not (memq state '(ignored unregistered))))))) (defun vc-hg-state (file) @@ -213,23 +215,19 @@ ;; If the buffer exists from a previous invocation it might be ;; read-only. (let ((inhibit-read-only t)) - ;; 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")))) + (with-current-buffer + buffer + (vc-hg-command buffer 0 files "log")))) (defvar log-view-message-re) (defvar log-view-file-re) (defvar log-view-font-lock-keywords) +(defvar log-view-per-file-logs) (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View" (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-file-re) "\\`a\\`") + (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)") (set (make-local-variable 'log-view-font-lock-keywords) @@ -252,14 +250,16 @@ (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)))) + (let* ((firstfile (car files)) + (working (and firstfile (vc-working-revision firstfile)))) (when (and (equal oldvers working) (not newvers)) (setq oldvers nil)) (when (and (not oldvers) newvers) (setq oldvers working)) (apply #'vc-hg-command (or buffer "*vc-diff*") nil (mapcar (lambda (file) (file-name-nondirectory file)) files) - "--cwd" (file-name-directory (car files)) + "--cwd" (or (when firstfile (file-name-directory firstfile)) + (expand-file-name default-directory)) "diff" (append (when oldvers @@ -274,7 +274,7 @@ (split-string (buffer-substring-no-properties (point-min) (point-max)))))) -;; Modelled after the similar function in vc-cvs.el +;; Modeled after the similar function in vc-cvs.el (defun vc-hg-revision-completion-table (files) (lexical-let ((files files) table) @@ -285,18 +285,23 @@ (defun vc-hg-annotate-command (file buffer &optional revision) "Execute \"hg annotate\" on FILE, inserting the contents in BUFFER. Optional arg REVISION is a revision to annotate from." - (vc-hg-command buffer 0 file "annotate" "-d" "-n" + (vc-hg-command buffer 0 file "annotate" "-d" "-n" (when revision (concat "-r" revision))) (with-current-buffer buffer (goto-char (point-min)) - (re-search-forward "^[0-9]") - (delete-region (point-min) (1- (point))))) + (re-search-forward "^[ \t]*[0-9]") + (delete-region (point-min) (match-beginning 0)))) +(declare-function vc-annotate-convert-time "vc-annotate" (time)) ;; The format for one line output by "hg annotate -d -n" looks like this: ;;215 Wed Jun 20 21:22:58 2007 -0700: CONTENTS ;; i.e: VERSION_NUMBER DATE: CONTENTS -(defconst vc-hg-annotate-re "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\): ") +;; If the user has set the "--follow" option, the output looks like: +;;215 Wed Jun 20 21:22:58 2007 -0700 foo.c: CONTENTS +;; i.e. VERSION_NUMBER DATE FILENAME: CONTENTS +(defconst vc-hg-annotate-re + "^[ \t]*\\([0-9]+\\) \\(.\\{30\\}\\)[^:\n]*\\(:[^ \n][^:\n]*\\)*: ") (defun vc-hg-annotate-time () (when (looking-at vc-hg-annotate-re) @@ -307,7 +312,7 @@ Optional arg REVISION is a revision to annotate from." (defun vc-hg-annotate-extract-revision-at-line () (save-excursion (beginning-of-line) - (if (looking-at vc-hg-annotate-re) (match-string-no-properties 1)))) + (when (looking-at vc-hg-annotate-re) (match-string-no-properties 1)))) (defun vc-hg-previous-revision (file rev) (let ((newrev (1- (string-to-number rev)))) @@ -327,7 +332,7 @@ Optional arg REVISION is a revision to annotate from." (when (<= newrev tip-revision) (number-to-string newrev)))) -;; Modelled after the similar function in vc-bzr.el +;; Modeled after the similar function in vc-bzr.el (defun vc-hg-delete-file (file) "Delete FILE and delete it in the hg repository." (condition-case () @@ -335,7 +340,7 @@ Optional arg REVISION is a revision to annotate from." (file-error nil)) (vc-hg-command nil 0 file "remove" "--after" "--force")) -;; Modelled after the similar function in vc-bzr.el +;; Modeled after the similar function in vc-bzr.el (defun vc-hg-rename-file (old new) "Rename file from OLD to NEW using `hg mv'." (vc-hg-command nil 0 new "mv" old)) @@ -352,7 +357,7 @@ COMMENT is ignored." (defalias 'vc-hg-responsible-p 'vc-hg-root) -;; Modelled after the similar function in vc-bzr.el +;; Modeled after the similar function in vc-bzr.el (defun vc-hg-could-register (file) "Return non-nil if FILE could be registered under hg." (and (vc-hg-responsible-p file) ; shortcut @@ -363,7 +368,7 @@ COMMENT is ignored." ;; registered. (error)))) -;; XXX This would remove the file. Is that correct? +;; FIXME: This would remove the file. Is that correct? ;; (defun vc-hg-unregister (file) ;; "Unregister FILE from hg." ;; (vc-hg-command nil nil file "remove")) @@ -380,7 +385,7 @@ REV is ignored." (vc-hg-command buffer 0 file "cat" "-r" rev) (vc-hg-command buffer 0 file "cat")))) -;; Modelled after the similar function in vc-bzr.el +;; Modeled after the similar function in vc-bzr.el (defun vc-hg-checkout (file &optional editable rev) "Retrieve a revision of FILE. EDITABLE is ignored. @@ -392,11 +397,11 @@ REV is the revision to check out into WORKFILE." (vc-hg-command t 0 file "cat" "-r" rev) (vc-hg-command t 0 file "cat"))))) -;; Modelled after the similar function in vc-bzr.el +;; Modeled after the similar function in vc-bzr.el (defun vc-hg-workfile-unchanged-p (file) (eq 'up-to-date (vc-hg-state file))) -;; Modelled after the similar function in vc-bzr.el +;; Modeled after the similar function in vc-bzr.el (defun vc-hg-revert (file &optional contents-done) (unless contents-done (with-temp-buffer (vc-hg-command t 0 file "revert")))) @@ -422,7 +427,9 @@ REV is the revision to check out into WORKFILE." (:constructor vc-hg-create-extra-fileinfo (rename-state extra-name)) (:conc-name vc-hg-extra-fileinfo->)) rename-state ;; rename or copy state - extra-name) ;; original name for copies and rename targets, new name for + extra-name) ;; original name for copies and rename targets, new name for + +(declare-function vc-default-status-printer "vc-dir" (backend fileentry)) (defun vc-hg-status-printer (info) "Pretty-printer for the vc-dir-fileinfo structure." @@ -468,7 +475,7 @@ REV is the revision to check out into WORKFILE." ;; For copied files the output looks like this: ;; A COPIED_FILE_NAME ;; ORIGINAL_FILE_NAME - (setf (nth 2 last-added) + (setf (nth 2 last-added) (vc-hg-create-extra-fileinfo 'copied file)) (setq last-line-copy t)) ((and last-line-copy (eq translated 'removed)) @@ -495,7 +502,32 @@ REV is the revision to check out into WORKFILE." (vc-exec-after `(vc-hg-after-dir-status (quote ,update-function)))) -;; XXX this adds another top level menu, instead figure out how to +(defun vc-hg-dir-status-files (dir files default-state update-function) + (apply 'vc-hg-command (current-buffer) 'async dir "status" "-C" files) + (vc-exec-after + `(vc-hg-after-dir-status (quote ,update-function)))) + +(defun vc-hg-status-extra-header (name &rest commands) + (concat (propertize name 'face 'font-lock-type-face) + (propertize + (with-temp-buffer + (apply 'vc-hg-command (current-buffer) 0 nil commands) + (buffer-substring-no-properties (point-min) (1- (point-max)))) + 'face 'font-lock-variable-name-face))) + +(defun vc-hg-status-extra-headers (dir) + "Generate extra status headers for a Mercurial tree." + (let ((default-directory dir)) + (concat + (vc-hg-status-extra-header "Root : " "root") "\n" + (vc-hg-status-extra-header "Branch : " "id" "-b") "\n" + (vc-hg-status-extra-header "Tags : " "id" "-t") ; "\n" + ;; these change after each commit + ;; (vc-hg-status-extra-header "Local num : " "id" "-n") "\n" + ;; (vc-hg-status-extra-header "Global id : " "id" "-i") + ))) + +;; FIXME: 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"