aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDan Nicolaescu2008-04-21 05:11:56 +0000
committerDan Nicolaescu2008-04-21 05:11:56 +0000
commitb54462764d27d8dfa43ddd39786cf352fc736d6a (patch)
treea86dfea48b238951a3e12c6344b5cfaeb9e4347a
parent61acee99020a65f7d5875d8b338199f16e472095 (diff)
downloademacs-b54462764d27d8dfa43ddd39786cf352fc736d6a.tar.gz
emacs-b54462764d27d8dfa43ddd39786cf352fc736d6a.zip
* vc-hooks.el (vc-insert-file, vc-state, vc-working-revision)
(vc-check-master-templates, vc-file-not-found-hook) (vc-kill-buffer-hook): * vc.el (vc-process-sentinel, vc-exec-after, vc-do-command) (vc-find-position-by-context, vc-buffer-context) (vc-restore-buffer-context, vc-responsible-backend) (vc-expand-dirs, vc-ensure-vc-buffer, vc-buffer-sync) (vc-next-action, vc-register, vc-register-with, vc-steal-lock) (vc-finish-logentry, vc-coding-system-for-diff, vc-switches) (vc-version-diff, vc-diff, vc-insert-headers) (vc-dired-buffers-for-dir, vc-dired-resynch-file) (vc-snapshot-precondition, vc-create-snapshot, vc-print-log) (vc-revert, vc-rollback, vc-version-backup-file) (vc-rename-master, vc-delete-file, vc-rename-file) (vc-branch-part, vc-default-retrieve-snapshot) (vc-annotate-display-autoscale, vc-annotate-display-select) (vc-annotate, vc-annotate-warp-revision, vc-annotate-difference) (vc-annotate-lines, vc-file-tree-walk-internal): Use when instead of if. (vc-dir-update): Handle directories. (vc-default-status-printer): Simplify.
-rw-r--r--lisp/ChangeLog21
-rw-r--r--lisp/vc-hooks.el46
-rw-r--r--lisp/vc.el508
3 files changed, 335 insertions, 240 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a79959ef904..2445d554417 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,26 @@
12008-04-21 Dan Nicolaescu <dann@ics.uci.edu> 12008-04-21 Dan Nicolaescu <dann@ics.uci.edu>
2 2
3 * vc-hooks.el (vc-insert-file, vc-state, vc-working-revision)
4 (vc-check-master-templates, vc-file-not-found-hook)
5 (vc-kill-buffer-hook):
6 * vc.el (vc-process-sentinel, vc-exec-after, vc-do-command)
7 (vc-find-position-by-context, vc-buffer-context)
8 (vc-restore-buffer-context, vc-responsible-backend)
9 (vc-expand-dirs, vc-ensure-vc-buffer, vc-buffer-sync)
10 (vc-next-action, vc-register, vc-register-with, vc-steal-lock)
11 (vc-finish-logentry, vc-coding-system-for-diff, vc-switches)
12 (vc-version-diff, vc-diff, vc-insert-headers)
13 (vc-dired-buffers-for-dir, vc-dired-resynch-file)
14 (vc-snapshot-precondition, vc-create-snapshot, vc-print-log)
15 (vc-revert, vc-rollback, vc-version-backup-file)
16 (vc-rename-master, vc-delete-file, vc-rename-file)
17 (vc-branch-part, vc-default-retrieve-snapshot)
18 (vc-annotate-display-autoscale, vc-annotate-display-select)
19 (vc-annotate, vc-annotate-warp-revision, vc-annotate-difference)
20 (vc-annotate-lines, vc-file-tree-walk-internal): Use when instead of if.
21 (vc-dir-update): Handle directories.
22 (vc-default-status-printer): Simplify.
23
3 * progmodes/asm-mode.el (asm-mode-map): 24 * progmodes/asm-mode.el (asm-mode-map):
4 * progmodes/hideif.el (hide-ifdef-mode-menu): Add :help. 25 * progmodes/hideif.el (hide-ifdef-mode-menu): Add :help.
5 26
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index e6956c80c75..7d2a4a946ac 100644
--- a/lisp/vc-hooks.el
+++ b/lisp/vc-hooks.el
@@ -309,15 +309,15 @@ non-nil if FILE exists and its contents were successfully inserted."
309 (when (file-exists-p file) 309 (when (file-exists-p file)
310 (if (not limit) 310 (if (not limit)
311 (insert-file-contents file) 311 (insert-file-contents file)
312 (if (not blocksize) (setq blocksize 8192)) 312 (unless blocksize (setq blocksize 8192))
313 (let ((filepos 0)) 313 (let ((filepos 0))
314 (while 314 (while
315 (and (< 0 (cadr (insert-file-contents 315 (and (< 0 (cadr (insert-file-contents
316 file nil filepos (incf filepos blocksize)))) 316 file nil filepos (incf filepos blocksize))))
317 (progn (beginning-of-line) 317 (progn (beginning-of-line)
318 (let ((pos (re-search-forward limit nil 'move))) 318 (let ((pos (re-search-forward limit nil 'move)))
319 (if pos (delete-region (match-beginning 0) 319 (when pos (delete-region (match-beginning 0)
320 (point-max))) 320 (point-max)))
321 (not pos))))))) 321 (not pos)))))))
322 (set-buffer-modified-p nil) 322 (set-buffer-modified-p nil)
323 t)) 323 t))
@@ -549,9 +549,9 @@ status of this file.
549 ;; - `removed' 549 ;; - `removed'
550 ;; - `copied' and `moved' (might be handled by `removed' and `added') 550 ;; - `copied' and `moved' (might be handled by `removed' and `added')
551 (or (vc-file-getprop file 'vc-state) 551 (or (vc-file-getprop file 'vc-state)
552 (if (and (> (length file) 0) (vc-backend file)) 552 (when (and (> (length file) 0) (vc-backend file))
553 (vc-file-setprop file 'vc-state 553 (vc-file-setprop file 'vc-state
554 (vc-call state-heuristic file))))) 554 (vc-call state-heuristic file)))))
555 555
556(defun vc-recompute-state (file) 556(defun vc-recompute-state (file)
557 "Recompute the version control state of FILE, and return it. 557 "Recompute the version control state of FILE, and return it.
@@ -604,9 +604,10 @@ Return non-nil if FILE is unchanged."
604 "Return the repository version from which FILE was checked out. 604 "Return the repository version from which FILE was checked out.
605If FILE is not registered, this function always returns nil." 605If FILE is not registered, this function always returns nil."
606 (or (vc-file-getprop file 'vc-working-revision) 606 (or (vc-file-getprop file 'vc-working-revision)
607 (if (vc-backend file) 607 (when (vc-backend file)
608 (vc-file-setprop file 'vc-working-revision 608 (vc-file-setprop file 'vc-working-revision
609 (vc-call working-revision file))))) 609 (vc-call working-revision file)))))
610
610;; Backward compatibility. 611;; Backward compatibility.
611(define-obsolete-function-alias 612(define-obsolete-function-alias
612 'vc-workfile-version 'vc-working-revision "23.1") 613 'vc-workfile-version 'vc-working-revision "23.1")
@@ -668,17 +669,17 @@ this function."
668 (mapcar 669 (mapcar
669 (lambda (s) 670 (lambda (s)
670 (let ((trial (vc-possible-master s dirname basename))) 671 (let ((trial (vc-possible-master s dirname basename)))
671 (if (and trial (file-exists-p trial) 672 (when (and trial (file-exists-p trial)
672 ;; Make sure the file we found with name 673 ;; Make sure the file we found with name
673 ;; TRIAL is not the source file itself. 674 ;; TRIAL is not the source file itself.
674 ;; That can happen with RCS-style names if 675 ;; That can happen with RCS-style names if
675 ;; the file name is truncated (e.g. to 14 676 ;; the file name is truncated (e.g. to 14
676 ;; chars). See if either directory or 677 ;; chars). See if either directory or
677 ;; attributes differ. 678 ;; attributes differ.
678 (or (not (string= dirname 679 (or (not (string= dirname
679 (file-name-directory trial))) 680 (file-name-directory trial)))
680 (not (equal (file-attributes file) 681 (not (equal (file-attributes file)
681 (file-attributes trial))))) 682 (file-attributes trial)))))
682 (throw 'found trial)))) 683 (throw 'found trial))))
683 templates)))) 684 templates))))
684 685
@@ -960,7 +961,7 @@ Used in `find-file-not-found-functions'."
960 ;; from a previous visit. 961 ;; from a previous visit.
961 (vc-file-clearprops buffer-file-name) 962 (vc-file-clearprops buffer-file-name)
962 (let ((backend (vc-backend buffer-file-name))) 963 (let ((backend (vc-backend buffer-file-name)))
963 (if backend (vc-call-backend backend 'find-file-not-found-hook)))) 964 (when backend (vc-call-backend backend 'find-file-not-found-hook))))
964 965
965(defun vc-default-find-file-not-found-hook (backend) 966(defun vc-default-find-file-not-found-hook (backend)
966 ;; This used to do what vc-rcs-find-file-not-found-hook does, but it only 967 ;; This used to do what vc-rcs-find-file-not-found-hook does, but it only
@@ -971,8 +972,7 @@ Used in `find-file-not-found-functions'."
971 972
972(defun vc-kill-buffer-hook () 973(defun vc-kill-buffer-hook ()
973 "Discard VC info about a file when we kill its buffer." 974 "Discard VC info about a file when we kill its buffer."
974 (if buffer-file-name 975 (when buffer-file-name (vc-file-clearprops buffer-file-name)))
975 (vc-file-clearprops buffer-file-name)))
976 976
977(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook) 977(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook)
978 978
diff --git a/lisp/vc.el b/lisp/vc.el
index 377661065f7..8fd89a0721a 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -668,10 +668,10 @@
668 (require 'dired) ; for dired-map-over-marks macro 668 (require 'dired) ; for dired-map-over-marks macro
669 (require 'dired-aux)) ; for dired-kill-{line,tree} 669 (require 'dired-aux)) ; for dired-kill-{line,tree}
670 670
671(if (not (assoc 'vc-parent-buffer minor-mode-alist)) 671(unless (assoc 'vc-parent-buffer minor-mode-alist)
672 (setq minor-mode-alist 672 (setq minor-mode-alist
673 (cons '(vc-parent-buffer vc-parent-buffer-name) 673 (cons '(vc-parent-buffer vc-parent-buffer-name)
674 minor-mode-alist))) 674 minor-mode-alist)))
675 675
676;; General customization 676;; General customization
677 677
@@ -1078,7 +1078,7 @@ BUF defaults to \"*vc*\", can be a string and will be created if necessary."
1078 ;; Impatient users sometime kill "slow" buffers; check liveness 1078 ;; Impatient users sometime kill "slow" buffers; check liveness
1079 ;; to avoid "error in process sentinel: Selecting deleted buffer". 1079 ;; to avoid "error in process sentinel: Selecting deleted buffer".
1080 (when (buffer-live-p buf) 1080 (when (buffer-live-p buf)
1081 (if previous (funcall previous p s)) 1081 (when previous (funcall previous p s))
1082 (with-current-buffer buf 1082 (with-current-buffer buf
1083 (setq mode-line-process 1083 (setq mode-line-process
1084 (let ((status (process-status p))) 1084 (let ((status (process-status p)))
@@ -1099,12 +1099,12 @@ BUF defaults to \"*vc*\", can be a string and will be created if necessary."
1099 ;; difficult to achieve. 1099 ;; difficult to achieve.
1100 (vc-exec-after cmd)))) 1100 (vc-exec-after cmd))))
1101 ;; But sometimes the sentinels really want to move point. 1101 ;; But sometimes the sentinels really want to move point.
1102 (if vc-sentinel-movepoint 1102 (when vc-sentinel-movepoint
1103 (let ((win (get-buffer-window (current-buffer) 0))) 1103 (let ((win (get-buffer-window (current-buffer) 0)))
1104 (if (not win) 1104 (if (not win)
1105 (goto-char vc-sentinel-movepoint) 1105 (goto-char vc-sentinel-movepoint)
1106 (with-selected-window win 1106 (with-selected-window win
1107 (goto-char vc-sentinel-movepoint)))))))))) 1107 (goto-char vc-sentinel-movepoint))))))))))
1108 1108
1109(defun vc-set-mode-line-busy-indicator () 1109(defun vc-set-mode-line-busy-indicator ()
1110 (setq mode-line-process 1110 (setq mode-line-process
@@ -1126,7 +1126,7 @@ Else, add CODE to the process' sentinel."
1126 ;; anyway. -- cyd 1126 ;; anyway. -- cyd
1127 ((or (null proc) (eq (process-status proc) 'exit)) 1127 ((or (null proc) (eq (process-status proc) 'exit))
1128 ;; Make sure we've read the process's output before going further. 1128 ;; Make sure we've read the process's output before going further.
1129 (if proc (accept-process-output proc)) 1129 (when proc (accept-process-output proc))
1130 (eval code)) 1130 (eval code))
1131 ;; If a process is running, add CODE to the sentinel 1131 ;; If a process is running, add CODE to the sentinel
1132 ((eq (process-status proc) 'run) 1132 ((eq (process-status proc) 'run)
@@ -1212,9 +1212,9 @@ that is inserted into the command line before the filename."
1212 (mapconcat 'identity vc-path path-separator)) 1212 (mapconcat 'identity vc-path path-separator))
1213 process-environment)) 1213 process-environment))
1214 (w32-quote-process-args t)) 1214 (w32-quote-process-args t))
1215 (if (and (eq okstatus 'async) (file-remote-p default-directory)) 1215 (when (and (eq okstatus 'async) (file-remote-p default-directory))
1216 ;; start-process does not support remote execution 1216 ;; start-process does not support remote execution
1217 (setq okstatus nil)) 1217 (setq okstatus nil))
1218 (if (eq okstatus 'async) 1218 (if (eq okstatus 'async)
1219 ;; Run asynchronously. 1219 ;; Run asynchronously.
1220 (let ((proc 1220 (let ((proc
@@ -1229,8 +1229,8 @@ that is inserted into the command line before the filename."
1229 `(if vc-command-messages 1229 `(if vc-command-messages
1230 (message "Running %s in background... done" ',full-command)))) 1230 (message "Running %s in background... done" ',full-command))))
1231 ;; Run synchrously 1231 ;; Run synchrously
1232 (if vc-command-messages 1232 (when vc-command-messages
1233 (message "Running %s in foreground..." full-command)) 1233 (message "Running %s in foreground..." full-command))
1234 (let ((buffer-undo-list t)) 1234 (let ((buffer-undo-list t))
1235 (setq status (apply 'process-file command nil t nil squeezed))) 1235 (setq status (apply 'process-file command nil t nil squeezed)))
1236 (when (and (not (eq t okstatus)) 1236 (when (and (not (eq t okstatus))
@@ -1270,7 +1270,7 @@ If CONTEXT cannot be found, return nil."
1270 (point-max) 1270 (point-max)
1271 (save-excursion 1271 (save-excursion
1272 (let ((diff (- (nth 1 context) (buffer-size)))) 1272 (let ((diff (- (nth 1 context) (buffer-size))))
1273 (if (< diff 0) (setq diff (- diff))) 1273 (when (< diff 0) (setq diff (- diff)))
1274 (goto-char (nth 0 context)) 1274 (goto-char (nth 0 context))
1275 (if (or (search-forward context-string nil t) 1275 (if (or (search-forward context-string nil t)
1276 ;; Can't use search-backward since the match may continue 1276 ;; Can't use search-backward since the match may continue
@@ -1296,8 +1296,8 @@ If CONTEXT cannot be found, return nil."
1296Used by `vc-restore-buffer-context' to later restore the context." 1296Used by `vc-restore-buffer-context' to later restore the context."
1297 (let ((point-context (vc-position-context (point))) 1297 (let ((point-context (vc-position-context (point)))
1298 ;; Use mark-marker to avoid confusion in transient-mark-mode. 1298 ;; Use mark-marker to avoid confusion in transient-mark-mode.
1299 (mark-context (if (eq (marker-buffer (mark-marker)) (current-buffer)) 1299 (mark-context (when (eq (marker-buffer (mark-marker)) (current-buffer))
1300 (vc-position-context (mark-marker)))) 1300 (vc-position-context (mark-marker))))
1301 ;; Make the right thing happen in transient-mark-mode. 1301 ;; Make the right thing happen in transient-mark-mode.
1302 (mark-active nil) 1302 (mark-active nil)
1303 ;; The new compilation code does not use compilation-error-list any 1303 ;; The new compilation code does not use compilation-error-list any
@@ -1359,12 +1359,12 @@ CONTEXT is that which `vc-buffer-context' returns."
1359 ;; if necessary, restore point and mark 1359 ;; if necessary, restore point and mark
1360 (if (not (vc-context-matches-p (point) point-context)) 1360 (if (not (vc-context-matches-p (point) point-context))
1361 (let ((new-point (vc-find-position-by-context point-context))) 1361 (let ((new-point (vc-find-position-by-context point-context)))
1362 (if new-point (goto-char new-point)))) 1362 (when new-point (goto-char new-point))))
1363 (and mark-active 1363 (and mark-active
1364 mark-context 1364 mark-context
1365 (not (vc-context-matches-p (mark) mark-context)) 1365 (not (vc-context-matches-p (mark) mark-context))
1366 (let ((new-mark (vc-find-position-by-context mark-context))) 1366 (let ((new-mark (vc-find-position-by-context mark-context)))
1367 (if new-mark (set-mark new-mark)))))) 1367 (when new-mark (set-mark new-mark))))))
1368 1368
1369;;; Code for deducing what fileset and backend to assume 1369;;; Code for deducing what fileset and backend to assume
1370 1370
@@ -1383,8 +1383,8 @@ If REGISTER is non-nil, return the first responsible backend under
1383which FILE is not yet registered. If there is no such backend, return 1383which FILE is not yet registered. If there is no such backend, return
1384the first backend under which FILE is not yet registered, but could 1384the first backend under which FILE is not yet registered, but could
1385be registered." 1385be registered."
1386 (if (not vc-handled-backends) 1386 (when (not vc-handled-backends)
1387 (error "No handled backends")) 1387 (error "No handled backends"))
1388 (or (and (not (file-directory-p file)) (not register) (vc-backend file)) 1388 (or (and (not (file-directory-p file)) (not register) (vc-backend file))
1389 (catch 'found 1389 (catch 'found
1390 ;; First try: find a responsible backend. If this is for registration, 1390 ;; First try: find a responsible backend. If this is for registration,
@@ -1413,7 +1413,7 @@ Only files already under version control are noticed."
1413 (let ((flattened '())) 1413 (let ((flattened '()))
1414 (dolist (node file-or-dir-list) 1414 (dolist (node file-or-dir-list)
1415 (vc-file-tree-walk 1415 (vc-file-tree-walk
1416 node (lambda (f) (if (vc-backend f) (push f flattened))))) 1416 node (lambda (f) (when (vc-backend f) (push f flattened)))))
1417 (nreverse flattened))) 1417 (nreverse flattened)))
1418 1418
1419(defun vc-deduce-fileset (&optional allow-directory-wildcard allow-unregistered) 1419(defun vc-deduce-fileset (&optional allow-directory-wildcard allow-unregistered)
@@ -1483,8 +1483,8 @@ Otherwise, throw an error."
1483 (set-buffer vc-parent-buffer)) 1483 (set-buffer vc-parent-buffer))
1484 (if (not buffer-file-name) 1484 (if (not buffer-file-name)
1485 (error "Buffer %s is not associated with a file" (buffer-name)) 1485 (error "Buffer %s is not associated with a file" (buffer-name))
1486 (if (not (vc-backend buffer-file-name)) 1486 (unless (vc-backend buffer-file-name)
1487 (error "File %s is not under version control" buffer-file-name)))))) 1487 (error "File %s is not under version control" buffer-file-name))))))
1488 1488
1489;;; Support for the C-x v v command. This is where all the single-file-oriented 1489;;; Support for the C-x v v command. This is where all the single-file-oriented
1490;;; code from before the fileset rewrite lives. 1490;;; code from before the fileset rewrite lives.
@@ -1515,12 +1515,12 @@ ARG and NO-CONFIRM are passed on to `revert-buffer'."
1515(defun vc-buffer-sync (&optional not-urgent) 1515(defun vc-buffer-sync (&optional not-urgent)
1516 "Make sure the current buffer and its working file are in sync. 1516 "Make sure the current buffer and its working file are in sync.
1517NOT-URGENT means it is ok to continue if the user says not to save." 1517NOT-URGENT means it is ok to continue if the user says not to save."
1518 (if (buffer-modified-p) 1518 (when (buffer-modified-p)
1519 (if (or vc-suppress-confirm 1519 (if (or vc-suppress-confirm
1520 (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name)))) 1520 (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name))))
1521 (save-buffer) 1521 (save-buffer)
1522 (unless not-urgent 1522 (unless not-urgent
1523 (error "Aborted"))))) 1523 (error "Aborted")))))
1524 1524
1525(defvar vc-dired-window-configuration) 1525(defvar vc-dired-window-configuration)
1526 1526
@@ -1705,8 +1705,8 @@ merge in the changes into your working copy."
1705 ;; unlocked-changes 1705 ;; unlocked-changes
1706 ((eq state 'unlocked-changes) 1706 ((eq state 'unlocked-changes)
1707 (dolist (file files) 1707 (dolist (file files)
1708 (if (not (equal buffer-file-name file)) 1708 (when (not (equal buffer-file-name file))
1709 (find-file-other-window file)) 1709 (find-file-other-window file))
1710 (if (save-window-excursion 1710 (if (save-window-excursion
1711 (vc-diff-internal nil (list file) (vc-working-revision file) nil) 1711 (vc-diff-internal nil (list file) (vc-working-revision file) nil)
1712 (goto-char (point-min)) 1712 (goto-char (point-min))
@@ -1768,10 +1768,10 @@ first backend that could register the file is used."
1768 ;; does not exist yet, even though buffer-modified-p is nil. 1768 ;; does not exist yet, even though buffer-modified-p is nil.
1769 (when bname 1769 (when bname
1770 (with-current-buffer bname 1770 (with-current-buffer bname
1771 (if (and (not (buffer-modified-p)) 1771 (when (and (not (buffer-modified-p))
1772 (zerop (buffer-size)) 1772 (zerop (buffer-size))
1773 (not (file-exists-p buffer-file-name))) 1773 (not (file-exists-p buffer-file-name)))
1774 (set-buffer-modified-p t)) 1774 (set-buffer-modified-p t))
1775 (vc-buffer-sync))) 1775 (vc-buffer-sync)))
1776 (vc-start-entry (list fname) 1776 (vc-start-entry (list fname)
1777 (if set-revision 1777 (if set-revision
@@ -1797,8 +1797,8 @@ first backend that could register the file is used."
1797(defun vc-register-with (backend) 1797(defun vc-register-with (backend)
1798 "Register the current file with a specified back end." 1798 "Register the current file with a specified back end."
1799 (interactive "SBackend: ") 1799 (interactive "SBackend: ")
1800 (if (not (member backend vc-handled-backends)) 1800 (when (not (member backend vc-handled-backends))
1801 (error "Unknown back end.")) 1801 (error "Unknown back end."))
1802 (let ((vc-handled-backends (list backend))) 1802 (let ((vc-handled-backends (list backend)))
1803 (call-interactively 'vc-register))) 1803 (call-interactively 'vc-register)))
1804 1804
@@ -1931,9 +1931,9 @@ After check-out, runs the normal hook `vc-checkout-hook'."
1931 (if rev 1931 (if rev
1932 (setq file-description (format "%s:%s" file rev)) 1932 (setq file-description (format "%s:%s" file rev))
1933 (setq file-description file)) 1933 (setq file-description file))
1934 (if (not (yes-or-no-p (format "Steal the lock on %s from %s? " 1934 (when (not (yes-or-no-p (format "Steal the lock on %s from %s? "
1935 file-description owner))) 1935 file-description owner)))
1936 (error "Steal canceled")) 1936 (error "Steal canceled"))
1937 (message "Stealing lock on %s..." file) 1937 (message "Stealing lock on %s..." file)
1938 (with-vc-properties 1938 (with-vc-properties
1939 (list file) 1939 (list file)
@@ -1995,7 +1995,7 @@ the buffer contents as a comment."
1995 ;; Check and record the comment, if any. 1995 ;; Check and record the comment, if any.
1996 (unless nocomment 1996 (unless nocomment
1997 ;; Comment too long? 1997 ;; Comment too long?
1998 (vc-call-backend (or (if vc-log-fileset (vc-backend vc-log-fileset)) 1998 (vc-call-backend (or (when vc-log-fileset (vc-backend vc-log-fileset))
1999 (vc-responsible-backend default-directory)) 1999 (vc-responsible-backend default-directory))
2000 'logentry-check) 2000 'logentry-check)
2001 (run-hooks 'vc-logentry-check-hook)) 2001 (run-hooks 'vc-logentry-check-hook))
@@ -2003,8 +2003,8 @@ the buffer contents as a comment."
2003 ;; But not if it is a vc-dired buffer. 2003 ;; But not if it is a vc-dired buffer.
2004 (with-current-buffer vc-parent-buffer 2004 (with-current-buffer vc-parent-buffer
2005 (or vc-dired-mode (eq major-mode 'vc-dir-mode) (vc-buffer-sync))) 2005 (or vc-dired-mode (eq major-mode 'vc-dir-mode) (vc-buffer-sync)))
2006 (if (not vc-log-operation) 2006 (unless vc-log-operation
2007 (error "No log operation is pending")) 2007 (error "No log operation is pending"))
2008 ;; save the parameters held in buffer-local variables 2008 ;; save the parameters held in buffer-local variables
2009 (let ((log-operation vc-log-operation) 2009 (let ((log-operation vc-log-operation)
2010 (log-fileset vc-log-fileset) 2010 (log-fileset vc-log-fileset)
@@ -2031,11 +2031,11 @@ the buffer contents as a comment."
2031 (bury-buffer) 2031 (bury-buffer)
2032 (pop-to-buffer tmp-vc-parent-buffer)))) 2032 (pop-to-buffer tmp-vc-parent-buffer))))
2033 ;; Now make sure we see the expanded headers 2033 ;; Now make sure we see the expanded headers
2034 (if log-fileset 2034 (when log-fileset
2035 (mapc 2035 (mapc
2036 (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t)) 2036 (lambda (file) (vc-resynch-buffer file vc-keep-workfiles t))
2037 log-fileset)) 2037 log-fileset))
2038 (if (or vc-dired-mode (eq major-mode 'vc-dir-mode)) 2038 (when (or vc-dired-mode (eq major-mode 'vc-dir-mode))
2039 (dired-move-to-filename)) 2039 (dired-move-to-filename))
2040 (run-hooks after-hook 'vc-finish-logentry-hook))) 2040 (run-hooks after-hook 'vc-finish-logentry-hook)))
2041 2041
@@ -2066,8 +2066,8 @@ the buffer contents as a comment."
2066 ;; if we already have this file open, 2066 ;; if we already have this file open,
2067 ;; use the buffer's coding system 2067 ;; use the buffer's coding system
2068 (let ((buf (find-buffer-visiting file))) 2068 (let ((buf (find-buffer-visiting file)))
2069 (if buf (with-current-buffer buf 2069 (when buf (with-current-buffer buf
2070 buffer-file-coding-system))) 2070 buffer-file-coding-system)))
2071 ;; otherwise, try to find one based on the file name 2071 ;; otherwise, try to find one based on the file name
2072 (car (find-operation-coding-system 'insert-file-contents file)) 2072 (car (find-operation-coding-system 'insert-file-contents file))
2073 ;; and a final fallback 2073 ;; and a final fallback
@@ -2075,20 +2075,20 @@ the buffer contents as a comment."
2075 2075
2076(defun vc-switches (backend op) 2076(defun vc-switches (backend op)
2077 (let ((switches 2077 (let ((switches
2078 (or (if backend 2078 (or (when backend
2079 (let ((sym (vc-make-backend-sym 2079 (let ((sym (vc-make-backend-sym
2080 backend (intern (concat (symbol-name op) 2080 backend (intern (concat (symbol-name op)
2081 "-switches"))))) 2081 "-switches")))))
2082 (if (boundp sym) (symbol-value sym)))) 2082 (when (boundp sym) (symbol-value sym))))
2083 (let ((sym (intern (format "vc-%s-switches" (symbol-name op))))) 2083 (let ((sym (intern (format "vc-%s-switches" (symbol-name op)))))
2084 (if (boundp sym) (symbol-value sym))) 2084 (when (boundp sym) (symbol-value sym)))
2085 (cond 2085 (cond
2086 ((eq op 'diff) diff-switches))))) 2086 ((eq op 'diff) diff-switches)))))
2087 (if (stringp switches) (list switches) 2087 (if (stringp switches) (list switches)
2088 ;; If not a list, return nil. 2088 ;; If not a list, return nil.
2089 ;; This is so we can set vc-diff-switches to t to override 2089 ;; This is so we can set vc-diff-switches to t to override
2090 ;; any switches in diff-switches. 2090 ;; any switches in diff-switches.
2091 (if (listp switches) switches)))) 2091 (when (listp switches) switches))))
2092 2092
2093;; Old def for compatibility with Emacs-21.[123]. 2093;; Old def for compatibility with Emacs-21.[123].
2094(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff)) 2094(defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff))
@@ -2203,7 +2203,7 @@ returns t if the buffer had changes, nil otherwise."
2203 (t 2203 (t
2204 (setq rev1-default (vc-call previous-revision first 2204 (setq rev1-default (vc-call previous-revision first
2205 (vc-working-revision first))) 2205 (vc-working-revision first)))
2206 (if (string= rev1-default "") (setq rev1-default nil)) 2206 (when (string= rev1-default "") (setq rev1-default nil))
2207 (setq rev2-default (vc-working-revision first)))) 2207 (setq rev2-default (vc-working-revision first))))
2208 ;; construct argument list 2208 ;; construct argument list
2209 (let* ((rev1-prompt (if rev1-default 2209 (let* ((rev1-prompt (if rev1-default
@@ -2220,8 +2220,8 @@ returns t if the buffer had changes, nil otherwise."
2220 (completing-read rev2-prompt completion-table 2220 (completing-read rev2-prompt completion-table
2221 nil nil nil nil rev2-default) 2221 nil nil nil nil rev2-default)
2222 (read-string rev2-prompt nil nil rev2-default)))) 2222 (read-string rev2-prompt nil nil rev2-default))))
2223 (if (string= rev1 "") (setq rev1 nil)) 2223 (when (string= rev1 "") (setq rev1 nil))
2224 (if (string= rev2 "") (setq rev2 nil)) 2224 (when (string= rev2 "") (setq rev2 nil))
2225 (list files rev1 rev2)))) 2225 (list files rev1 rev2))))
2226 (if (and (not rev1) rev2) 2226 (if (and (not rev1) rev2)
2227 (error "Not a valid revision range.")) 2227 (error "Not a valid revision range."))
@@ -2250,7 +2250,7 @@ saving the buffer."
2250 (if historic 2250 (if historic
2251 (call-interactively 'vc-version-diff) 2251 (call-interactively 'vc-version-diff)
2252 (let* ((files (vc-deduce-fileset t))) 2252 (let* ((files (vc-deduce-fileset t)))
2253 (if buffer-file-name (vc-buffer-sync not-urgent)) 2253 (when buffer-file-name (vc-buffer-sync not-urgent))
2254 (vc-diff-internal t files nil nil (interactive-p))))) 2254 (vc-diff-internal t files nil nil (interactive-p)))))
2255 2255
2256 2256
@@ -2320,21 +2320,21 @@ the variable `vc-BACKEND-header'."
2320 (save-excursion 2320 (save-excursion
2321 (save-restriction 2321 (save-restriction
2322 (widen) 2322 (widen)
2323 (if (or (not (vc-check-headers)) 2323 (when (or (not (vc-check-headers))
2324 (y-or-n-p "Version headers already exist. Insert another set? ")) 2324 (y-or-n-p "Version headers already exist. Insert another set? "))
2325 (let* ((delims (cdr (assq major-mode vc-comment-alist))) 2325 (let* ((delims (cdr (assq major-mode vc-comment-alist)))
2326 (comment-start-vc (or (car delims) comment-start "#")) 2326 (comment-start-vc (or (car delims) comment-start "#"))
2327 (comment-end-vc (or (car (cdr delims)) comment-end "")) 2327 (comment-end-vc (or (car (cdr delims)) comment-end ""))
2328 (hdsym (vc-make-backend-sym (vc-backend buffer-file-name) 2328 (hdsym (vc-make-backend-sym (vc-backend buffer-file-name)
2329 'header)) 2329 'header))
2330 (hdstrings (and (boundp hdsym) (symbol-value hdsym)))) 2330 (hdstrings (and (boundp hdsym) (symbol-value hdsym))))
2331 (dolist (s hdstrings) 2331 (dolist (s hdstrings)
2332 (insert comment-start-vc "\t" s "\t" 2332 (insert comment-start-vc "\t" s "\t"
2333 comment-end-vc "\n")) 2333 comment-end-vc "\n"))
2334 (if vc-static-header-alist 2334 (when vc-static-header-alist
2335 (dolist (f vc-static-header-alist) 2335 (dolist (f vc-static-header-alist)
2336 (if (string-match (car f) buffer-file-name) 2336 (when (string-match (car f) buffer-file-name)
2337 (insert (format (cdr f) (car hdstrings))))))))))) 2337 (insert (format (cdr f) (car hdstrings)))))))))))
2338 2338
2339(defun vc-clear-headers (&optional file) 2339(defun vc-clear-headers (&optional file)
2340 "Clear all version headers in the current buffer (or FILE). 2340 "Clear all version headers in the current buffer (or FILE).
@@ -2659,8 +2659,8 @@ Called by dired after any portion of a vc-dired buffer has been read in."
2659 (when (fboundp 'dired-buffers-for-dir) 2659 (when (fboundp 'dired-buffers-for-dir)
2660 (dolist (buffer (dired-buffers-for-dir dir)) 2660 (dolist (buffer (dired-buffers-for-dir dir))
2661 (with-current-buffer buffer 2661 (with-current-buffer buffer
2662 (if vc-dired-mode 2662 (when vc-dired-mode
2663 (push buffer result))))) 2663 (push buffer result)))))
2664 (nreverse result))) 2664 (nreverse result)))
2665 2665
2666(defun vc-dired-resynch-file (file) 2666(defun vc-dired-resynch-file (file)
@@ -2669,11 +2669,11 @@ Called by dired after any portion of a vc-dired buffer has been read in."
2669 (when buffers 2669 (when buffers
2670 (mapcar (lambda (buffer) 2670 (mapcar (lambda (buffer)
2671 (with-current-buffer buffer 2671 (with-current-buffer buffer
2672 (if (dired-goto-file file) 2672 (when (dired-goto-file file)
2673 ;; bind vc-dired-terse-mode to nil so that 2673 ;; bind vc-dired-terse-mode to nil so that
2674 ;; files won't vanish when they are checked in 2674 ;; files won't vanish when they are checked in
2675 (let ((vc-dired-terse-mode nil)) 2675 (let ((vc-dired-terse-mode nil))
2676 (dired-do-redisplay 1))))) 2676 (dired-do-redisplay 1)))))
2677 buffers)))) 2677 buffers))))
2678 2678
2679;;;###autoload 2679;;;###autoload
@@ -2707,7 +2707,7 @@ With prefix arg READ-SWITCHES, specify a value to override
2707 (:type list) ;So we can use `member' on lists of FIs. 2707 (:type list) ;So we can use `member' on lists of FIs.
2708 (:constructor 2708 (:constructor
2709 ;; We could define it as an alias for `list'. 2709 ;; We could define it as an alias for `list'.
2710 vc-dir-create-fileinfo (name state &optional extra marked)) 2710 vc-dir-create-fileinfo (name state &optional extra marked directory))
2711 (:conc-name vc-dir-fileinfo->)) 2711 (:conc-name vc-dir-fileinfo->))
2712 name ;Keep it as first, for `member'. 2712 name ;Keep it as first, for `member'.
2713 state 2713 state
@@ -2717,7 +2717,7 @@ With prefix arg READ-SWITCHES, specify a value to override
2717 ;; To keep track of not updated files during a global refresh 2717 ;; To keep track of not updated files during a global refresh
2718 needs-update 2718 needs-update
2719 ;; To distinguish files and directories. 2719 ;; To distinguish files and directories.
2720 directoryp) 2720 directory)
2721 2721
2722(defvar vc-ewoc nil) 2722(defvar vc-ewoc nil)
2723 2723
@@ -2741,26 +2741,27 @@ specific headers."
2741 2741
2742(defun vc-default-status-printer (backend fileentry) 2742(defun vc-default-status-printer (backend fileentry)
2743 "Pretty print FILEENTRY." 2743 "Pretty print FILEENTRY."
2744 (if (vc-dir-fileinfo->directoryp fileentry) 2744 ;; If you change the layout here, change vc-dir-move-to-goal-column.
2745 (insert " Directory: %s" (vc-dir-fileinfo->name fileentry)) 2745 (let ((state
2746 ;; If you change the layout here, change vc-dir-move-to-goal-column. 2746 (if (vc-dir-fileinfo->directory fileentry)
2747 (let ((state (vc-dir-fileinfo->state fileentry))) 2747 'DIRECTORY
2748 (insert 2748 (vc-dir-fileinfo->state fileentry))))
2749 (propertize 2749 (insert
2750 (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? )) 2750 (propertize
2751 'face 'font-lock-type-face) 2751 (format "%c" (if (vc-dir-fileinfo->marked fileentry) ?* ? ))
2752 " " 2752 'face 'font-lock-type-face)
2753 (propertize 2753 " "
2754 (format "%-20s" state) 2754 (propertize
2755 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face) 2755 (format "%-20s" state)
2756 ((memq state '(missing conflict)) 'font-lock-warning-face) 2756 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
2757 (t 'font-lock-variable-name-face)) 2757 ((memq state '(missing conflict)) 'font-lock-warning-face)
2758 'mouse-face 'highlight) 2758 (t 'font-lock-variable-name-face))
2759 " " 2759 'mouse-face 'highlight)
2760 (propertize 2760 " "
2761 (format "%s" (vc-dir-fileinfo->name fileentry)) 2761 (propertize
2762 'face 'font-lock-function-name-face 2762 (format "%s" (vc-dir-fileinfo->name fileentry))
2763 'mouse-face 'highlight))))) 2763 'face 'font-lock-function-name-face
2764 'mouse-face 'highlight))))
2764 2765
2765(defun vc-dir-printer (fileentry) 2766(defun vc-dir-printer (fileentry)
2766 (let ((backend (vc-responsible-backend default-directory))) 2767 (let ((backend (vc-responsible-backend default-directory)))
@@ -3016,6 +3017,12 @@ specific headers."
3016 3017
3017(put 'vc-dir-mode 'mode-class 'special) 3018(put 'vc-dir-mode 'mode-class 'special)
3018 3019
3020;; t if directories should be shown in vc-dir.
3021;; WORK IN PROGRESS! DO NOT SET this! ONLY set it if you want to help
3022;; write code for this feature. This variable will likely disappear
3023;; when the work is done.
3024(defvar vc-dir-insert-directories t)
3025
3019(defun vc-dir-update (entries buffer &optional noinsert) 3026(defun vc-dir-update (entries buffer &optional noinsert)
3020 "Update BUFFER's ewoc from the list of ENTRIES. 3027 "Update BUFFER's ewoc from the list of ENTRIES.
3021If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." 3028If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
@@ -3036,31 +3043,100 @@ If NOINSERT, ignore elements on ENTRIES which are not in the ewoc."
3036 ((string< dir1 dir2) t) 3043 ((string< dir1 dir2) t)
3037 ((not (string= dir1 dir2)) nil) 3044 ((not (string= dir1 dir2)) nil)
3038 ((string< (car entry1) (car entry2)))))))) 3045 ((string< (car entry1) (car entry2))))))))
3039 (let ((entry (car entries)) 3046 (if (not vc-dir-insert-directories)
3040 (node (ewoc-nth vc-ewoc 0))) 3047 (let ((entry (car entries))
3041 (while (and entry node) 3048 (node (ewoc-nth vc-ewoc 0)))
3042 (let ((entryfile (car entry)) 3049 (while (and entry node)
3043 (nodefile (vc-dir-fileinfo->name (ewoc-data node)))) 3050 (let ((entryfile (car entry))
3044 (cond 3051 (nodefile (vc-dir-fileinfo->name (ewoc-data node))))
3045 ((string-lessp nodefile entryfile) 3052 (cond
3046 (setq node (ewoc-next vc-ewoc node))) 3053 ((string-lessp nodefile entryfile)
3047 ((string-lessp entryfile nodefile) 3054 (setq node (ewoc-next vc-ewoc node)))
3048 (unless noinsert 3055 ((string-lessp entryfile nodefile)
3049 (ewoc-enter-before vc-ewoc node 3056 (unless noinsert
3050 (apply 'vc-dir-create-fileinfo entry))) 3057 (ewoc-enter-before vc-ewoc node
3051 (setq entries (cdr entries) entry (car entries))) 3058 (apply 'vc-dir-create-fileinfo entry)))
3052 (t 3059 (setq entries (cdr entries) entry (car entries)))
3053 (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry)) 3060 (t
3054 (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry)) 3061 (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
3055 (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil) 3062 (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
3056 (ewoc-invalidate vc-ewoc node) 3063 (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
3057 (setq entries (cdr entries) entry (car entries)) 3064 (ewoc-invalidate vc-ewoc node)
3058 (setq node (ewoc-next vc-ewoc node)))))) 3065 (setq entries (cdr entries) entry (car entries))
3059 (unless (or node noinsert) 3066 (setq node (ewoc-next vc-ewoc node))))))
3060 ;; We're past the last node, all remaining entries go to the end. 3067 (unless (or node noinsert)
3061 (while entries 3068 ;; We're past the last node, all remaining entries go to the end.
3062 (ewoc-enter-last vc-ewoc 3069 (while entries
3063 (apply 'vc-dir-create-fileinfo (pop entries)))))))) 3070 (ewoc-enter-last vc-ewoc
3071 (apply 'vc-dir-create-fileinfo (pop entries))))))
3072 ;; Insert directory entries in the right places.
3073 (let ((entry (car entries))
3074 (node (ewoc-nth vc-ewoc 0)))
3075 ;; Insert . if it is not present.
3076 (unless node
3077 (let ((rd (file-relative-name default-directory)))
3078 (ewoc-enter-last
3079 vc-ewoc (vc-dir-create-fileinfo
3080 rd nil nil nil (expand-file-name default-directory))))
3081 (setq node (ewoc-nth vc-ewoc 0)))
3082
3083 (while (and entry node)
3084 (let* ((entryfile (car entry))
3085 (entrydir (file-name-directory (expand-file-name entryfile)))
3086 (nodedir
3087 (or (vc-dir-fileinfo->directory (ewoc-data node))
3088 (file-name-directory
3089 (expand-file-name
3090 (vc-dir-fileinfo->name (ewoc-data node)))))))
3091 (cond
3092 ;; First try to find the directory.
3093 ((string-lessp nodedir entrydir)
3094 (setq node (ewoc-next vc-ewoc node)))
3095 ((string-equal nodedir entrydir)
3096 ;; Found the directory, find the place for the file name.
3097 (let ((nodefile (vc-dir-fileinfo->name (ewoc-data node))))
3098 (cond
3099 ((string-lessp nodefile entryfile)
3100 (setq node (ewoc-next vc-ewoc node)))
3101 ((string-equal nodefile entryfile)
3102 (setf (vc-dir-fileinfo->state (ewoc-data node)) (nth 1 entry))
3103 (setf (vc-dir-fileinfo->extra (ewoc-data node)) (nth 2 entry))
3104 (setf (vc-dir-fileinfo->needs-update (ewoc-data node)) nil)
3105 (ewoc-invalidate vc-ewoc node)
3106 (setq entries (cdr entries) entry (car entries))
3107 (setq node (ewoc-next vc-ewoc node)))
3108 (t
3109 (ewoc-enter-before vc-ewoc node
3110 (apply 'vc-dir-create-fileinfo entry))
3111 (setq entries (cdr entries) entry (car entries))))))
3112 (t
3113 ;; We need to insert a directory node
3114 (let ((rd (file-relative-name entrydir)))
3115 (ewoc-enter-last
3116 vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir)))
3117 ;; Now insert the node itself.
3118 (ewoc-enter-before vc-ewoc node
3119 (apply 'vc-dir-create-fileinfo entry))
3120 (setq entries (cdr entries) entry (car entries))))))
3121 ;; We're past the last node, all remaining entries go to the end.
3122 (unless (or node noinsert)
3123 (let* ((lastnode (ewoc-nth vc-ewoc -1))
3124 (lastdir
3125 (or (vc-dir-fileinfo->directory (ewoc-data lastnode))
3126 (file-name-directory
3127 (expand-file-name
3128 (vc-dir-fileinfo->name (ewoc-data lastnode)))))))
3129 (dolist (entry entries)
3130 (let ((entrydir (file-name-directory (expand-file-name (car entry)))))
3131 ;; Insert a directory node if needed.
3132 (unless (string-equal lastdir entrydir)
3133 (setq lastdir entrydir)
3134 (let ((rd (file-relative-name entrydir)))
3135 (ewoc-enter-last
3136 vc-ewoc (vc-dir-create-fileinfo rd nil nil nil entrydir))))
3137 ;; Now insert the node itself.
3138 (ewoc-enter-last vc-ewoc
3139 (apply 'vc-dir-create-fileinfo entry))))))))))
3064 3140
3065(defun vc-dir-busy () 3141(defun vc-dir-busy ()
3066 (and (buffer-live-p vc-dir-process-buffer) 3142 (and (buffer-live-p vc-dir-process-buffer)
@@ -3385,7 +3461,7 @@ Otherwise, return nil."
3385 dir 3461 dir
3386 (lambda (f) 3462 (lambda (f)
3387 (if (not (vc-up-to-date-p f)) (throw 'vc-locked-example f) 3463 (if (not (vc-up-to-date-p f)) (throw 'vc-locked-example f)
3388 (if (get-file-buffer f) (setq status 'visited))))) 3464 (when (get-file-buffer f) (setq status 'visited)))))
3389 status))) 3465 status)))
3390 3466
3391;;;###autoload 3467;;;###autoload
@@ -3400,7 +3476,7 @@ checked out in that new branch."
3400 (read-string "New snapshot name: ") 3476 (read-string "New snapshot name: ")
3401 current-prefix-arg)) 3477 current-prefix-arg))
3402 (message "Making %s... " (if branchp "branch" "snapshot")) 3478 (message "Making %s... " (if branchp "branch" "snapshot"))
3403 (if (file-directory-p dir) (setq dir (file-name-as-directory dir))) 3479 (when (file-directory-p dir) (setq dir (file-name-as-directory dir)))
3404 (vc-call-backend (vc-responsible-backend dir) 3480 (vc-call-backend (vc-responsible-backend dir)
3405 'create-snapshot dir name branchp) 3481 'create-snapshot dir name branchp)
3406 (message "Making %s... done" (if branchp "branch" "snapshot"))) 3482 (message "Making %s... done" (if branchp "branch" "snapshot")))
@@ -3448,8 +3524,8 @@ If WORKING-REVISION is non-nil, leave the point at that revision."
3448 (delete-char (- (match-end 0) (match-beginning 0))) 3524 (delete-char (- (match-end 0) (match-beginning 0)))
3449 (forward-line -1)) 3525 (forward-line -1))
3450 (goto-char (point-min)) 3526 (goto-char (point-min))
3451 (if (looking-at "[\b\t\n\v\f\r ]+") 3527 (when (looking-at "[\b\t\n\v\f\r ]+")
3452 (delete-char (- (match-end 0) (match-beginning 0)))) 3528 (delete-char (- (match-end 0) (match-beginning 0))))
3453 (shrink-window-if-larger-than-buffer) 3529 (shrink-window-if-larger-than-buffer)
3454 ;; move point to the log entry for the working revision 3530 ;; move point to the log entry for the working revision
3455 (vc-call-backend ',backend 'show-log-entry ',working-revision) 3531 (vc-call-backend ',backend 'show-log-entry ',working-revision)
@@ -3467,26 +3543,24 @@ to the working revision (except for keyword expansion)."
3467 ;; sure buffer is saved. If the user says `no', abort since 3543 ;; sure buffer is saved. If the user says `no', abort since
3468 ;; we cannot show the changes and ask for confirmation to 3544 ;; we cannot show the changes and ask for confirmation to
3469 ;; discard them. 3545 ;; discard them.
3470 (if (or (not files) (memq (buffer-file-name) files)) 3546 (when (or (not files) (memq (buffer-file-name) files))
3471 (vc-buffer-sync nil)) 3547 (vc-buffer-sync nil))
3472 (dolist (file files) 3548 (dolist (file files)
3473 (let ((buf (get-file-buffer file))) 3549 (let ((buf (get-file-buffer file)))
3474 (if (and buf (buffer-modified-p buf)) 3550 (when (and buf (buffer-modified-p buf))
3475 (error "Please kill or save all modified buffers before reverting."))) 3551 (error "Please kill or save all modified buffers before reverting.")))
3476 (if (vc-up-to-date-p file) 3552 (when (vc-up-to-date-p file)
3477 (unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file)) 3553 (unless (yes-or-no-p (format "%s seems up-to-date. Revert anyway? " file))
3478 (error "Revert canceled")))) 3554 (error "Revert canceled"))))
3479 (if (vc-diff-internal vc-allow-async-revert files nil nil) 3555 (when (vc-diff-internal vc-allow-async-revert files nil nil)
3480 (progn 3556 (unless (yes-or-no-p (format "Discard changes in %s? " (vc-delistify files)))
3481 (unless (yes-or-no-p (format "Discard changes in %s? " (vc-delistify files))) 3557 (error "Revert canceled"))
3482 (error "Revert canceled")) 3558 (delete-windows-on "*vc-diff*")
3483 (delete-windows-on "*vc-diff*") 3559 (kill-buffer "*vc-diff*"))
3484 (kill-buffer "*vc-diff*")))
3485 (dolist (file files) 3560 (dolist (file files)
3486 (progn 3561 (message "Reverting %s..." (vc-delistify files))
3487 (message "Reverting %s..." (vc-delistify files)) 3562 (vc-revert-file file)
3488 (vc-revert-file file) 3563 (message "Reverting %s...done" (vc-delistify files)))))
3489 (message "Reverting %s...done" (vc-delistify files))))))
3490 3564
3491;;;###autoload 3565;;;###autoload
3492(defun vc-rollback () 3566(defun vc-rollback ()
@@ -3499,21 +3573,21 @@ depending on the underlying version-control system."
3499 (granularity (vc-call-backend backend 'revision-granularity))) 3573 (granularity (vc-call-backend backend 'revision-granularity)))
3500 (unless (vc-find-backend-function backend 'rollback) 3574 (unless (vc-find-backend-function backend 'rollback)
3501 (error "Rollback is not supported in %s" backend)) 3575 (error "Rollback is not supported in %s" backend))
3502 (if (and (not (eq granularity 'repository)) (/= (length files) 1)) 3576 (when (and (not (eq granularity 'repository)) (/= (length files) 1))
3503 (error "Rollback requires a singleton fileset or repository versioning")) 3577 (error "Rollback requires a singleton fileset or repository versioning"))
3504 (if (not (vc-call latest-on-branch-p (car files))) 3578 (when (not (vc-call latest-on-branch-p (car files)))
3505 (error "Rollback is only possible at the tip revision.")) 3579 (error "Rollback is only possible at the tip revision."))
3506 ;; If any of the files is visited by the current buffer, make 3580 ;; If any of the files is visited by the current buffer, make
3507 ;; sure buffer is saved. If the user says `no', abort since 3581 ;; sure buffer is saved. If the user says `no', abort since
3508 ;; we cannot show the changes and ask for confirmation to 3582 ;; we cannot show the changes and ask for confirmation to
3509 ;; discard them. 3583 ;; discard them.
3510 (if (or (not files) (memq (buffer-file-name) files)) 3584 (when (or (not files) (memq (buffer-file-name) files))
3511 (vc-buffer-sync nil)) 3585 (vc-buffer-sync nil))
3512 (dolist (file files) 3586 (dolist (file files)
3513 (if (buffer-modified-p (get-file-buffer file)) 3587 (when (buffer-modified-p (get-file-buffer file))
3514 (error "Please kill or save all modified buffers before rollback.")) 3588 (error "Please kill or save all modified buffers before rollback."))
3515 (if (not (vc-up-to-date-p file)) 3589 (when (not (vc-up-to-date-p file))
3516 (error "Please revert all modified workfiles before rollback."))) 3590 (error "Please revert all modified workfiles before rollback.")))
3517 ;; Accumulate changes associated with the fileset 3591 ;; Accumulate changes associated with the fileset
3518 (vc-setup-buffer "*vc-diff*") 3592 (vc-setup-buffer "*vc-diff*")
3519 (not-modified) 3593 (not-modified)
@@ -3579,8 +3653,8 @@ its name; otherwise return nil."
3579 backup-file 3653 backup-file
3580 ;; there is no automatic backup, but maybe the user made one manually 3654 ;; there is no automatic backup, but maybe the user made one manually
3581 (setq backup-file (vc-version-backup-file-name file rev 'manual)) 3655 (setq backup-file (vc-version-backup-file-name file rev 'manual))
3582 (if (file-exists-p backup-file) 3656 (when (file-exists-p backup-file)
3583 backup-file))))) 3657 backup-file)))))
3584 3658
3585(defun vc-revert-file (file) 3659(defun vc-revert-file (file)
3586 "Revert FILE back to the repository working revision it was based on." 3660 "Revert FILE back to the repository working revision it was based on."
@@ -3705,9 +3779,9 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
3705 (mapcar 3779 (mapcar
3706 (lambda (s) (vc-possible-master s newdir newbase)) 3780 (lambda (s) (vc-possible-master s newdir newbase))
3707 templates))) 3781 templates)))
3708 (if (or (file-symlink-p oldmaster) 3782 (when (or (file-symlink-p oldmaster)
3709 (file-symlink-p (file-name-directory oldmaster))) 3783 (file-symlink-p (file-name-directory oldmaster)))
3710 (error "This is unsafe in the presence of symbolic links")) 3784 (error "This is unsafe in the presence of symbolic links"))
3711 (rename-file 3785 (rename-file
3712 oldmaster 3786 oldmaster
3713 (catch 'found 3787 (catch 'found
@@ -3733,8 +3807,8 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
3733 (file-name-nondirectory file))) 3807 (file-name-nondirectory file)))
3734 (unless (vc-find-backend-function backend 'delete-file) 3808 (unless (vc-find-backend-function backend 'delete-file)
3735 (error "Deleting files under %s is not supported in VC" backend)) 3809 (error "Deleting files under %s is not supported in VC" backend))
3736 (if (and buf (buffer-modified-p buf)) 3810 (when (and buf (buffer-modified-p buf))
3737 (error "Please save files before deleting them")) 3811 (error "Please save files before deleting them"))
3738 (unless (y-or-n-p (format "Really want to delete %s? " 3812 (unless (y-or-n-p (format "Really want to delete %s? "
3739 (file-name-nondirectory file))) 3813 (file-name-nondirectory file)))
3740 (error "Abort!")) 3814 (error "Abort!"))
@@ -3748,7 +3822,7 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
3748 (unless buf (kill-buffer (current-buffer))))) 3822 (unless buf (kill-buffer (current-buffer)))))
3749 (vc-call delete-file file) 3823 (vc-call delete-file file)
3750 ;; If the backend hasn't deleted the file itself, let's do it for him. 3824 ;; If the backend hasn't deleted the file itself, let's do it for him.
3751 (if (file-exists-p file) (delete-file file)) 3825 (when (file-exists-p file) (delete-file file))
3752 ;; Forget what VC knew about the file. 3826 ;; Forget what VC knew about the file.
3753 (vc-file-clearprops file) 3827 (vc-file-clearprops file)
3754 (vc-resynch-buffer file buf t))) 3828 (vc-resynch-buffer file buf t)))
@@ -3758,12 +3832,12 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
3758 "Rename file OLD to NEW, and rename its master file likewise." 3832 "Rename file OLD to NEW, and rename its master file likewise."
3759 (interactive "fVC rename file: \nFRename to: ") 3833 (interactive "fVC rename file: \nFRename to: ")
3760 (let ((oldbuf (get-file-buffer old))) 3834 (let ((oldbuf (get-file-buffer old)))
3761 (if (and oldbuf (buffer-modified-p oldbuf)) 3835 (when (and oldbuf (buffer-modified-p oldbuf))
3762 (error "Please save files before moving them")) 3836 (error "Please save files before moving them"))
3763 (if (get-file-buffer new) 3837 (when (get-file-buffer new)
3764 (error "Already editing new file name")) 3838 (error "Already editing new file name"))
3765 (if (file-exists-p new) 3839 (when (file-exists-p new)
3766 (error "New file already exists")) 3840 (error "New file already exists"))
3767 (let ((state (vc-state old))) 3841 (let ((state (vc-state old)))
3768 (unless (memq state '(up-to-date edited)) 3842 (unless (memq state '(up-to-date edited))
3769 (error "Please %s files before moving them" 3843 (error "Please %s files before moving them"
@@ -3771,17 +3845,17 @@ backend to NEW-BACKEND, and unregister FILE from the current backend.
3771 (vc-call rename-file old new) 3845 (vc-call rename-file old new)
3772 (vc-file-clearprops old) 3846 (vc-file-clearprops old)
3773 ;; Move the actual file (unless the backend did it already) 3847 ;; Move the actual file (unless the backend did it already)
3774 (if (file-exists-p old) (rename-file old new)) 3848 (when (file-exists-p old) (rename-file old new))
3775 ;; ?? Renaming a file might change its contents due to keyword expansion. 3849 ;; ?? Renaming a file might change its contents due to keyword expansion.
3776 ;; We should really check out a new copy if the old copy was precisely equal 3850 ;; We should really check out a new copy if the old copy was precisely equal
3777 ;; to some checked-in revision. However, testing for this is tricky.... 3851 ;; to some checked-in revision. However, testing for this is tricky....
3778 (if oldbuf 3852 (when oldbuf
3779 (with-current-buffer oldbuf 3853 (with-current-buffer oldbuf
3780 (let ((buffer-read-only buffer-read-only)) 3854 (let ((buffer-read-only buffer-read-only))
3781 (set-visited-file-name new)) 3855 (set-visited-file-name new))
3782 (vc-backend new) 3856 (vc-backend new)
3783 (vc-mode-line new) 3857 (vc-mode-line new)
3784 (set-buffer-modified-p nil))))) 3858 (set-buffer-modified-p nil)))))
3785 3859
3786;;;###autoload 3860;;;###autoload
3787(defun vc-update-change-log (&rest args) 3861(defun vc-update-change-log (&rest args)
@@ -3839,8 +3913,8 @@ log entries should be gathered."
3839(defun vc-branch-part (rev) 3913(defun vc-branch-part (rev)
3840 "Return the branch part of a revision number REV." 3914 "Return the branch part of a revision number REV."
3841 (let ((index (string-match "\\.[0-9]+\\'" rev))) 3915 (let ((index (string-match "\\.[0-9]+\\'" rev)))
3842 (if index 3916 (when index
3843 (substring rev 0 index)))) 3917 (substring rev 0 index))))
3844 3918
3845(defun vc-minor-part (rev) 3919(defun vc-minor-part (rev)
3846 "Return the minor revision number of a revision number REV." 3920 "Return the minor revision number of a revision number REV."
@@ -4030,7 +4104,7 @@ to provide the `find-revision' operation instead."
4030 (vc-up-to-date-p f) 4104 (vc-up-to-date-p f)
4031 (vc-error-occurred 4105 (vc-error-occurred
4032 (vc-call checkout f nil "") 4106 (vc-call checkout f nil "")
4033 (if update (vc-resynch-buffer f t t))))))) 4107 (when update (vc-resynch-buffer f t t)))))))
4034 (let ((result (vc-snapshot-precondition dir))) 4108 (let ((result (vc-snapshot-precondition dir)))
4035 (if (stringp result) 4109 (if (stringp result)
4036 (error "File %s is locked" result) 4110 (error "File %s is locked" result)
@@ -4039,7 +4113,7 @@ to provide the `find-revision' operation instead."
4039 dir 4113 dir
4040 (lambda (f) (vc-error-occurred 4114 (lambda (f) (vc-error-occurred
4041 (vc-call checkout f nil name) 4115 (vc-call checkout f nil name)
4042 (if update (vc-resynch-buffer f t t))))))))) 4116 (when update (vc-resynch-buffer f t t)))))))))
4043 4117
4044(defun vc-default-revert (backend file contents-done) 4118(defun vc-default-revert (backend file contents-done)
4045 (unless contents-done 4119 (unless contents-done
@@ -4160,10 +4234,10 @@ cover the range from the oldest annotation to the newest."
4160 (goto-char (point-min)) 4234 (goto-char (point-min))
4161 (while (not (eobp)) 4235 (while (not (eobp))
4162 (when (setq date (vc-annotate-get-time-set-line-props)) 4236 (when (setq date (vc-annotate-get-time-set-line-props))
4163 (if (> date newest) 4237 (when (> date newest)
4164 (setq newest date)) 4238 (setq newest date))
4165 (if (< date oldest) 4239 (when (< date oldest)
4166 (setq oldest date))) 4240 (setq oldest date)))
4167 (forward-line 1))) 4241 (forward-line 1)))
4168 (vc-annotate-display 4242 (vc-annotate-display
4169 (/ (- (if full newest current) oldest) 4243 (/ (- (if full newest current) oldest)
@@ -4239,7 +4313,7 @@ By default, the current buffer is highlighted, unless overridden by
4239BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to 4313BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to
4240use; you may override this using the second optional arg MODE." 4314use; you may override this using the second optional arg MODE."
4241 (interactive) 4315 (interactive)
4242 (if mode (setq vc-annotate-display-mode mode)) 4316 (when mode (setq vc-annotate-display-mode mode))
4243 (pop-to-buffer (or buffer (current-buffer))) 4317 (pop-to-buffer (or buffer (current-buffer)))
4244 (cond ((null vc-annotate-display-mode) 4318 (cond ((null vc-annotate-display-mode)
4245 ;; The ratio is global, thus relative to the global color-map. 4319 ;; The ratio is global, thus relative to the global color-map.
@@ -4311,18 +4385,18 @@ mode-specific menu. `vc-annotate-color-map' and
4311 ;; If BUF is specified it tells in which buffer we should put the 4385 ;; If BUF is specified it tells in which buffer we should put the
4312 ;; annotations. This is used when switching annotations to another 4386 ;; annotations. This is used when switching annotations to another
4313 ;; revision, so we should update the buffer's name. 4387 ;; revision, so we should update the buffer's name.
4314 (if buf (with-current-buffer buf 4388 (when buf (with-current-buffer buf
4315 (rename-buffer temp-buffer-name t) 4389 (rename-buffer temp-buffer-name t)
4316 ;; In case it had to be uniquified. 4390 ;; In case it had to be uniquified.
4317 (setq temp-buffer-name (buffer-name)))) 4391 (setq temp-buffer-name (buffer-name))))
4318 (with-output-to-temp-buffer temp-buffer-name 4392 (with-output-to-temp-buffer temp-buffer-name
4319 (vc-call annotate-command file (get-buffer temp-buffer-name) rev) 4393 (vc-call annotate-command file (get-buffer temp-buffer-name) rev)
4320 ;; we must setup the mode first, and then set our local 4394 ;; we must setup the mode first, and then set our local
4321 ;; variables before the show-function is called at the exit of 4395 ;; variables before the show-function is called at the exit of
4322 ;; with-output-to-temp-buffer 4396 ;; with-output-to-temp-buffer
4323 (with-current-buffer temp-buffer-name 4397 (with-current-buffer temp-buffer-name
4324 (if (not (equal major-mode 'vc-annotate-mode)) 4398 (unless (equal major-mode 'vc-annotate-mode)
4325 (vc-annotate-mode)) 4399 (vc-annotate-mode))
4326 (set (make-local-variable 'vc-annotate-backend) (vc-backend file)) 4400 (set (make-local-variable 'vc-annotate-backend) (vc-backend file))
4327 (set (make-local-variable 'vc-annotate-parent-file) file) 4401 (set (make-local-variable 'vc-annotate-parent-file) file)
4328 (set (make-local-variable 'vc-annotate-parent-rev) rev) 4402 (set (make-local-variable 'vc-annotate-parent-rev) rev)
@@ -4457,18 +4531,18 @@ revision."
4457 (setq newrev (vc-call next-revision 4531 (setq newrev (vc-call next-revision
4458 vc-annotate-parent-file newrev)) 4532 vc-annotate-parent-file newrev))
4459 (setq revspec (1- revspec))) 4533 (setq revspec (1- revspec)))
4460 (if (not newrev) 4534 (unless newrev
4461 (message "Cannot increment %d revisions from revision %s" 4535 (message "Cannot increment %d revisions from revision %s"
4462 revspeccopy vc-annotate-parent-rev))) 4536 revspeccopy vc-annotate-parent-rev)))
4463 ((and (integerp revspec) (< revspec 0)) 4537 ((and (integerp revspec) (< revspec 0))
4464 (setq newrev vc-annotate-parent-rev) 4538 (setq newrev vc-annotate-parent-rev)
4465 (while (and (< revspec 0) newrev) 4539 (while (and (< revspec 0) newrev)
4466 (setq newrev (vc-call previous-revision 4540 (setq newrev (vc-call previous-revision
4467 vc-annotate-parent-file newrev)) 4541 vc-annotate-parent-file newrev))
4468 (setq revspec (1+ revspec))) 4542 (setq revspec (1+ revspec)))
4469 (if (not newrev) 4543 (unless newrev
4470 (message "Cannot decrement %d revisions from revision %s" 4544 (message "Cannot decrement %d revisions from revision %s"
4471 (- 0 revspeccopy) vc-annotate-parent-rev))) 4545 (- 0 revspeccopy) vc-annotate-parent-rev)))
4472 ((stringp revspec) (setq newrev revspec)) 4546 ((stringp revspec) (setq newrev revspec))
4473 (t (error "Invalid argument to vc-annotate-warp-revision"))) 4547 (t (error "Invalid argument to vc-annotate-warp-revision")))
4474 (when newrev 4548 (when newrev
@@ -4504,10 +4578,10 @@ This calls the backend function annotate-time, and returns the
4504difference in days between the time returned and the current time, 4578difference in days between the time returned and the current time,
4505or OFFSET if present." 4579or OFFSET if present."
4506 (let ((next-time (vc-annotate-get-time-set-line-props))) 4580 (let ((next-time (vc-annotate-get-time-set-line-props)))
4507 (if next-time 4581 (when next-time
4508 (- (or offset 4582 (- (or offset
4509 (vc-call-backend vc-annotate-backend 'annotate-current-time)) 4583 (vc-call-backend vc-annotate-backend 'annotate-current-time))
4510 next-time)))) 4584 next-time))))
4511 4585
4512(defun vc-default-annotate-current-time (backend) 4586(defun vc-default-annotate-current-time (backend)
4513 "Return the current time, encoded as fractional days." 4587 "Return the current time, encoded as fractional days."
@@ -4519,10 +4593,10 @@ or OFFSET if present."
4519 "Highlight `vc-annotate' output in the current buffer. 4593 "Highlight `vc-annotate' output in the current buffer.
4520RATIO, is the expansion that should be applied to `vc-annotate-color-map'. 4594RATIO, is the expansion that should be applied to `vc-annotate-color-map'.
4521The annotations are relative to the current time, unless overridden by OFFSET." 4595The annotations are relative to the current time, unless overridden by OFFSET."
4522 (if (/= ratio 1.0) 4596 (when (/= ratio 1.0)
4523 (set (make-local-variable 'vc-annotate-color-map) 4597 (set (make-local-variable 'vc-annotate-color-map)
4524 (mapcar (lambda (elem) (cons (* (car elem) ratio) (cdr elem))) 4598 (mapcar (lambda (elem) (cons (* (car elem) ratio) (cdr elem)))
4525 vc-annotate-color-map))) 4599 vc-annotate-color-map)))
4526 (set (make-local-variable 'vc-annotate-offset) offset) 4600 (set (make-local-variable 'vc-annotate-offset) offset)
4527 (font-lock-mode 1)) 4601 (font-lock-mode 1))
4528 4602
@@ -4544,9 +4618,9 @@ The annotations are relative to the current time, unless overridden by OFFSET."
4544 (face (or (intern-soft face-name) 4618 (face (or (intern-soft face-name)
4545 (let ((tmp-face (make-face (intern face-name)))) 4619 (let ((tmp-face (make-face (intern face-name))))
4546 (set-face-foreground tmp-face (cdr color)) 4620 (set-face-foreground tmp-face (cdr color))
4547 (if vc-annotate-background 4621 (when vc-annotate-background
4548 (set-face-background tmp-face 4622 (set-face-background tmp-face
4549 vc-annotate-background)) 4623 vc-annotate-background))
4550 tmp-face)))) ; Return the face 4624 tmp-face)))) ; Return the face
4551 (put-text-property start end 'face face))))) 4625 (put-text-property start end 'face face)))))
4552 ;; Pretend to font-lock there were no matches. 4626 ;; Pretend to font-lock there were no matches.
@@ -4578,7 +4652,7 @@ Invoke FUNC f ARGS on each VC-managed file f underneath it."
4578 4652
4579(defun vc-file-tree-walk-internal (file func args) 4653(defun vc-file-tree-walk-internal (file func args)
4580 (if (not (file-directory-p file)) 4654 (if (not (file-directory-p file))
4581 (if (vc-backend file) (apply func file args)) 4655 (when (vc-backend file) (apply func file args))
4582 (message "Traversing directory %s..." (abbreviate-file-name file)) 4656 (message "Traversing directory %s..." (abbreviate-file-name file))
4583 (let ((dir (file-name-as-directory file))) 4657 (let ((dir (file-name-as-directory file)))
4584 (mapcar 4658 (mapcar