emacs: lisp/vc.el comparison

comparison lisp/vc.el @ 50894:4dc2d45403ec

(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'.

author	Stefan Monnier <monnier@iro.umontreal.ca>
date	Thu, 08 May 2003 17:41:16 +0000
parents	f614a2396578
children	dd6110a63907

comparison

equal deleted inserted replaced

-:60a9c1f0319a
+:4dc2d45403ec
 ;; Author:     FSF (see below for full credits)
 ;; Maintainer: Andre Spiegel <spiegel@gnu.org>
 ;; 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.
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 (defmacro with-vc-properties (file form settings)
 "Execute FORM, then maybe set per-file properties for FILE.
 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)
 	       (let ((property (car setting)))
 		 (unless (memq property vc-touched-properties)
 "Check out a writable copy of FILE if necessary, then execute BODY.
 Check in FILE with COMMENT (a string) after BODY has been executed.
 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)
 (error (format "File not under version control: `%s'" file)))
 (unless (vc-editable-p ,filevar)
 (vc-checkout ,filevar t))))
 (save-excursion
 ,@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
 ,filevar ,comment
 (set-buffer (find-file-noselect ,filevar))
 ,@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
 (set-buffer (find-file-noselect (dired-get-filename)))
 (defvar vc-post-command-functions nil
 "Hook run at the end of `vc-do-command'.
 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.
 Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil or the
 current buffer if BUFFER is t.  If the destination buffer is not
 (unless (or (eq buffer t)
 (and (stringp buffer)
 (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
 	;; come into play.
 	(setq squeezed (append squeezed (list (file-relative-name file)))))
 			   (vc-position-context (mark-marker))))
 	;; Make the right thing happen in transient-mark-mode.
 	(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
-			;; Construct a list; each elt is nil or a buffer
+		      ;; iff that buffer is a compilation output buffer
-			;; iff that buffer is a compilation output buffer
+		      ;; that contains markers into the current buffer.
-			;; that contains markers into the current buffer.
+		      (save-current-buffer
-			(save-excursion
+			(mapcar (lambda (buffer)
-			  (mapcar (lambda (buffer)
+				  (set-buffer buffer)
-				    (set-buffer buffer)
+				  (let ((errors (or
-				    (let ((errors (or
+						 compilation-old-error-list
-						   compilation-old-error-list
+						 compilation-error-list))
-						   compilation-error-list))
+					(buffer-error-marked-p nil))
-					  (buffer-error-marked-p nil))
+				    (while (and (consp errors)
-				      (while (and (consp errors)
+						(not buffer-error-marked-p))
-						  (not buffer-error-marked-p))
+				      (and (markerp (cdr (car errors)))
-					(and (markerp (cdr (car errors)))
+					   (eq buffer
-					     (eq buffer
+					       (marker-buffer
-						 (marker-buffer
+						(cdr (car errors))))
-						  (cdr (car errors))))
+					   (setq buffer-error-marked-p t))
-					     (setq buffer-error-marked-p t))
+				      (setq errors (cdr errors)))
-					(setq errors (cdr errors)))
+				    (if buffer-error-marked-p buffer)))
-				      (if buffer-error-marked-p buffer)))
+				(buffer-list))))))
-				  (buffer-list)))))))
 (list point-context mark-context reparse)))
 (defun vc-restore-buffer-context (context)
 "Restore point/mark, and reparse any affected compilation buffers.
 CONTEXT is that which `vc-buffer-context' returns."
 (defvar vc-dired-window-configuration)
 (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))
+(let ((dired-buffer (current-buffer)))
-	(dired-dir default-directory))
 (dired-map-over-marks
 (let ((file (dired-get-filename)))
 (message "Processing %s..." file)
 (vc-next-action-on-file file nil comment)
 (set-buffer dired-buffer)
 file
 (vc-version-backup-file file rel2)))
 (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)
+	       (append (vc-switches nil 'diff)
-diff-switches
+		       (list (file-relative-name file-rel1)
-(list diff-switches))
+			     (file-relative-name file-rel2))))
-(if (listp vc-diff-switches)
-vc-diff-switches
-(list vc-diff-switches))
-(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."
+(defun vc-switches (backend op)
-`(append
+(let ((switches
-(if (listp diff-switches) diff-switches (list diff-switches))
+	 (or (if backend
-(if (listp vc-diff-switches) vc-diff-switches (list vc-diff-switches))
+		 (let ((sym (vc-make-backend-sym
-(let* ((backend-switches-symbol
+			     backend (intern (concat (symbol-name op)
-	    (intern (concat "vc-" (downcase (symbol-name ,backend))
+						     "-switches")))))
-			    "-diff-switches")))
+		   (if (boundp sym) (symbol-value sym))))
-	   (backend-switches
+	     (let ((sym (intern (format "vc-%s-switches" (symbol-name op)))))
-	    (if (boundp backend-switches-symbol)
+	       (if (boundp sym) (symbol-value sym)))
-		(eval backend-switches-symbol)
+	     (cond
-	      nil)))
+	      ((eq op 'diff) diff-switches)))))
-(if (listp backend-switches) backend-switches (list backend-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.
 The meaning of REL1 and REL2 is the same as for `vc-version-diff'."
 ;; This implementation does an explicit tree walk, and calls
 (defun vc-dired-hook ()
 "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
 ;; subdir header line
 ((setq subdir (dired-get-subdir))
 (goto-char (point-min))
 (message "No files locked under %s" default-directory)))))
 (defun vc-dired-purge ()
 "Remove empty subdirs."
-(let (subdir)
+(goto-char (point-min))
-(goto-char (point-min))
+(while (dired-get-subdir)
-(while (setq subdir (dired-get-subdir))
+(forward-line 2)
-(forward-line 2)
+(if (dired-get-filename nil t)
-(if (dired-get-filename nil t)
+	(if (not (dired-next-subdir 1 t))
-(if (not (dired-next-subdir 1 t))
+	    (goto-char (point-max)))
-(goto-char (point-max)))
+(forward-line -2)
-(forward-line -2)
+(if (not (string= (dired-current-directory) default-directory))
-(if (not (string= (dired-current-directory) default-directory))
+	  (dired-do-kill-lines t "")
-(dired-do-kill-lines t "")
+	;; We cannot remove the top level directory.
-;; We cannot remove the top level directory.
+	;; Just make it look a little nicer.
-;; Just make it look a little nicer.
+	(forward-line 1)
-(forward-line 1)
+	(kill-line)
-(kill-line)
+	(if (not (dired-next-subdir 1 t))
-(if (not (dired-next-subdir 1 t))
+	    (goto-char (point-max))))))
-(goto-char (point-max))))))
+(goto-char (point-min)))
-(goto-char (point-min))))
 (defun vc-dired-buffers-for-dir (dir)
 "Return a list of all vc-dired buffers that currently display DIR."
 (let (result)
 ;; Check whether dired is loaded.
 A prefix argument NOREVERT means do not revert the buffer afterwards."
 (interactive "P")
 (vc-ensure-vc-buffer)
 (let* ((file (buffer-file-name))
 	 (backend (vc-backend file))
-(target (vc-workfile-version file))
+(target (vc-workfile-version file)))
-(config (current-window-configuration)) done)
 (cond
 ((not (vc-find-backend-function backend 'cancel-version))
 (error "Sorry, canceling versions is not supported under %s" backend))
 ((not (vc-call latest-on-branch-p file))
 (error "This is not the latest version; VC cannot cancel it"))
 		(copy-file file modified-file 'ok-if-already-exists)
 		;; If we have a local copy of the unmodified file, handle that
 		;; 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))
 	  (when modified-file
 	    (vc-switch-backend file new-backend)
 	(error "This is unsafe in the presence of symbolic links"))
 (rename-file
 oldmaster
 (catch 'found
 ;; If possible, keep the master file in the same directory.
-(mapcar (lambda (f)
+(dolist (f masters)
-		 (if (and f (string= (file-name-directory (expand-file-name f))
+	 (if (and f (string= (file-name-directory (expand-file-name f)) dir))
-				     dir))
+	     (throw 'found f)))
-		     (throw 'found f)))
-	       masters)
 ;; If not, just use the first possible place.
-(mapcar (lambda (f)
+(dolist (f masters)
-		 (and f
+	 (and f (or (not (setq dir (file-name-directory f)))
-		      (or (not (setq dir (file-name-directory f)))
+		    (file-directory-p dir))
-			  (file-directory-p dir))
+	      (throw 'found f)))
-		      (throw 'found f)))
-	       masters)
 (error "New file lacks a version control directory")))))
 ;;;###autoload
 (defun vc-rename-file (old new)
 "Rename file OLD to NEW, and rename its master file likewise."
 (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"))
 (if (get-file-buffer new)
 	(error "Already editing new file name"))
 (if (file-exists-p new)
 	(error "New file already exists"))
-(when backend
+(vc-call-backend backend 'rename-file old new)
-(if (and backend (not (vc-up-to-date-p old)))
+(vc-file-clearprops old)
-	  (error "Please check in files before moving them"))
-(vc-call-backend backend 'rename-file old new))
 ;; Move the actual file (unless the backend did it already)
 (if (or (not backend) (file-exists-p old))
 	(rename-file old new))
 ;; ?? Renaming a file might change its contents due to keyword expansion.
 ;; We should really check out a new copy if the old copy was precisely equal
 (if prefix
 (setq vc-annotate-display-mode
 (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
 ;; (only after `with-output-to-temp-buffer'.)
 (setq vc-annotate-buffers
 			 (set-face-foreground tmp-face (cdr color))
 			 (if vc-annotate-background
 			     (set-face-background tmp-face
 						  vc-annotate-background))
 			 tmp-face)))	; Return the face
-	     (point (point))
+	     (point (point)))
-	     overlay)
 	(forward-line 1)
 	(put-text-property point (point) 'face face)))
 ;; Pretend to font-lock there were no matches.
 nil))

Mercurial > emacs

comparison lisp/vc.el @ 50894:4dc2d45403ec