# HG changeset patch # User Stefan Monnier # Date 1052415676 0 # Node ID 4dc2d45403ec41ee49a5bbc64dbf7aba95e3ae57 # Parent 60a9c1f0319a9546e6f43429751e4a19bb81a127 (with-vc-properties, with-vc-file, edit-vc-file): Add `declare's for debugging and indentation. (vc-do-command): Use `remq'. (vc-buffer-context): Remove unused var `curbuf'. (vc-next-action-dired): Remove unused var `dired-dir'. (vc-switches): New fun. (vc-diff-switches-list): Use it. (vc-dired-hook): Remove unused var `cvs-dir'. (vc-dired-purge): Remove unused var `subdir'. (vc-cancel-version): Remove unused var `config'. (vc-rename-master): Use dolist iso mapcar. (vc-rename-file): Remove redundant tests. Clear the properties of the old file name. (vc-annotate): Pass the complete filename to `annotate-command'. (vc-annotate-lines): Remove unused var `overlay'. diff -r 60a9c1f0319a -r 4dc2d45403ec lisp/vc.el --- a/lisp/vc.el Thu May 08 14:29:59 2003 +0000 +++ b/lisp/vc.el Thu May 08 17:41:16 2003 +0000 @@ -6,7 +6,7 @@ ;; Maintainer: Andre Spiegel ;; Keywords: tools -;; $Id: vc.el,v 1.349 2003/02/05 23:13:21 lektu Exp $ +;; $Id: vc.el,v 1.350 2003/02/19 18:56:38 spiegel Exp $ ;; This file is part of GNU Emacs. @@ -751,6 +751,7 @@ SETTINGS is an association list of property/value pairs. After executing FORM, set those properties from SETTINGS that have not yet been updated to their corresponding values." + (declare (debug t)) `(let ((vc-touched-properties (list t))) ,form (mapcar (lambda (setting) @@ -775,6 +776,7 @@ FILE is passed through `expand-file-name'; BODY executed within `save-excursion'. If FILE is not under version control, or locked by somebody else, signal error." + (declare (debug t) (indent 2)) (let ((filevar (make-symbol "file"))) `(let ((,filevar (expand-file-name ,file))) (or (vc-backend ,filevar) @@ -788,14 +790,13 @@ ,@body) (vc-checkin ,filevar nil ,comment)))) -(put 'with-vc-file 'lisp-indent-function 2) - ;;;###autoload (defmacro edit-vc-file (file comment &rest body) "Edit FILE under version control, executing body. Checkin with COMMENT after executing BODY. This macro uses `with-vc-file', passing args to it. However, before executing BODY, find FILE, and after BODY, save buffer." + (declare (debug t) (indent 2)) (let ((filevar (make-symbol "file"))) `(let ((,filevar (expand-file-name ,file))) (with-vc-file @@ -804,8 +805,6 @@ ,@body (save-buffer))))) -(put 'edit-vc-file 'lisp-indent-function 2) - (defun vc-ensure-vc-buffer () "Make sure that the current buffer visits a version-controlled file." (if vc-dired-mode @@ -874,6 +873,7 @@ Each function is called inside the buffer in which the command was run and is passed 3 arguments: the COMMAND, the FILE and the FLAGS.") +(defvar w32-quote-process-args) ;;;###autoload (defun vc-do-command (buffer okstatus command file &rest flags) "Execute a VC command, notifying user and checking for errors. @@ -895,10 +895,9 @@ (string= (buffer-name) buffer)) (eq buffer (current-buffer))) (vc-setup-buffer buffer)) - (let ((squeezed nil) + (let ((squeezed (remq nil flags)) (inhibit-read-only t) (status 0)) - (setq squeezed (delq nil (copy-sequence flags))) (when file ;; FIXME: file-relative-name can return a bogus result because ;; it doesn't look at the actual file-system to see if symlinks @@ -986,27 +985,26 @@ (mark-active nil) ;; We may want to reparse the compilation buffer after revert (reparse (and (boundp 'compilation-error-list) ;compile loaded - (let ((curbuf (current-buffer))) - ;; Construct a list; each elt is nil or a buffer - ;; iff that buffer is a compilation output buffer - ;; that contains markers into the current buffer. - (save-excursion - (mapcar (lambda (buffer) - (set-buffer buffer) - (let ((errors (or - compilation-old-error-list - compilation-error-list)) - (buffer-error-marked-p nil)) - (while (and (consp errors) - (not buffer-error-marked-p)) - (and (markerp (cdr (car errors))) - (eq buffer - (marker-buffer - (cdr (car errors)))) - (setq buffer-error-marked-p t)) - (setq errors (cdr errors))) - (if buffer-error-marked-p buffer))) - (buffer-list))))))) + ;; Construct a list; each elt is nil or a buffer + ;; iff that buffer is a compilation output buffer + ;; that contains markers into the current buffer. + (save-current-buffer + (mapcar (lambda (buffer) + (set-buffer buffer) + (let ((errors (or + compilation-old-error-list + compilation-error-list)) + (buffer-error-marked-p nil)) + (while (and (consp errors) + (not buffer-error-marked-p)) + (and (markerp (cdr (car errors))) + (eq buffer + (marker-buffer + (cdr (car errors)))) + (setq buffer-error-marked-p t)) + (setq errors (cdr errors))) + (if buffer-error-marked-p buffer))) + (buffer-list)))))) (list point-context mark-context reparse))) (defun vc-restore-buffer-context (context) @@ -1232,8 +1230,7 @@ (defun vc-next-action-dired (file rev comment) "Call `vc-next-action-on-file' on all the marked files. Ignores FILE and REV, but passes on COMMENT." - (let ((dired-buffer (current-buffer)) - (dired-dir default-directory)) + (let ((dired-buffer (current-buffer))) (dired-map-over-marks (let ((file (dired-get-filename))) (message "Processing %s..." file) @@ -1855,29 +1852,31 @@ (coding-system-for-read (vc-coding-system-for-diff file))) (if (and file-rel1 file-rel2) (apply 'vc-do-command "*vc-diff*" 1 "diff" nil - (append (if (listp diff-switches) - diff-switches - (list diff-switches)) - (if (listp vc-diff-switches) - vc-diff-switches - (list vc-diff-switches)) - (list (file-relative-name file-rel1) - (file-relative-name file-rel2)))) + (append (vc-switches nil 'diff) + (list (file-relative-name file-rel1) + (file-relative-name file-rel2)))) (vc-call diff file rel1 rel2)))) -(defmacro vc-diff-switches-list (backend) - "Return the list of switches to use for executing diff under BACKEND." - `(append - (if (listp diff-switches) diff-switches (list diff-switches)) - (if (listp vc-diff-switches) vc-diff-switches (list vc-diff-switches)) - (let* ((backend-switches-symbol - (intern (concat "vc-" (downcase (symbol-name ,backend)) - "-diff-switches"))) - (backend-switches - (if (boundp backend-switches-symbol) - (eval backend-switches-symbol) - nil))) - (if (listp backend-switches) backend-switches (list backend-switches))))) + +(defun vc-switches (backend op) + (let ((switches + (or (if backend + (let ((sym (vc-make-backend-sym + backend (intern (concat (symbol-name op) + "-switches"))))) + (if (boundp sym) (symbol-value sym)))) + (let ((sym (intern (format "vc-%s-switches" (symbol-name op))))) + (if (boundp sym) (symbol-value sym))) + (cond + ((eq op 'diff) diff-switches))))) + (if (stringp switches) (list switches) + ;; If not a list, return nil. + ;; This is so we can set vc-diff-switches to t to override + ;; any switches in diff-switches. + (if (listp switches) switches)))) + +(defun vc-diff-switches-list (backend) (vc-switches backend 'diff)) +;; (defmacro vc-diff-switches-list (backend) `(vc-switches ',backend 'diff)) (defun vc-default-diff-tree (backend dir rel1 rel2) "List differences for all registered files at and below DIR. @@ -2192,7 +2191,7 @@ "Reformat the listing according to version control. Called by dired after any portion of a vc-dired buffer has been read in." (message "Getting version information... ") - (let (subdir filename (buffer-read-only nil) cvs-dir) + (let (subdir filename (buffer-read-only nil)) (goto-char (point-min)) (while (not (eobp)) (cond @@ -2251,23 +2250,22 @@ (defun vc-dired-purge () "Remove empty subdirs." - (let (subdir) - (goto-char (point-min)) - (while (setq subdir (dired-get-subdir)) - (forward-line 2) - (if (dired-get-filename nil t) - (if (not (dired-next-subdir 1 t)) - (goto-char (point-max))) - (forward-line -2) - (if (not (string= (dired-current-directory) default-directory)) - (dired-do-kill-lines t "") - ;; We cannot remove the top level directory. - ;; Just make it look a little nicer. - (forward-line 1) - (kill-line) - (if (not (dired-next-subdir 1 t)) - (goto-char (point-max)))))) - (goto-char (point-min)))) + (goto-char (point-min)) + (while (dired-get-subdir) + (forward-line 2) + (if (dired-get-filename nil t) + (if (not (dired-next-subdir 1 t)) + (goto-char (point-max))) + (forward-line -2) + (if (not (string= (dired-current-directory) default-directory)) + (dired-do-kill-lines t "") + ;; We cannot remove the top level directory. + ;; Just make it look a little nicer. + (forward-line 1) + (kill-line) + (if (not (dired-next-subdir 1 t)) + (goto-char (point-max)))))) + (goto-char (point-min))) (defun vc-dired-buffers-for-dir (dir) "Return a list of all vc-dired buffers that currently display DIR." @@ -2565,8 +2563,7 @@ (vc-ensure-vc-buffer) (let* ((file (buffer-file-name)) (backend (vc-backend file)) - (target (vc-workfile-version file)) - (config (current-window-configuration)) done) + (target (vc-workfile-version file))) (cond ((not (vc-find-backend-function backend 'cancel-version)) (error "Sorry, canceling versions is not supported under %s" backend)) @@ -2681,7 +2678,8 @@ ;; here and not in vc-revert-file because we don't want to ;; delete that copy -- it is still useful for OLD-BACKEND. (if unmodified-file - (copy-file unmodified-file file 'ok-if-already-exists) + (copy-file unmodified-file file + 'ok-if-already-exists 'keep-date) (if (y-or-n-p "Get base version from master? ") (vc-revert-file file)))) (vc-call-backend new-backend 'receive-file file rev)) @@ -2726,18 +2724,14 @@ oldmaster (catch 'found ;; If possible, keep the master file in the same directory. - (mapcar (lambda (f) - (if (and f (string= (file-name-directory (expand-file-name f)) - dir)) - (throw 'found f))) - masters) + (dolist (f masters) + (if (and f (string= (file-name-directory (expand-file-name f)) dir)) + (throw 'found f))) ;; If not, just use the first possible place. - (mapcar (lambda (f) - (and f - (or (not (setq dir (file-name-directory f))) - (file-directory-p dir)) - (throw 'found f))) - masters) + (dolist (f masters) + (and f (or (not (setq dir (file-name-directory f))) + (file-directory-p dir)) + (throw 'found f))) (error "New file lacks a version control directory"))))) ;;;###autoload @@ -2746,7 +2740,7 @@ (interactive "fVC rename file: \nFRename to: ") (let ((oldbuf (get-file-buffer old)) (backend (vc-backend old))) - (unless (or (null backend) (vc-find-backend-function backend 'rename-file)) + (unless (vc-find-backend-function backend 'rename-file) (error "Renaming files under %s is not supported in VC" backend)) (if (and oldbuf (buffer-modified-p oldbuf)) (error "Please save files before moving them")) @@ -2754,10 +2748,8 @@ (error "Already editing new file name")) (if (file-exists-p new) (error "New file already exists")) - (when backend - (if (and backend (not (vc-up-to-date-p old))) - (error "Please check in files before moving them")) - (vc-call-backend backend 'rename-file old new)) + (vc-call-backend backend 'rename-file old new) + (vc-file-clearprops old) ;; Move the actual file (unless the backend did it already) (if (or (not backend) (file-exists-p old)) (rename-file old new)) @@ -3056,14 +3048,14 @@ (float (string-to-number (read-string "Annotate span days: (default 20) " nil nil "20"))))) - (setq vc-annotate-backend (vc-backend (buffer-file-name))) + (setq vc-annotate-backend (vc-backend buffer-file-name)) (message "Annotating...") (if (not (vc-find-backend-function vc-annotate-backend 'annotate-command)) (error "Sorry, annotating is not implemented for %s" vc-annotate-backend)) (with-output-to-temp-buffer temp-buffer-name (vc-call-backend vc-annotate-backend 'annotate-command - (file-name-nondirectory (buffer-file-name)) + buffer-file-name (get-buffer temp-buffer-name) vc-annotate-version)) ;; Don't use the temp-buffer-name until the buffer is created @@ -3151,8 +3143,7 @@ (set-face-background tmp-face vc-annotate-background)) tmp-face))) ; Return the face - (point (point)) - overlay) + (point (point))) (forward-line 1) (put-text-property point (point) 'face face))) ;; Pretend to font-lock there were no matches.