emacs: lisp/vc.el comparison

comparison lisp/vc.el @ 12872:857663042672

(vc-revert-buffer1): Split part of the function into vc-buffer-context and vc-restore-buffer-context, so we can use it also in other circumstances. (vc-buffer-context, vc-restore-buffer-context): New functions. (vc-clear-headers): New function, uses the above. (vc-cancel-version): When `norevert', locks the most recent remaining version. Also, refuse to work on anything but the latest version of a branch. Removed the check whether the version is the user's, because that is difficult to decide, now that multiple branches are possible. (vc-latest-on-branch-p): New function. (vc-head-version): New access function to the already existing property. (vc-trunk-p, vc-branch-part): Functions moved before first use.

author	André Spiegel <spiegel@gnu.org>
date	Thu, 17 Aug 1995 12:40:03 +0000
parents	e6713915dd94
children	03d3b7d60f67

comparison

equal deleted inserted replaced

-:d998327b9011
+:857663042672
 ))
 (if (not (boundp 'file-regular-p))
 (fset 'file-regular-p 'file-regular-p-18))
+;;; functions that operate on RCS revision numbers
+(defun vc-trunk-p (rev)
+;; return t if REV is a revision on the trunk
+(not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
+(defun vc-branch-part (rev)
+;; return the branch part of a revision number REV
+(substring rev 0 (string-match "\\.[0-9]+\\'" rev)))
 ;; File property caching
 (defun vc-clear-context ()
 "Clear all cached file properties and the comment ring."
 (interactive)
 (vc-file-setprop file 'vc-top-version nil)
 (vc-file-setprop file 'vc-master-locks nil))
 (progn
 (vc-file-setprop file 'vc-cvs-status nil))))
-;;; functions that operate on RCS revision numbers
+(defun vc-head-version (file)
+;; Return the RCS head version of FILE
-(defun vc-trunk-p (rev)
+(cond ((vc-file-getprop file 'vc-head-version))
-;; return t if REV is a revision on the trunk
+	(t (vc-fetch-master-properties file)
-(not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
+	   (vc-file-getprop file 'vc-head-version))))
-(defun vc-branch-part (rev)
-;; return the branch part of a revision number REV
-(substring rev 0 (string-match "\\.[0-9]+\\'" rev)))
 ;; Random helper functions
+(defun vc-latest-on-branch-p (file)
+;; return t iff the current workfile version of FILE is
+;; the latest on its branch.
+(vc-backend-dispatch file
+;; SCCS
+(string= (vc-workfile-version file) (vc-latest-version file))
+;; RCS
+(let ((workfile-version (vc-workfile-version file)) tip-version)
+(if (vc-trunk-p workfile-version)
+	   (progn
+	     ;; Re-fetch the head version number.  This is to make
+;; sure that no-one has checked in a new version behind
+	     ;; our back.
+	     (vc-fetch-master-properties file)
+	     (string= (vc-file-getprop file 'vc-head-version)
+		      workfile-version))
+	 ;; If we are not on the trunk, we need to examine the
+	 ;; whole current branch.  (vc-top-version is not what we need.)
+	 (save-excursion
+	   (set-buffer (get-buffer-create "*vc-info*"))
+	   (vc-insert-file (vc-name file) "^desc")
+	   (setq tip-version (car (vc-parse-buffer (list (list
+(concat "^\\(" (regexp-quote (vc-branch-part workfile-version))
+		     "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2)))))
+	   (if (get-buffer "*vc-info*")
+	       (kill-buffer (get-buffer "*vc-info*")))
+	   (string= tip-version workfile-version))))
+;; CVS
+(error "vc-latest-on-branch-p is not defined for CVS files")))
 (defun vc-registration-error (file)
 (if file
 (error "File %s is not under version control" file)
 (error "Buffer %s is not associated with a file" (buffer-name))))
 )
 ;;; Save a bit of the text around POSN in the current buffer, to help
 ;;; us find the corresponding position again later.  This works even
 ;;; if all markers are destroyed or corrupted.
+;;; A lot of this was shamelessly lifted from Sebastian Kremer's rcs.el mode.
 (defun vc-position-context (posn)
 (list posn
 	(buffer-size)
 	(buffer-substring posn
 			  (min (point-max) (+ posn 100)))))
 			 ;; beginning of buffer like backward-char would
 			 (search-forward context-string nil t)))
 	      ;; to beginning of OSTRING
 	      (- (point) (length context-string))))))))
-(defun vc-revert-buffer1 (&optional arg no-confirm)
+(defun vc-buffer-context ()
-;; Most of this was shamelessly lifted from Sebastian Kremer's rcs.el mode.
+;; Return a list '(point-context mark-context reparse); from which
-;; Revert buffer, try to keep point and mark where user expects them in spite
+;; vc-restore-buffer-context can later restore the context.
-;; of changes because of expanded version-control key words.
-;; This is quite important since otherwise typeahead won't work as expected.
-(interactive "P")
-(widen)
 (let ((point-context (vc-position-context (point)))
 	;; Use mark-marker to avoid confusion in transient-mark-mode.
 	(mark-context  (if (eq (marker-buffer (mark-marker)) (current-buffer))
 			   (vc-position-context (mark-marker))))
 	;; Make the right thing happen in transient-mark-mode.
 						  (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)))
-(revert-buffer arg no-confirm)
+(defun vc-restore-buffer-context (context)
+;; Restore point/mark, and reparse any affected compilation buffers.
+;; CONTEXT is that which vc-buffer-context returns.
+(let ((point-context (nth 0 context))
+	(mark-context (nth 1 context))
+	(reparse (nth 2 context)))
 ;; Reparse affected compilation buffers.
 (while reparse
 (if (car reparse)
 	  (save-excursion
 	    (set-buffer (car reparse))
 (let ((new-point (vc-find-position-by-context point-context)))
 (if new-point (goto-char new-point)))
 (if mark-context
 	(let ((new-mark (vc-find-position-by-context mark-context)))
 	  (if new-mark (set-mark new-mark))))))
+(defun vc-revert-buffer1 (&optional arg no-confirm)
+;; Revert buffer, try to keep point and mark where user expects them in spite
+;; of changes because of expanded version-control key words.
+;; This is quite important since otherwise typeahead won't work as expected.
+(interactive "P")
+(widen)
+(let ((context (vc-buffer-context)))
+(revert-buffer arg no-confirm)
+(vc-restore-buffer-context context)))
 (defun vc-buffer-sync (&optional not-urgent)
 ;; Make sure the current buffer and its working file are in sync
 ;; NOT-URGENT means it is ok to continue if the user says not to save.
 				      (if (string-match (car f) buffer-file-name)
 					  (insert (format (cdr f) (car hdstrings))))))
 			  vc-static-header-alist))
 	      )
 	    )))))
+(defun vc-clear-headers ()
+;; Clear all version headers in the current buffer, i.e. reset them
+;; to the nonexpanded form.  Only implemented for RCS, yet.
+;; Don't lose point and mark during this.
+(let ((context (vc-buffer-context)))
+(goto-char (point-min))
+(while (re-search-forward "\\$\\([A-Za-z]+\\): [^\\$]+\\$" nil t)
+(replace-match "$\\1$"))
+(vc-restore-buffer-context context)))
 ;; The VC directory submode.  Coopt Dired for this.
 ;; All VC commands get mapped into logical equivalents.
 (defvar vc-dired-prefix-map (make-sparse-keymap))
 (interactive "P")
 (if vc-dired-mode
 (find-file-other-window (dired-get-filename)))
 (while vc-parent-buffer
 (pop-to-buffer vc-parent-buffer))
-(if (eq (vc-backend (buffer-file-name)) 'CVS)
+(cond
-(error "Unchecking files under CVS is dangerous and not supported in VC"))
+((eq (vc-backend (buffer-file-name)) 'CVS)
-(let* ((target (concat (vc-latest-version (buffer-file-name))))
+(error "Unchecking files under CVS is dangerous and not supported in VC"))
-	(yours (concat (vc-your-latest-version (buffer-file-name))))
+((vc-locking-user (buffer-file-name))
-	(prompt (if (string-equal yours target)
+(error "This version is locked.  Use vc-revert-buffer to discard changes."))
-		    "Remove your version %s from master? "
+((not (vc-latest-on-branch-p (buffer-file-name)))
-		  "Version %s was not your change.  Remove it anyway? ")))
+(error "This is not the latest version.  VC cannot cancel it.")))
-(if (null (yes-or-no-p (format prompt target)))
+(let ((target (vc-workfile-version (buffer-file-name))))
+(if (null (yes-or-no-p "Remove this version from master? "))
 	nil
+(setq norevert (or norevert (not
+(yes-or-no-p "Revert buffer to most recent remaining version? "))))
 (vc-backend-uncheck (buffer-file-name) target)
-(if (or norevert
+(if (not norevert)
-	      (not (yes-or-no-p "Revert buffer to most recent remaining version? ")))
+	  (vc-checkout (buffer-file-name) nil)
-	  (vc-mode-line (buffer-file-name))
+	;; If norevert, lock the most recent remaining version,
-	(vc-checkout (buffer-file-name) nil)))
+;; and mark the buffer modified.
-))
+	(if (eq (vc-backend (buffer-file-name)) 'RCS)
+	    (progn (setq buffer-read-only nil)
+		   (vc-clear-headers)))
+	(vc-backend-checkout (buffer-file-name) t (vc-branch-part target))
+	(set-visited-file-name (buffer-file-name))
+	(vc-mode-line (buffer-file-name)))
+(message "Version %s has been removed from the master." target)
+)))
 ;;;###autoload
 (defun vc-rename-file (old new)
 "Rename file OLD to NEW, and rename its master file likewise."
 (interactive "fVC rename file: \nFRename to: ")
 (vc-file-setprop file 'vc-locking-user (user-login-name))
 (message "Stealing lock on %s...done" file)
 )
 (defun vc-backend-uncheck (file target)
-;; Undo the latest checkin.  Note: this code will have to get a lot
+;; Undo the latest checkin.
-;; smarter when we support multiple branches.
 (message "Removing last change from %s..." file)
 (vc-backend-dispatch file
 (vc-do-command nil 0 "rmdel" file 'MASTER (concat "-r" target))
 (vc-do-command nil 0 "rcs" file 'MASTER (concat "-o" target))
 nil  ;; this is never reached under CVS

Mercurial > emacs

comparison lisp/vc.el @ 12872:857663042672