Function: cvs-fileinfo-from-entries

cvs-fileinfo-from-entries is a byte-compiled function defined in pcvs-info.el.gz.

Signature

(cvs-fileinfo-from-entries DIR &optional ALL)

Documentation

List of fileinfos for DIR, extracted from CVS/Entries.

Unless ALL is non-nil, returns only the files that are not up-to-date. DIR can also be a file.

Source Code

;; Defined in /usr/src/emacs/lisp/vc/pcvs-info.el.gz
;;;
;;; Look at CVS/Entries to quickly find a first approximation of the status
;;;

(defun cvs-fileinfo-from-entries (dir &optional all)
  "List of fileinfos for DIR, extracted from CVS/Entries.
Unless ALL is non-nil, returns only the files that are not up-to-date.
DIR can also be a file."
  (let* ((singlefile
	  (cond
	   ((equal dir "") nil)
	   ((file-directory-p dir) (setq dir (file-name-as-directory dir)) nil)
	   (t (prog1 (file-name-nondirectory dir)
		(setq dir (or (file-name-directory dir) ""))))))
	 (file (expand-file-name "CVS/Entries" dir))
	 (fis nil))
    (if (not (file-readable-p file))
	(push (cvs-create-fileinfo (if singlefile 'UNKNOWN 'DIRCHANGE)
				   dir (or singlefile ".") "") fis)
      (with-temp-buffer
	(insert-file-contents file)
	(goto-char (point-min))
	;; Select the single file entry in case we're only interested in a file.
	(cond
	 ((not singlefile)
	  (push (cvs-create-fileinfo 'DIRCHANGE dir "." "") fis))
	 ((re-search-forward
	   (concat "^[^/]*/" (regexp-quote singlefile) "/.*") nil t)
	  (setq all t)
	  (goto-char (match-beginning 0))
	  (narrow-to-region (point) (match-end 0)))
	 (t
	  (push (cvs-create-fileinfo 'UNKNOWN dir singlefile "") fis)
	  (narrow-to-region (point-min) (point-min))))
	(while (looking-at "\\([^/]*\\)/\\([^/]*\\)/\\([^/]*\\)/\\([^/]*\\)/")
	  (if (/= (match-beginning 1) (match-end 1))
	      (setq fis (append (cvs-fileinfo-from-entries
				 (concat dir (file-name-as-directory
					      (match-string 2)))
				 all)
				fis))
	    (let ((f (match-string 2))
		  (rev (match-string 3))
		  (date (match-string 4))
		  timestamp
		  (type 'MODIFIED)
		  (subtype nil))
	      (cond
	       ((equal (substring rev 0 1) "-")
		(setq type 'REMOVED rev (substring rev 1)))
	       ((not (file-exists-p (concat dir f))) (setq type 'MISSING))
	       ((equal rev "0") (setq type 'ADDED rev nil))
	       ((equal date "Result of merge") (setq subtype 'MERGED))
	       ((let ((mtime (file-attribute-modification-time
			      (file-attributes (concat dir f))))
		      (system-time-locale "C"))
		  (setq timestamp (format-time-string "%c" mtime t))
		  ;; Solaris sometimes uses "Wed Sep 05", not "Wed Sep  5".
		  ;; See "grep '[^a-z_]ctime' cvs/src/*.c" for reference.
		  (if (= (aref timestamp 8) ?0)
		      (setq timestamp (concat (substring timestamp 0 8)
					      " " (substring timestamp 9))))
		  (equal timestamp date))
		(setq type (if all 'UP-TO-DATE)))
	       ((equal date (concat "Result of merge+" timestamp))
		(setq type 'CONFLICT)))
	      (when type
		(push (cvs-create-fileinfo type dir f ""
					   :base-rev rev :subtype subtype)
		      fis))))
	  (forward-line 1))))
    fis))