Function: vc-cvs-dir-extra-headers

vc-cvs-dir-extra-headers is a byte-compiled function defined in vc-cvs.el.gz.

Signature

(vc-cvs-dir-extra-headers DIR)

Documentation

Extract and represent per-directory properties of a CVS working copy.

Source Code

;; Defined in /usr/src/emacs/lisp/vc/vc-cvs.el.gz
(defun vc-cvs-dir-extra-headers (_dir)
  "Extract and represent per-directory properties of a CVS working copy."
  (let ((repo
	 (condition-case nil
	     (with-temp-buffer
	       (insert-file-contents "CVS/Root")
	       (goto-char (point-min))
	       (and (looking-at ":ext:") (delete-char 5))
	       (concat (buffer-substring (point) (1- (point-max))) "\n"))
	   (file-error nil)))
	(module
	 (condition-case nil
	     (with-temp-buffer
	       (insert-file-contents "CVS/Repository")
	       (goto-char (point-min))
	       (skip-chars-forward "^\n")
	       (concat (buffer-substring (point-min) (point)) "\n"))
	   (file-error nil))))
    (concat
     (cond (repo
	    (concat (propertize "Repository : " 'face 'vc-dir-header)
                    (propertize repo 'face 'vc-dir-header-value)))
	   (t ""))
     (cond (module
	    (concat (propertize "Module     : " 'face 'vc-dir-header)
                    (propertize module 'face 'vc-dir-header-value)))
	   (t ""))
     (if (file-readable-p "CVS/Tag")
	 (let ((tag (vc-cvs-file-to-string "CVS/Tag")))
	   (cond
	    ((string-match "\\`T" tag)
	     (concat (propertize "Tag        : " 'face 'vc-dir-header)
		     (propertize (substring tag 1)
				 'face 'vc-dir-header-value)))
	    ((string-match "\\`D" tag)
	     (concat (propertize "Date       : " 'face 'vc-dir-header)
		     (propertize (substring tag 1)
				 'face 'vc-dir-header-value)))
	    (t ""))))

     ;; In CVS, branch is a per-file property, not a per-directory property.
     ;; We can't really do this here without making dangerous assumptions.
     ;;(propertize "Branch:     " 'face 'vc-dir-header)
     ;;(propertize "ADD CODE TO PRINT THE BRANCH NAME\n"
     ;;	 'face 'font-lock-warning-face)
     )))