X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/bdaf8a62d53cf8d5a0dc4f0dc530ecd6fc1f44fe..4b03e20a6f086c901d7e183a905ee9097a6de0b6:/lisp/vc-cvs.el diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index f90f698275..975a24dcd4 100644 --- a/lisp/vc-cvs.el +++ b/lisp/vc-cvs.el @@ -1,7 +1,7 @@ ;;; vc-cvs.el --- non-resident support for CVS version-control ;; Copyright (C) 1995, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel @@ -212,7 +212,7 @@ See also variable `vc-cvs-sticky-date-format-string'." 'edited))) (defun vc-cvs-dir-state (dir) - "Find the CVS state of all files in DIR." + "Find the CVS state of all files in DIR and subdirectories." ;; if DIR is not under CVS control, don't do anything. (when (file-readable-p (expand-file-name "CVS/Entries" dir)) (if (vc-stay-local-p dir) @@ -221,7 +221,8 @@ See also variable `vc-cvs-sticky-date-format-string'." ;; Don't specify DIR in this command, the default-directory is ;; enough. Otherwise it might fail with remote repositories. (with-temp-buffer - (vc-cvs-command t 0 nil "status" "-l") + (buffer-disable-undo) ;; Because these buffers can get huge + (vc-cvs-command t 0 nil "status") (goto-char (point-min)) (while (re-search-forward "^=+\n\\([^=\n].*\n\\|\n\\)+" nil t) (narrow-to-region (match-beginning 0) (match-end 0)) @@ -229,13 +230,13 @@ See also variable `vc-cvs-sticky-date-format-string'." (goto-char (point-max)) (widen))))))) -(defun vc-cvs-workfile-version (file) - "CVS-specific version of `vc-workfile-version'." +(defun vc-cvs-working-revision (file) + "CVS-specific version of `vc-working-revision'." ;; There is no need to consult RCS headers under CVS, because we ;; get the workfile version for free when we recognize that a file ;; is registered in CVS. (vc-cvs-registered file) - (vc-file-getprop file 'vc-workfile-version)) + (vc-file-getprop file 'vc-working-revision)) (defun vc-cvs-checkout-model (file) "CVS-specific version of `vc-checkout-model'." @@ -261,7 +262,7 @@ committed and support display of sticky tags." (let* ((sticky-tag (vc-file-getprop file 'vc-cvs-sticky-tag)) help-echo (string - (if (string= (vc-workfile-version file) "0") + (if (string= (vc-working-revision file) "0") ;; A file that is added but not yet committed. (progn (setq help-echo "Added file (needs commit) under CVS") @@ -282,11 +283,10 @@ committed and support display of sticky tags." "CVS-specific version of `vc-dired-state-info'." (let ((cvs-state (vc-state file))) (cond ((eq cvs-state 'edited) - (if (equal (vc-workfile-version file) "0") + (if (equal (vc-working-revision file) "0") "(added)" "(modified)")) - ((eq cvs-state 'needs-patch) "(patch)") - ((eq cvs-state 'needs-merge) "(merge)")))) - + (t + (vc-default-dired-state-info 'CVS file))))) ;;; ;;; State-changing functions @@ -298,15 +298,18 @@ COMMENT can be used to provide an initial description of FILES. `vc-register-switches' and `vc-cvs-register-switches' are passed to the CVS command (in that order)." - (when (and (not (vc-cvs-responsible-p file)) - (vc-cvs-could-register file)) - ;; Register the directory if needed. - (vc-cvs-register (directory-file-name (file-name-directory file)))) - (apply 'vc-cvs-command nil 0 files - "add" - (and comment (string-match "[^\t\n ]" comment) - (concat "-m" comment)) - (vc-switches 'CVS 'register))) + ;; Register the directories if needed. + (let (dirs) + (dolist (file files) + (and (not (vc-cvs-responsible-p file)) + (vc-cvs-could-register file) + (push (directory-file-name (file-name-directory file)) dirs))) + (if dirs (vc-cvs-register dirs))) + (apply 'vc-cvs-command nil 0 files + "add" + (and comment (string-match "[^\t\n ]" comment) + (concat "-m" comment)) + (vc-switches 'CVS 'register))) (defun vc-cvs-responsible-p (file) "Return non-nil if CVS thinks it is responsible for FILE." @@ -330,7 +333,7 @@ its parents." (defun vc-cvs-checkin (files rev comment) "CVS-specific version of `vc-backend-checkin'." - (unless (or (not rev) (vc-cvs-valid-version-number-p rev)) + (unless (or (not rev) (vc-cvs-valid-revision-number-p rev)) (if (not (vc-cvs-valid-symbolic-tag-name-p rev)) (error "%s is not a valid symbolic tag name" rev) ;; If the input revison is a valid symbolic tag name, we create it @@ -351,7 +354,7 @@ its parents." ((re-search-forward "Up-to-date check failed" nil t) (mapc (lambda (file) (vc-file-setprop file 'vc-state 'needs-merge)) files) - (error (substitute-command-keys + (error "%s" (substitute-command-keys (concat "Up-to-date check failed: " "type \\[vc-next-action] to merge in changes")))) (t @@ -359,12 +362,12 @@ its parents." (goto-char (point-min)) (shrink-window-if-larger-than-buffer) (error "Check-in failed")))) - ;; Single-file commit? Then update the version by parsing the buffer. + ;; Single-file commit? Then update the revision by parsing the buffer. ;; Otherwise we can't necessarily tell what goes with what; clear ;; its properties so they have to be refetched. (if (= (length files) 1) (vc-file-setprop - (car files) 'vc-workfile-version + (car files) 'vc-working-revision (vc-parse-buffer "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" 2)) (mapc (lambda (file) (vc-file-clearprops file)) files)) ;; Anyway, forget the checkout model of the file, because we might have @@ -379,7 +382,7 @@ its parents." (if (and rev (not (vc-cvs-valid-symbolic-tag-name-p rev))) (vc-cvs-command nil 0 files "update" "-A")))) -(defun vc-cvs-find-version (file rev buffer) +(defun vc-cvs-find-revision (file rev buffer) (apply 'vc-cvs-command buffer 0 file "-Q" ; suppress diagnostic output @@ -404,8 +407,8 @@ REV is the revision to check out." (vc-cvs-command nil 0 file "edit") (set-file-modes file (logior (file-modes file) 128)) (if (equal file buffer-file-name) (toggle-read-only -1)))) - ;; Check out a particular version (or recreate the file). - (vc-file-setprop file 'vc-workfile-version nil) + ;; Check out a particular revision (or recreate the file). + (vc-file-setprop file 'vc-working-revision nil) (apply 'vc-cvs-command nil 0 file (and editable "-w") "update" @@ -426,7 +429,7 @@ REV is the revision to check out." (vc-cvs-command nil 0 file "commit" "-mRemoved.")) (defun vc-cvs-revert (file &optional contents-done) - "Revert FILE to the version on which it was based." + "Revert FILE to the working revision on which it was based." (vc-default-revert 'CVS file contents-done) (unless (eq (vc-checkout-model file) 'implicit) (if vc-cvs-use-edit @@ -434,13 +437,13 @@ REV is the revision to check out." ;; Make the file read-only by switching off all w-bits (set-file-modes file (logand (file-modes file) 3950))))) -(defun vc-cvs-merge (file first-version &optional second-version) +(defun vc-cvs-merge (file first-revision &optional second-revision) "Merge changes into current working copy of FILE. -The changes are between FIRST-VERSION and SECOND-VERSION." +The changes are between FIRST-REVISION and SECOND-REVISION." (vc-cvs-command nil 0 file "update" "-kk" - (concat "-j" first-version) - (concat "-j" second-version)) + (concat "-j" first-revision) + (concat "-j" second-revision)) (vc-file-setprop file 'vc-state 'edited) (with-current-buffer (get-buffer "*vc*") (goto-char (point-min)) @@ -451,18 +454,18 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (defun vc-cvs-merge-news (file) "Merge in any new changes made to FILE." (message "Merging changes into %s..." file) - ;; (vc-file-setprop file 'vc-workfile-version nil) + ;; (vc-file-setprop file 'vc-working-revision nil) (vc-file-setprop file 'vc-checkout-time 0) - (vc-cvs-command nil 0 file "update") + (vc-cvs-command nil nil file "update") ;; Analyze the merge result reported by CVS, and set ;; file properties accordingly. (with-current-buffer (get-buffer "*vc*") (goto-char (point-min)) - ;; get new workfile version + ;; get new working revision (if (re-search-forward "^Merging differences between [0-9.]* and \\([0-9.]*\\) into" nil t) - (vc-file-setprop file 'vc-workfile-version (match-string 1)) - (vc-file-setprop file 'vc-workfile-version nil)) + (vc-file-setprop file 'vc-working-revision (match-string 1)) + (vc-file-setprop file 'vc-working-revision nil)) ;; get file status (prog1 (if (eq (buffer-size) 0) @@ -494,16 +497,21 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (error "Couldn't analyze cvs update result"))) (message "Merging changes into %s...done" file)))) +(defun vc-cvs-modify-change-comment (files rev comment) + "Modify the change comments for FILES on a specified REV. +Will fail unless you have administrative privileges on the repo." + (vc-cvs-command nil 0 files "rcs" (concat "-m" comment ":" rev))) ;;; ;;; History functions ;;; (defun vc-cvs-print-log (files &optional buffer) - "Get change log associated with FILE." + "Get change logs associated with FILES." + ;; It's just the catenation of the individual logs. (vc-cvs-command buffer - (if (and (vc-stay-local-p files) (fboundp 'start-process)) 'async 0) + (if (vc-stay-local-p files) 'async 0) files "log")) (defun vc-cvs-wash-log () @@ -512,17 +520,47 @@ The changes are between FIRST-VERSION and SECOND-VERSION." nil) (defun vc-cvs-diff (files &optional oldvers newvers buffer) - "Get a difference report using CVS between two versions of FILE." - (let* ((async (and (not vc-disable-async-diff) - (vc-stay-local-p files) - (fboundp 'start-process))) - (status (apply 'vc-cvs-command (or buffer "*vc-diff*") + "Get a difference report using CVS between two revisions of FILE." + (let* ((async (and (not vc-disable-async-diff) + (vc-stay-local-p files))) + (invoke-cvs-diff-list nil) + status) + ;; Look through the file list and see if any files have backups + ;; that can be used to do a plain "diff" instead of "cvs diff". + (dolist (file files) + (let ((ov oldvers) + (nv newvers)) + (when (or (not ov) (string-equal ov "")) + (setq ov (vc-working-revision file))) + (when (string-equal nv "") + (setq nv nil)) + (let ((file-oldvers (vc-version-backup-file file ov)) + (file-newvers (if (not nv) + file + (vc-version-backup-file file nv))) + (coding-system-for-read (vc-coding-system-for-diff file))) + (if (and file-oldvers file-newvers) + (progn + (apply 'vc-do-command (or buffer "*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-oldvers) + (file-relative-name file-newvers)))) + (setq status 0)) + (push file invoke-cvs-diff-list))))) + (when invoke-cvs-diff-list + (setq status (apply 'vc-cvs-command (or buffer "*vc-diff*") (if async 'async 1) - files "diff" + invoke-cvs-diff-list "diff" (and oldvers (concat "-r" oldvers)) (and newvers (concat "-r" newvers)) (vc-switches 'CVS 'diff)))) - (if async 1 status))) ; async diff, pessimistic assumption + (if async 1 status))) ; async diff, pessimistic assumption + (defun vc-cvs-diff-tree (dir &optional rev1 rev2) "Diff all files at and below DIR." @@ -559,14 +597,14 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (set-process-filter process vc-filter) (funcall vc-filter process (substring string (match-beginning 0)))))) -(defun vc-cvs-annotate-command (file buffer &optional version) +(defun vc-cvs-annotate-command (file buffer &optional revision) "Execute \"cvs annotate\" on FILE, inserting the contents in BUFFER. -Optional arg VERSION is a version to annotate from." +Optional arg REVISION is a revision to annotate from." (vc-cvs-command buffer - (if (and (vc-stay-local-p file) (fboundp 'start-process)) + (if (vc-stay-local-p file) 'async 0) file "annotate" - (if version (concat "-r" version))) + (if revision (concat "-r" revision))) ;; Strip the leading few lines. (let ((proc (get-buffer-process buffer))) (if proc @@ -590,7 +628,8 @@ encoded as fractional days." systime, or nil if there is none." (let* ((bol (point)) (cache (get-text-property bol 'vc-cvs-annotate-time)) - buffer-read-only) + (inhibit-read-only t) + (inhibit-modification-hooks t)) (cond (cache) ((looking-at @@ -612,11 +651,14 @@ systime, or nil if there is none." bol (1+ bol) 'vc-cvs-annotate-time (setq cache (cons ;; Position at end makes for nicer overlay result. - (match-end 0) + ;; Don't put actual buffer pos here, but only relative + ;; distance, so we don't ever move backward in the + ;; goto-char below, even if the text is moved. + (- (match-end 0) (match-beginning 0)) (vc-annotate-convert-time (encode-time 0 0 0 day month year)))))))) (when cache - (goto-char (car cache)) ; fontify from here to eol + (goto-char (+ bol (car cache))) ; Fontify from here to eol. (cdr cache)))) ; days (float) (defun vc-cvs-annotate-extract-revision-at-line () @@ -632,7 +674,7 @@ systime, or nil if there is none." ;;; (defun vc-cvs-create-snapshot (dir name branchp) - "Assign to DIR's current version a given NAME. + "Assign to DIR's current revision a given NAME. If BRANCHP is non-nil, the name is created as a branch (and the current workspace is immediately moved to that new branch)." (vc-cvs-command nil 0 dir "tag" "-c" (if branchp "-b") name) @@ -662,13 +704,13 @@ If UPDATE is non-nil, then update (resynch) any affected buffers." ((or (string= state "U") (string= state "P")) (vc-file-setprop file 'vc-state 'up-to-date) - (vc-file-setprop file 'vc-workfile-version nil) + (vc-file-setprop file 'vc-working-revision nil) (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))) ((or (string= state "M") (string= state "C")) (vc-file-setprop file 'vc-state 'edited) - (vc-file-setprop file 'vc-workfile-version nil) + (vc-file-setprop file 'vc-working-revision nil) (vc-file-setprop file 'vc-checkout-time 0))) (vc-file-setprop file 'vc-cvs-sticky-tag sticky-tag) (vc-resynch-buffer file t t)))) @@ -694,6 +736,9 @@ If UPDATE is non-nil, then update (resynch) any affected buffers." ;;; Internal functions ;;; +(defun vc-cvs-root (dir) + (vc-find-root dir "CVS" t)) + (defun vc-cvs-command (buffer okstatus files &rest flags) "A wrapper around `vc-do-command' for use in vc-cvs.el. The difference to vc-do-command is that this function always invokes `cvs', @@ -782,9 +827,14 @@ For an empty string, nil is returned (invalid CVS root)." (defun vc-cvs-parse-status (&optional full) "Parse output of \"cvs status\" command in the current buffer. Set file properties accordingly. Unless FULL is t, parse only -essential information." +essential information. Note that this can never set the 'ignored +state." (let (file status) (goto-char (point-min)) + (while (looking-at "? \\(.*\\)") + (setq file (expand-file-name (match-string 1))) + (vc-file-setprop file 'vc-state 'unregistered) + (forward-line 1)) (if (re-search-forward "^File: " nil t) (cond ((looking-at "no file") nil) @@ -799,7 +849,7 @@ essential information." "\\(RCS Version\\|RCS Revision\\|Repository revision\\):\ \[\t ]+\\([0-9.]+\\)" nil t)) - (vc-file-setprop file 'vc-latest-version (match-string 2))) + (vc-file-setprop file 'vc-latest-revision (match-string 2))) (vc-file-setprop file 'vc-state (cond @@ -842,8 +892,8 @@ CVS/Entries should only be accessed through this function." (and (string-match "^[a-zA-Z]" tag) (not (string-match "[^a-z0-9A-Z-_]" tag)))) -(defun vc-cvs-valid-version-number-p (tag) - "Return non-nil if TAG is a valid version number." +(defun vc-cvs-valid-revision-number-p (tag) + "Return non-nil if TAG is a valid revision number." (and (string-match "^[0-9]" tag) (not (string-match "[^0-9.]" tag)))) @@ -906,8 +956,9 @@ is non-nil." (cond ;; entry for a "locally added" file (not yet committed) ((looking-at "/[^/]+/0/") + (vc-file-setprop file 'vc-backend 'CVS) (vc-file-setprop file 'vc-checkout-time 0) - (vc-file-setprop file 'vc-workfile-version "0") + (vc-file-setprop file 'vc-working-revision "0") (if set-state (vc-file-setprop file 'vc-state 'edited))) ;; normal entry ((looking-at @@ -921,7 +972,8 @@ is non-nil." ;; sticky tag "\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty) "\\(.*\\)")) ;Sticky tag - (vc-file-setprop file 'vc-workfile-version (match-string 1)) + (vc-file-setprop file 'vc-backend 'CVS) + (vc-file-setprop file 'vc-working-revision (match-string 1)) (vc-file-setprop file 'vc-cvs-sticky-tag (vc-cvs-parse-sticky-tag (match-string 4) (match-string 5))) @@ -961,11 +1013,11 @@ is non-nil." (push (match-string 1) res)) res))) -(defun vc-cvs-revision-completion-table (file) - (lexical-let ((file file) +(defun vc-cvs-revision-completion-table (files) + (lexical-let ((files files) table) (setq table (lazy-completion-table - table (lambda () (vc-cvs-revision-table file)))) + table (lambda () (vc-cvs-revision-table (car files))))) table))