X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/18e1f24981ba72ede1fb434568e18ed0e46debbd..739d627a477191703f57ca4cfbd1bf8dc25625f9:/lisp/vc-cvs.el diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el index f5c86d4ead..0d1a2be916 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 @@ -207,9 +207,10 @@ See also variable `vc-cvs-sticky-date-format-string'." ;; Otherwise consider it `edited'. (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) (lastmod (nth 5 (file-attributes file)))) - (if (equal checkout-time lastmod) - 'up-to-date - 'edited))) + (cond + ((equal checkout-time lastmod) 'up-to-date) + ((string= (vc-working-revision file) "0") 'added) + (t 'edited)))) (defun vc-cvs-dir-state (dir) "Find the CVS state of all files in DIR and subdirectories." @@ -261,16 +262,11 @@ Handle the special case of a CVS file that is added but not yet committed and support display of sticky tags." (let* ((sticky-tag (vc-file-getprop file 'vc-cvs-sticky-tag)) help-echo - (string - (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") - "CVS @@") - (let ((def-ml (vc-default-mode-line-string 'CVS file))) - (setq help-echo - (get-text-property 0 'help-echo def-ml)) - def-ml)))) + (string + (let ((def-ml (vc-default-mode-line-string 'CVS file))) + (setq help-echo + (get-text-property 0 'help-echo def-ml)) + def-ml))) (propertize (if (zerop (length sticky-tag)) string @@ -279,15 +275,6 @@ committed and support display of sticky tags." (concat string "[" sticky-tag "]")) 'help-echo help-echo))) -(defun vc-cvs-dired-state-info (file) - "CVS-specific version of `vc-dired-state-info'." - (let ((cvs-state (vc-state file))) - (cond ((eq cvs-state 'edited) - (if (equal (vc-working-revision file) "0") - "(added)" "(modified)")) - ((eq cvs-state 'needs-patch) "(patch)") - ((eq cvs-state 'needs-merge) "(merge)")))) - ;;; ;;; State-changing functions @@ -299,15 +286,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." @@ -454,7 +444,7 @@ The changes are between FIRST-REVISION and SECOND-REVISION." (message "Merging changes into %s..." file) ;; (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*") @@ -649,11 +639,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 () @@ -731,6 +724,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', @@ -816,38 +812,53 @@ For an empty string, nil is returned (invalid CVS root)." ;; Normalize CVS root record (list method user host root))))) +;; XXX: This does not work correctly for subdirectories. "cvs status" +;; information is context sensitive, it contains lines like: +;; cvs status: Examining DIRNAME +;; and the file entries after that don't show the full path. +;; Because of this vc-dired only shows changed files at the top level +;; for CVS. (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." - (let (file status) +essential information. Note that this can never set the 'ignored +state." + (let (file status missing) (goto-char (point-min)) - (if (re-search-forward "^File: " nil t) - (cond - ((looking-at "no file") nil) - ((re-search-forward "\\=\\([^ \t]+\\)" nil t) - (setq file (expand-file-name (match-string 1))) - (vc-file-setprop file 'vc-backend 'CVS) - (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t)) - (setq status "Unknown") - (setq status (match-string 1))) - (if (and full - (re-search-forward - "\\(RCS Version\\|RCS Revision\\|Repository revision\\):\ + (while (looking-at "? \\(.*\\)") + (setq file (expand-file-name (match-string 1))) + (vc-file-setprop file 'vc-state 'unregistered) + (forward-line 1)) + (when (re-search-forward "^File: " nil t) + (when (setq missing (looking-at "no file ")) + (goto-char (match-end 0))) + (cond + ((re-search-forward "\\=\\([^ \t]+\\)" nil t) + (setq file (expand-file-name (match-string 1))) + (vc-file-setprop file 'vc-backend 'CVS) + (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t)) + (setq status "Unknown") + (setq status (match-string 1))) + (if (and full + (re-search-forward + "\\(RCS Version\\|RCS Revision\\|Repository revision\\):\ \[\t ]+\\([0-9.]+\\)" - nil t)) - (vc-file-setprop file 'vc-latest-revision (match-string 2))) - (vc-file-setprop - file 'vc-state - (cond - ((string-match "Up-to-date" status) - (vc-file-setprop file 'vc-checkout-time - (nth 5 (file-attributes file))) - 'up-to-date) - ((string-match "Locally Modified" status) 'edited) - ((string-match "Needs Merge" status) 'needs-merge) - ((string-match "Needs \\(Checkout\\|Patch\\)" status) 'needs-patch) - (t 'edited)))))))) + nil t)) + (vc-file-setprop file 'vc-latest-revision (match-string 2))) + (vc-file-setprop + file 'vc-state + (cond + ((string-match "Up-to-date" status) + (vc-file-setprop file 'vc-checkout-time + (nth 5 (file-attributes file))) + 'up-to-date) + ((string-match "Locally Modified" status) 'edited) + ((string-match "Needs Merge" status) 'needs-merge) + ((string-match "Needs \\(Checkout\\|Patch\\)" status) + (if missing 'missing 'needs-patch)) + ((string-match "Locally Added" status) 'added) + ((string-match "Locally Removed" status) 'removed) + (t 'edited)))))))) (defun vc-cvs-dir-state-heuristic (dir) "Find the CVS state of all files in DIR, using only local information." @@ -862,6 +873,75 @@ essential information." (vc-cvs-parse-entry file t)))) (forward-line 1)))) +;; XXX Experimental function for the vc-dired replacement. +(defun vc-cvs-after-dir-status (update-function status-buffer) + ;; Heavily inspired by vc-cvs-parse-status. AKA a quick hack. + ;; It needs a lot of testing. + (let ((status nil) + (status-str nil) + (file nil) + (result nil) + (missing nil) + (subdir default-directory)) + (goto-char (point-min)) + (while + ;; Look for either a file entry, an unregistered file, or a + ;; directory change. + (re-search-forward + "\\(^=+\n\\([^=c?\n].*\n\\|\n\\)+\\)\\|\\(\\(^?? .*\n\\)+\\)\\|\\(^cvs status: Examining .*\n\\)" + nil t) + ;; XXX: get rid of narrowing here. + (narrow-to-region (match-beginning 0) (match-end 0)) + (goto-char (point-min)) + ;; The subdir + (when (looking-at "cvs status: Examining \\(.+\\)") + (setq subdir (expand-file-name (match-string 1)))) + ;; Unregistered files + (while (looking-at "? \\(.*\\)") + (setq file (file-relative-name + (expand-file-name (match-string 1) subdir))) + (push (cons file 'unregistered) result) + (forward-line 1)) + ;; A file entry. + (when (re-search-forward "^File: " nil t) + (when (setq missing (looking-at "no file ")) + (goto-char (match-end 0))) + (cond + ((re-search-forward "\\=\\([^ \t]+\\)" nil t) + (setq file (file-relative-name + (expand-file-name (match-string 1) subdir))) + (if (not (re-search-forward "\\=[ \t]+Status: \\(.*\\)" nil t)) + (push (cons file 'unregistered) result) + (setq status-str (match-string 1)) + (setq status + (cond + ((string-match "Up-to-date" status-str) 'up-to-date) + ((string-match "Locally Modified" status-str) 'edited) + ((string-match "Needs Merge" status-str) 'needs-merge) + ((string-match "Needs \\(Checkout\\|Patch\\)" status-str) + (if missing 'missing 'needs-patch)) + ((string-match "Locally Added" status-str) 'added) + ((string-match "Locally Removed" status-str) 'removed) + (t 'edited))) + (unless (eq status 'up-to-date) + (push (cons file status) result)))))) + (goto-char (point-max)) + (widen)) + ;; Remove the temporary buffer. + (kill-buffer (current-buffer)) + (funcall update-function result status-buffer))) + +;; XXX Experimental function for the vc-dired replacement. +(defun vc-cvs-dir-status (dir update-function status-buffer) + "Create a list of conses (file . state) for DIR." + (with-current-buffer + (get-buffer-create (expand-file-name " *VC-cvs* tmp status" dir)) + (erase-buffer) + (vc-cvs-command (current-buffer) 'async dir "status") + (vc-exec-after + `(vc-cvs-after-dir-status (quote ,update-function) ,status-buffer)) + (current-buffer))) + (defun vc-cvs-get-entries (dir) "Insert the CVS/Entries file from below DIR into the current buffer. This function ensures that the correct coding system is used for that, @@ -943,9 +1023,10 @@ 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-working-revision "0") - (if set-state (vc-file-setprop file 'vc-state 'edited))) + (if set-state (vc-file-setprop file 'vc-state 'added))) ;; normal entry ((looking-at (concat "/[^/]+" @@ -958,6 +1039,7 @@ is non-nil." ;; sticky tag "\\(.\\|\\)" ;Sticky tag type (date or tag name, could be empty) "\\(.*\\)")) ;Sticky tag + (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)