diff options
Diffstat (limited to 'lisp/vc.el')
| -rw-r--r-- | lisp/vc.el | 421 |
1 files changed, 248 insertions, 173 deletions
diff --git a/lisp/vc.el b/lisp/vc.el index c3c03131caa..47d231eb2c7 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -46,8 +46,9 @@ ;; This mode is fully documented in the Emacs user's manual. ;; -;; Supported version-control systems presently include CVS, RCS, GNU Arch, -;; Subversion, Meta-CVS, and SCCS (or its free replacement, CSSC). +;; Supported version-control systems presently include CVS, RCS, GNU +;; Arch, Subversion, Bzr, Mercurial, Meta-CVS, and SCCS (or its free +;; replacement, CSSC). ;; ;; Some features will not work with old RCS versions. Where ;; appropriate, VC finds out which version you have, and allows or @@ -101,6 +102,12 @@ ;; with `vc-sys-'. Some of the functions are mandatory (marked with a ;; `*'), others are optional (`-'). ;; +;; BACKEND PROPERTIES +;; +;; * revision-granularity +;; +;; Takes no arguments. Returns either 'file or 'repository. +;; ;; STATE-QUERYING FUNCTIONS ;; ;; * registered (file) @@ -163,9 +170,12 @@ ;; ;; - mode-line-string (file) ;; -;; If provided, this function should return the VC-specific mode line -;; string for FILE. The default implementation deals well with all -;; states that `vc-state' can return. +;; If provided, this function should return the VC-specific mode +;; line string for FILE. The returned string should have a +;; `help-echo' property which is the text to be displayed as a +;; tooltip when the mouse hovers over the VC entry on the mode-line. +;; The default implementation deals well with all states that +;; `vc-state' can return. ;; ;; - dired-state-info (file) ;; @@ -175,12 +185,20 @@ ;; ;; STATE-CHANGING FUNCTIONS ;; -;; * register (file &optional rev comment) +;; * create-repo () ;; -;; Register FILE in this backend. Optionally, an initial revision REV -;; and an initial description of the file, COMMENT, may be specified. +;; Create an empty repository in the current directory and initialize +;; it so VC mode can add files to it. For file-oriented systems, this +;; need do no more than create a subdirectory with the right name. +;; +;; * register (files &optional rev comment) +;; +;; Register FILES in this backend. Optionally, an initial revision REV +;; and an initial description of the file, COMMENT, may be specified, +;; but it is not guaranteed that the backend will do anything with this. ;; The implementation should pass the value of vc-register-switches -;; to the backend command. +;; to the backend command. (Note: in older versions of VC, this +;; command took a single file argument and not a list.) ;; ;; - init-version (file) ;; @@ -214,12 +232,14 @@ ;; Unregister FILE from this backend. This is only needed if this ;; backend may be used as a "more local" backend for temporary editing. ;; -;; * checkin (file rev comment) +;; * checkin (files rev comment) ;; -;; Commit changes in FILE to this backend. If REV is non-nil, that -;; should become the new revision number. COMMENT is used as a -;; check-in comment. The implementation should pass the value of -;; vc-checkin-switches to the backend command. +;; Commit changes in FILES to this backend. If REV is non-nil, that +;; should become the new revision number (not all backends do +;; anything with it). COMMENT is used as a check-in comment. The +;; implementation should pass the value of vc-checkin-switches to +;; the backend command. (Note: in older versions of VC, this +;; command took a single file argument and not a list.) ;; ;; * find-version (file rev buffer) ;; @@ -246,13 +266,14 @@ ;; already been reverted from a version backup, and this function ;; only needs to update the status of FILE within the backend. ;; -;; - cancel-version (file editable) +;; - rollback (files) ;; -;; Cancel the current workfile version of FILE, i.e. remove it from the -;; master. EDITABLE non-nil means that FILE should be writable -;; afterwards, and if locking is used for FILE, then a lock should also -;; be set. If this function is not provided, trying to cancel a -;; version is caught as an error. +;; Remove the tip version of each of FILES from the repository. If +;; this function is not provided, trying to cancel a version is +;; caught as an error. (Most backends don't provide it.) (Also +;; note that older versions of this backend command were called +;; 'cancel-version' and took a single file arg, not a list of +;; files.) ;; ;; - merge (file rev1 rev2) ;; @@ -271,10 +292,11 @@ ;; ;; HISTORY FUNCTIONS ;; -;; * print-log (file &optional buffer) +;; * print-log (files &optional buffer) ;; -;; Insert the revision log of FILE into BUFFER, or the *vc* buffer -;; if BUFFER is nil. +;; Insert the revision log for FILES into BUFFER, or the *vc* buffer +;; if BUFFER is nil. (Note: older versions of this function expected +;; only a single file argument.) ;; ;; - log-view-mode () ;; @@ -327,6 +349,11 @@ ;; of either 0 (no differences found), or 1 (either non-empty diff ;; or the diff is run asynchronously). ;; +;; - revision-completion-table (file) +;; +;; Return a completion table for existing revisions of FILE. +;; The default is to not use any completion table. +;; ;; - diff-tree (dir &optional rev1 rev2) ;; ;; Insert the diff for all files at and below DIR into the *vc-diff* @@ -559,7 +586,8 @@ These are passed to the checkin program by \\[vc-register]." :group 'vc :version "20.3") -(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn" "{arch}") +(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".svn" + ".hg" ".bzr" "{arch}") "List of directory names to be ignored when walking directory trees." :type '(repeat string) :group 'vc) @@ -587,7 +615,7 @@ to use -L and sets this variable to remember whether it worked." :group 'vc) (defcustom vc-allow-async-revert nil - "Specifies whether the diff during \\[vc-revert-buffer] may be asynchronous. + "Specifies whether the diff during \\[vc-revert] may be asynchronous. Enabling this option means that you can confirm a revert operation even if the local changes in the file have not been found and displayed yet." :type '(choice (const :tag "No" nil) @@ -951,6 +979,8 @@ Else, add CODE to the process' sentinel." ;; lost. Terminated processes get deleted automatically ;; anyway. -- cyd ((or (null proc) (eq (process-status proc) 'exit)) + ;; Make sure we've read the process's output before going further. + (if proc (accept-process-output proc)) (eval code)) ;; If a process is running, add CODE to the sentinel ((eq (process-status proc) 'run) @@ -958,12 +988,13 @@ Else, add CODE to the process' sentinel." (set-process-sentinel proc `(lambda (p s) (with-current-buffer ',(current-buffer) - (goto-char (process-mark p)) - ,@(append (cdr (cdr (cdr ;strip off `with-current-buffer buf - ; (goto-char...)' - (car (cdr (cdr ;strip off `lambda (p s)' - sentinel)))))) - (list `(vc-exec-after ',code)))))))) + (save-excursion + (goto-char (process-mark p)) + ,@(append (cdr (cdr (car ;Strip off (save-exc (goto-char...) + (cdr (cdr ;Strip off (with-current-buffer buf + (car (cdr (cdr ;Strip off (lambda (p s) + sentinel)))))))) + (list `(vc-exec-after ',code))))))))) (t (error "Unexpected process state")))) nil) @@ -972,9 +1003,13 @@ Else, add CODE to the process' sentinel." Each function is called inside the buffer in which the command was run and is passed 3 arguments: the COMMAND, the FILE and the FLAGS.") +(defun vc-delistify (filelist) + "Smash a FILELIST into a file list string suitable for info messages." + (if (not filelist) "." (mapconcat 'identity filelist " "))) + (defvar w32-quote-process-args) ;;;###autoload -(defun vc-do-command (buffer okstatus command file &rest flags) +(defun vc-do-command (buffer okstatus command file-or-list &rest flags) "Execute a VC command, notifying user and checking for errors. Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the current buffer if BUFFER is t. If the destination buffer is not @@ -982,65 +1017,69 @@ already current, set it up properly and erase it. The command is considered successful if its exit status does not exceed OKSTATUS (if OKSTATUS is nil, that means to ignore error status, if it is `async', that means not to wait for termination of the subprocess; if it is t it means to -ignore all execution errors). FILE is the -name of the working file (may also be nil, to execute commands that -don't expect a file name). If an optional list of FLAGS is present, +ignore all execution errors). FILE-OR-LIST is the name of a working file; +it may be a list of files or be nil (to execute commands that don't expect +a file name or set of files). If an optional list of FLAGS is present, that is inserted into the command line before the filename." - (and file (setq file (expand-file-name file))) - (if vc-command-messages - (message "Running %s on %s..." command file)) - (save-current-buffer - (unless (or (eq buffer t) - (and (stringp buffer) - (string= (buffer-name) buffer)) - (eq buffer (current-buffer))) - (vc-setup-buffer buffer)) - (let ((squeezed (remq nil flags)) - (inhibit-read-only t) - (status 0)) - (when file - ;; FIXME: file-relative-name can return a bogus result because - ;; it doesn't look at the actual file-system to see if symlinks - ;; come into play. - (setq squeezed (append squeezed (list (file-relative-name file))))) - (let ((exec-path (append vc-path exec-path)) - ;; Add vc-path to PATH for the execution of this command. - (process-environment - (cons (concat "PATH=" (getenv "PATH") - path-separator - (mapconcat 'identity vc-path path-separator)) - process-environment)) - (w32-quote-process-args t)) - (if (and (eq okstatus 'async) (file-remote-p default-directory)) - ;; start-process does not support remote execution - (setq okstatus nil)) - (if (eq okstatus 'async) - (let ((proc - (let ((process-connection-type nil)) - (apply 'start-process command (current-buffer) command - squeezed)))) - (unless (active-minibuffer-window) - (message "Running %s in the background..." command)) - ;;(set-process-sentinel proc (lambda (p msg) (delete-process p))) - (set-process-filter proc 'vc-process-filter) - (vc-exec-after - `(unless (active-minibuffer-window) - (message "Running %s in the background... done" ',command)))) - (let ((buffer-undo-list t)) - (setq status (apply 'process-file command nil t nil squeezed))) - (when (and (not (eq t okstatus)) - (or (not (integerp status)) - (and okstatus (< okstatus status)))) - (pop-to-buffer (current-buffer)) - (goto-char (point-min)) - (shrink-window-if-larger-than-buffer) - (error "Running %s...FAILED (%s)" command - (if (integerp status) (format "status %d" status) status)))) - (if vc-command-messages - (message "Running %s...OK" command))) - (vc-exec-after - `(run-hook-with-args 'vc-post-command-functions ',command ',file ',flags)) - status))) + ;; FIXME: file-relative-name can return a bogus result because + ;; it doesn't look at the actual file-system to see if symlinks + ;; come into play. + (let* ((files + (mapcar (lambda (f) (file-relative-name (expand-file-name f))) + (if (listp file-or-list) file-or-list (list file-or-list)))) + (full-command + (concat command " " (vc-delistify flags) " " (vc-delistify files)))) + (if vc-command-messages + (message "Running %s..." full-command)) + (save-current-buffer + (unless (or (eq buffer t) + (and (stringp buffer) + (string= (buffer-name) buffer)) + (eq buffer (current-buffer))) + (vc-setup-buffer buffer)) + (let ((squeezed (remq nil flags)) + (inhibit-read-only t) + (status 0)) + (when files + (setq squeezed (nconc squeezed files))) + (let ((exec-path (append vc-path exec-path)) + ;; Add vc-path to PATH for the execution of this command. + (process-environment + (cons (concat "PATH=" (getenv "PATH") + path-separator + (mapconcat 'identity vc-path path-separator)) + process-environment)) + (w32-quote-process-args t)) + (if (and (eq okstatus 'async) (file-remote-p default-directory)) + ;; start-process does not support remote execution + (setq okstatus nil)) + (if (eq okstatus 'async) + (let ((proc + (let ((process-connection-type nil)) + (apply 'start-process command (current-buffer) command + squeezed)))) + (unless (active-minibuffer-window) + (message "Running %s in the background..." full-command)) + ;;(set-process-sentinel proc (lambda (p msg) (delete-process p))) + (set-process-filter proc 'vc-process-filter) + (vc-exec-after + `(unless (active-minibuffer-window) + (message "Running %s in the background... done" ',full-command)))) + (let ((buffer-undo-list t)) + (setq status (apply 'process-file command nil t nil squeezed))) + (when (and (not (eq t okstatus)) + (or (not (integerp status)) + (and okstatus (< okstatus status)))) + (pop-to-buffer (current-buffer)) + (goto-char (point-min)) + (shrink-window-if-larger-than-buffer) + (error "Running %s...FAILED (%s)" full-command + (if (integerp status) (format "status %d" status) status)))) + (if vc-command-messages + (message "Running %s...OK" full-command))) + (vc-exec-after + `(run-hook-with-args 'vc-post-command-functions ',command ',file-or-list ',flags)) + status)))) (defun vc-position-context (posn) "Save a bit of the text around POSN in the current buffer. @@ -1270,7 +1309,7 @@ If VERBOSE is non-nil, query the user rather than using default parameters." ;; DO NOT revert the file without asking the user! (if (not visited) (find-file-other-window file)) (if (yes-or-no-p "Revert to master version? ") - (vc-revert-buffer))) + (vc-revert))) (t ;; normal action (if (not verbose) (vc-checkin file nil comment) @@ -1460,7 +1499,7 @@ first backend that could register the file is used." (message "Registering %s... " file) (let ((backend (vc-responsible-backend file t))) (vc-file-clearprops file) - (vc-call-backend backend 'register file rev comment) + (vc-call-backend backend 'register (list file) rev comment) (vc-file-setprop file 'vc-backend backend) (unless vc-make-backup-files (make-local-variable 'backup-inhibited) @@ -1516,6 +1555,16 @@ The default is to return nil always." The default implementation returns t for all files." t) +(defun vc-expand-dirs (file-or-dir-list) + "Expands directories in a file list specification. +Only files already under version control are noticed." + ;; FIXME: Kill this function. + (let ((flattened '())) + (dolist (node file-or-dir-list) + (vc-file-tree-walk + node (lambda (f) (if (vc-backend f) (push f flattened))))) + (nreverse flattened))) + (defun vc-resynch-window (file &optional keep noquery) "If FILE is in the current buffer, either revert or unvisit it. The choice between revert (to see expanded keywords) and unvisit depends on @@ -1672,7 +1721,7 @@ Runs the normal hook `vc-checkin-hook'." ;; Change buffers to get local value of vc-checkin-switches. (with-current-buffer (or (get-file-buffer file) (current-buffer)) (progn - (vc-call checkin file rev comment) + (vc-call checkin (list file) rev comment) (vc-delete-automatic-version-backups file))) `((vc-state . up-to-date) (vc-checkout-time . ,(nth 5 (file-attributes file))) @@ -1752,6 +1801,8 @@ saving the buffer." (message "No changes to %s since latest version" file) (vc-version-diff file nil nil))))) +(defun vc-default-revision-completion-table (backend file) nil) + (defun vc-version-diff (file rev1 rev2) "List the differences between FILE's versions REV1 and REV2. If REV1 is empty or nil it means to use the current workfile version; @@ -1759,12 +1810,13 @@ REV2 empty or nil means the current file contents. FILE may also be a directory, in that case, generate diffs between the correponding versions of all registered files in or below it." (interactive - (let ((file (expand-file-name - (read-file-name (if buffer-file-name - "File or dir to diff (default visited file): " - "File or dir to diff: ") - default-directory buffer-file-name t))) - (rev1-default nil) (rev2-default nil)) + (let* ((file (expand-file-name + (read-file-name (if buffer-file-name + "File or dir to diff (default visited file): " + "File or dir to diff: ") + default-directory buffer-file-name t))) + (rev1-default nil) (rev2-default nil) + (completion-table (vc-call revision-completion-table file))) ;; compute default versions based on the file state (cond ;; if it's a directory, don't supply any version default @@ -1776,21 +1828,25 @@ versions of all registered files in or below it." ;; if the file is not locked, use last and previous version as default (t (setq rev1-default (vc-call previous-version file - (vc-workfile-version file))) + (vc-workfile-version file))) (if (string= rev1-default "") (setq rev1-default nil)) (setq rev2-default (vc-workfile-version file)))) ;; construct argument list - (list file - (read-string (if rev1-default - (concat "Older version (default " - rev1-default "): ") - "Older version: ") - nil nil rev1-default) - (read-string (if rev2-default - (concat "Newer version (default " - rev2-default "): ") - "Newer version (default current source): ") - nil nil rev2-default)))) + (let* ((rev1-prompt (if rev1-default + (concat "Older version (default " + rev1-default "): ") + "Older version: ")) + (rev2-prompt (concat "Newer version (default " + (or rev2-default "current source") "): ")) + (rev1 (if completion-table + (completing-read rev1-prompt completion-table + nil nil nil nil rev1-default) + (read-string rev1-prompt nil nil rev1-default))) + (rev2 (if completion-table + (completing-read rev2-prompt completion-table + nil nil nil nil rev2-default) + (read-string rev2-prompt nil nil rev2-default)))) + (list file rev1 rev2)))) (if (file-directory-p file) ;; recursive directory diff (progn @@ -1885,7 +1941,7 @@ actually call the backend, but performs a local diff." (error "diff failed")) (if (not vc-diff-knows-L) (setq vc-diff-knows-L 'yes))) status) - (vc-call diff file rev1 rev2)))) + (vc-call diff (list file) rev1 rev2 "*vc-diff*")))) (defun vc-switches (backend op) (let ((switches @@ -1945,7 +2001,16 @@ The meaning of REV1 and REV2 is the same as for `vc-version-diff'." "Visit version REV of the current file in another window. If the current file is named `F', the version is named `F.~REV~'. If `F.~REV~' already exists, use it instead of checking it out again." - (interactive "sVersion to visit (default is workfile version): ") + (interactive + (save-current-buffer + (vc-ensure-vc-buffer) + (let ((completion-table + (vc-call revision-completion-table buffer-file-name)) + (prompt "Version to visit (default is workfile version): ")) + (list + (if completion-table + (completing-read prompt completion-table) + (read-string prompt)))))) (vc-ensure-vc-buffer) (let* ((file buffer-file-name) (version (if (string-equal rev "") @@ -2108,7 +2173,7 @@ See Info node `Merging'." (define-key vmap "t" 'vc-dired-toggle-terse-mode) map)) -(define-derived-mode vc-dired-mode dired-mode "Dired under VC" +(define-derived-mode vc-dired-mode dired-mode "Dired under " "The major mode used in VC directory buffers. It works like Dired, but lists only files under version control, with @@ -2168,6 +2233,8 @@ There is a special command, `*l', to mark all files currently locked." (set (make-local-variable 'dired-actual-switches) vc-dired-switches)) (set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display) + (setq mode-name (concat mode-name (symbol-name (vc-responsible-backend + default-directory)))) (setq vc-dired-mode t)) (defun vc-dired-toggle-terse-mode () @@ -2226,7 +2293,9 @@ Called by dired after any portion of a vc-dired buffer has been read in." ;; if the backend supports it, get the state ;; of all files in this directory at once (let ((backend (vc-responsible-backend subdir))) - (if (vc-find-backend-function backend 'dir-state) + ;; check `backend' can really handle `subdir'. + (if (and (vc-call-backend backend 'responsible-p subdir) + (vc-find-backend-function backend 'dir-state)) (vc-call-backend backend 'dir-state subdir))) (forward-line 1) ;; erase (but don't remove) the "total" line @@ -2443,7 +2512,7 @@ If FOCUS-REV is non-nil, leave the point at that revision." ;; buffer can be accessed by the command. (condition-case err (progn - (vc-call print-log file "*vc-change-log*") + (vc-call print-log (list file) "*vc-change-log*") (set-buffer "*vc-change-log*")) (wrong-number-of-arguments ;; If this error came from the above call to print-log, try again @@ -2456,7 +2525,7 @@ If FOCUS-REV is non-nil, leave the point at that revision." (not (eq (caddr err) 2))) (signal (car err) (cdr err)) ;; for backward compatibility - (vc-call print-log file) + (vc-call print-log (list file)) (set-buffer "*vc*")))) (pop-to-buffer (current-buffer)) (vc-exec-after @@ -2485,7 +2554,7 @@ If FOCUS-REV is non-nil, leave the point at that revision." "Return a string with all log entries stored in BACKEND for FILE." (if (vc-find-backend-function backend 'print-log) (with-current-buffer "*vc*" - (vc-call print-log file) + (vc-call print-log (list file)) (vc-call wash-log file) (buffer-string)))) @@ -2510,7 +2579,7 @@ it if their logs are not in RCS format." (delete-region (match-beginning 0) (match-end 0))))) ;;;###autoload -(defun vc-revert-buffer () +(defun vc-revert () "Revert the current buffer's file to the version it was based on. This asks for confirmation if the buffer contents are not identical to that version. This function does not automatically pick up newer @@ -2569,7 +2638,7 @@ the current branch are merged into the working file." (if (eq (vc-state file) 'edited) (error (substitute-command-keys - "File is locked--type \\[vc-revert-buffer] to discard changes")) + "File is locked--type \\[vc-revert] to discard changes")) (error (substitute-command-keys "Unexpected file state (%s)--type \\[vc-next-action] to correct") @@ -2635,21 +2704,20 @@ return its name; otherwise return nil." (vc-resynch-buffer file t t)) ;;;###autoload -(defun vc-cancel-version (norevert) - "Get rid of most recently checked in version of this file. -A prefix argument NOREVERT means do not revert the buffer afterwards." +(defun vc-rollback () + "Get rid of most recently checked in version of this file." (interactive "P") (vc-ensure-vc-buffer) (let* ((file buffer-file-name) (backend (vc-backend file)) (target (vc-workfile-version file))) (cond - ((not (vc-find-backend-function backend 'cancel-version)) + ((not (vc-find-backend-function backend 'rollback)) (error "Sorry, canceling versions is not supported under %s" backend)) ((not (vc-call latest-on-branch-p file)) (error "This is not the latest version; VC cannot cancel it")) ((not (vc-up-to-date-p file)) - (error "%s" (substitute-command-keys "File is not up to date; use \\[vc-revert-buffer] to discard changes")))) + (error "%s" (substitute-command-keys "File is not up to date; use \\[vc-revert] to discard changes")))) (if (null (yes-or-no-p (format "Remove version %s from master? " target))) (error "Aborted") (setq norevert (or norevert (not @@ -2658,7 +2726,7 @@ A prefix argument NOREVERT means do not revert the buffer afterwards." (message "Removing last change from %s..." file) (with-vc-properties file - (vc-call cancel-version file norevert) + (vc-call rollback (list file)) `((vc-state . ,(if norevert 'edited 'up-to-date)) (vc-checkout-time . ,(if norevert 0 @@ -2922,7 +2990,11 @@ log entries should be gathered." (vc-call-backend (vc-responsible-backend default-directory) 'update-changelog args)) -(defun vc-default-update-changelog (backend files) +(defalias 'vc-cvs-update-changelog 'vc-update-changelog-rcs2log) +(defalias 'vc-rcs-update-changelog 'vc-update-changelog-rcs2log) +;; FIXME: This should probably be moved to vc-rcs.el and replaced in +;; vc-cvs.el by code using cvs2cl. +(defun vc-update-changelog-rcs2log (files) "Default implementation of update-changelog. Uses `rcs2log' which only works for RCS and CVS." ;; FIXME: We (c|sh)ould add support for cvs2cl @@ -2963,9 +3035,7 @@ Uses `rcs2log' which only works for RCS and CVS." (mapcar (lambda (f) (file-relative-name - (if (file-name-absolute-p f) - f - (concat odefault f)))) + (expand-file-name f odefault))) files))) "done" (pop-to-buffer (get-buffer-create "*vc*")) @@ -3033,13 +3103,13 @@ cover the range from the oldest annotation to the newest." ;; Run through this file and find the oldest and newest dates annotated. (save-excursion (goto-char (point-min)) - (while (setq date (prog1 (vc-call-backend vc-annotate-backend - 'annotate-time) - (forward-line 1))) - (if (> date newest) - (setq newest date)) - (if (< date oldest) - (setq oldest date)))) + (while (not (eobp)) + (when (setq date (vc-call-backend vc-annotate-backend 'annotate-time)) + (if (> date newest) + (setq newest date)) + (if (< date oldest) + (setq oldest date))) + (forward-line 1))) (vc-annotate-display (/ (- (if full newest current) oldest) (vc-annotate-oldest-in-map vc-annotate-color-map)) @@ -3104,9 +3174,9 @@ use; you may override this using the second optional arg MODE." (vc-annotate-display-default (or vc-annotate-ratio 1.0))) ;; One of the auto-scaling modes ((eq vc-annotate-display-mode 'scale) - (vc-annotate-display-autoscale)) + (vc-exec-after `(vc-annotate-display-autoscale))) ((eq vc-annotate-display-mode 'fullscale) - (vc-annotate-display-autoscale t)) + (vc-exec-after `(vc-annotate-display-autoscale t))) ((numberp vc-annotate-display-mode) ; A fixed number of days lookback (vc-annotate-display-default (/ vc-annotate-display-mode @@ -3183,9 +3253,13 @@ colors. `vc-annotate-background' specifies the background color." (set (make-local-variable 'vc-annotate-parent-rev) rev) (set (make-local-variable 'vc-annotate-parent-display-mode) display-mode))) - (when current-line - (goto-line current-line temp-buffer-name)) - (message "Annotating... done"))) + + (vc-exec-after + `(progn + (when ,current-line + (goto-line ,current-line ,temp-buffer-name)) + (unless (active-minibuffer-window) + (message "Annotating... done")))))) (defun vc-annotate-prev-version (prefix) "Visit the annotation of the version previous to this one. @@ -3360,30 +3434,30 @@ The annotations are relative to the current time, unless overridden by OFFSET." (font-lock-mode 1)) (defun vc-annotate-lines (limit) - (let (difference) - (while (and (< (point) limit) - (setq difference (vc-annotate-difference vc-annotate-offset))) - (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map) - (cons nil vc-annotate-very-old-color))) - ;; substring from index 1 to remove any leading `#' in the name - (face-name (concat "vc-annotate-face-" - (if (string-equal - (substring (cdr color) 0 1) "#") - (substring (cdr color) 1) - (cdr color)))) - ;; Make the face if not done. - (face (or (intern-soft face-name) - (let ((tmp-face (make-face (intern face-name)))) - (set-face-foreground tmp-face (cdr color)) - (if vc-annotate-background - (set-face-background tmp-face - vc-annotate-background)) - tmp-face))) ; Return the face - (point (point))) - (forward-line 1) - (put-text-property point (point) 'face face))) - ;; Pretend to font-lock there were no matches. - nil)) + (while (< (point) limit) + (let ((difference (vc-annotate-difference vc-annotate-offset)) + (start (point)) + (end (progn (forward-line 1) (point)))) + (when difference + (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map) + (cons nil vc-annotate-very-old-color))) + ;; substring from index 1 to remove any leading `#' in the name + (face-name (concat "vc-annotate-face-" + (if (string-equal + (substring (cdr color) 0 1) "#") + (substring (cdr color) 1) + (cdr color)))) + ;; Make the face if not done. + (face (or (intern-soft face-name) + (let ((tmp-face (make-face (intern face-name)))) + (set-face-foreground tmp-face (cdr color)) + (if vc-annotate-background + (set-face-background tmp-face + vc-annotate-background)) + tmp-face)))) ; Return the face + (put-text-property start end 'face face))))) + ;; Pretend to font-lock there were no matches. + nil) ;; Collect back-end-dependent stuff here @@ -3423,6 +3497,7 @@ The annotations are relative to the current time, unless overridden by OFFSET." (defun vc-file-tree-walk (dirname func &rest args) "Walk recursively through DIRNAME. Invoke FUNC f ARGS on each VC-managed file f underneath it." + ;; FIXME: Kill this function. (vc-file-tree-walk-internal (expand-file-name dirname) func args) (message "Traversing directory %s...done" dirname)) @@ -3433,13 +3508,13 @@ Invoke FUNC f ARGS on each VC-managed file f underneath it." (let ((dir (file-name-as-directory file))) (mapcar (lambda (f) (or - (string-equal f ".") - (string-equal f "..") - (member f vc-directory-exclusion-list) - (let ((dirf (expand-file-name f dir))) - (or - (file-symlink-p dirf);; Avoid possible loops - (vc-file-tree-walk-internal dirf func args))))) + (string-equal f ".") + (string-equal f "..") + (member f vc-directory-exclusion-list) + (let ((dirf (expand-file-name f dir))) + (or + (file-symlink-p dirf) ;; Avoid possible loops. + (vc-file-tree-walk-internal dirf func args))))) (directory-files dir))))) (provide 'vc) |