diff options
| author | Dan Nicolaescu | 2008-04-21 05:11:56 +0000 |
|---|---|---|
| committer | Dan Nicolaescu | 2008-04-21 05:11:56 +0000 |
| commit | b54462764d27d8dfa43ddd39786cf352fc736d6a (patch) | |
| tree | a86dfea48b238951a3e12c6344b5cfaeb9e4347a | |
| parent | 61acee99020a65f7d5875d8b338199f16e472095 (diff) | |
| download | emacs-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/ChangeLog | 21 | ||||
| -rw-r--r-- | lisp/vc-hooks.el | 46 | ||||
| -rw-r--r-- | lisp/vc.el | 508 |
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 @@ | |||
| 1 | 2008-04-21 Dan Nicolaescu <dann@ics.uci.edu> | 1 | 2008-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. |
| 605 | If FILE is not registered, this function always returns nil." | 605 | If 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." | |||
| 1296 | Used by `vc-restore-buffer-context' to later restore the context." | 1296 | Used 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 | |||
| 1383 | which FILE is not yet registered. If there is no such backend, return | 1383 | which FILE is not yet registered. If there is no such backend, return |
| 1384 | the first backend under which FILE is not yet registered, but could | 1384 | the first backend under which FILE is not yet registered, but could |
| 1385 | be registered." | 1385 | be 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. |
| 1517 | NOT-URGENT means it is ok to continue if the user says not to save." | 1517 | NOT-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. |
| 3021 | If NOINSERT, ignore elements on ENTRIES which are not in the ewoc." | 3028 | If 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 | |||
| 4239 | BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to | 4313 | BUFFER. `vc-annotate-display-mode' specifies the highlighting mode to |
| 4240 | use; you may override this using the second optional arg MODE." | 4314 | use; 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 | |||
| 4504 | difference in days between the time returned and the current time, | 4578 | difference in days between the time returned and the current time, |
| 4505 | or OFFSET if present." | 4579 | or 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. |
| 4520 | RATIO, is the expansion that should be applied to `vc-annotate-color-map'. | 4594 | RATIO, is the expansion that should be applied to `vc-annotate-color-map'. |
| 4521 | The annotations are relative to the current time, unless overridden by OFFSET." | 4595 | The 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 |