;; 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."
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
(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)"))
- (t
- (vc-default-dired-state-info 'CVS file)))))
;;;
;;; State-changing functions
`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."
;;; 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',
;; 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. Note that this can never set the 'ignored
state."
- (let (file status)
+ (let (file status missing)
(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)
- ((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\\):\
+ (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."
(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,
(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 "/[^/]+"
HCoop / bpt / emacs.git / blobdiff