(cvs-fi-up-to-date-face, cvs-fi-unknown-face): New vars.

(cvs-status-map): Don't inherit from cvs-mode-map anymore.
(cvs-filename-map, cvs-dirname-map): Remove.
(cvs-default-action): Remove.
(cvs-add-face): Use `keymap' rather than `local-map' property, and only
if the arg is really a keymap.
(cvs-fileinfo-pp): Don't use any special map for file and dir names.
Don't hardcode the mapping from state (aka type) to face, but check
the var cvs-fi-<type>-face instead.
(cvs-fileinfo-from-entries): New function.

1 files changed, 82 insertions, 32 deletions

diff --git a/lisp/pcvs-info.el b/lisp/pcvs-info.el
index 0adb7b680ea..623e24a7ba5 100644
--- a/lisp/pcvs-info.el
+++ b/lisp/pcvs-info.el
@@ -5,7 +5,7 @@
 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
 ;; Keywords: pcl-cvs
 ;; Version: $Name:  $
-;; Revision: $Id: pcvs-info.el,v 1.1 2000/03/11 03:42:29 monnier Exp $
+;; Revision: $Id: pcvs-info.el,v 1.2 2000/03/22 02:56:52 monnier Exp $
 
 ;; This file is part of GNU Emacs.
 
@@ -65,7 +65,6 @@ to confuse some users sometimes."
   :group 'pcl-cvs
   :type '(boolean))
 
-
 ;;;;
 ;;;; Faces for fontification
 ;;;;
@@ -129,6 +128,8 @@ to confuse some users sometimes."
   "PCL-CVS face used to highlight CVS messages."
   :group 'pcl-cvs)
 
+(defvar cvs-fi-up-to-date-face 'cvs-handled-face)
+(defvar cvs-fi-unknown-face 'cvs-unknown-face)
 
 ;; There is normally no need to alter the following variable, but if
 ;; your site has installed CVS in a non-standard way you might have
@@ -137,20 +138,9 @@ to confuse some users sometimes."
 (defvar cvs-bakprefix ".#"
   "The prefix that CVS prepends to files when rcsmerge'ing.")
 
-(easy-mmode-defmap cvs-filename-map
-  '(([(mouse-2)] . cvs-mode-find-file))
-  "Local keymap for text properties of file names"
-  :inherit 'cvs-mode-map)
-
 (easy-mmode-defmap cvs-status-map
   '(([(mouse-2)] . cvs-mouse-toggle-mark))
-  "Local keymap for text properties of status"
-  :inherit 'cvs-mode-map)
-
-(easy-mmode-defmap cvs-dirname-map
-  '(([(mouse-2)] . cvs-mode-find-file))
-  "Local keymap for text properties of directory names"
-  :inherit 'cvs-mode-map)
+  "Local keymap for text properties of status")
 
 ;; Constructor:
 
@@ -225,7 +215,6 @@ to confuse some users sometimes."
 	(if (string= dir "") "." (directory-file-name dir))
       ;; Here, I use `concat' rather than `expand-file-name' because I want
       ;; the resulting path to stay relative if `dir' is relative.
-      ;; I could also use `expand-file-name' with `default-directory = ""'
       (concat dir (cvs-fileinfo->file fileinfo)))))
 
 (defun cvs-fileinfo->pp-name (fi)
@@ -320,7 +309,6 @@ Most of the actions have the obvious meaning.
 ;;;; Utility functions
 ;;;;
 
-;;----------
 (defun cvs-applicable-p (fi-or-type func)
   "Check if FUNC is applicable to FI-OR-TYPE.
 If FUNC is nil, always return t.
@@ -330,23 +318,17 @@ FI-OR-TYPE can either be a symbol (a fileinfo-type) or a fileinfo."
     (and (not (eq type 'MESSAGE))
 	 (eq (car (memq func (cdr (assq type cvs-states)))) func))))
 
-;; (defun cvs-default-action (fileinfo)
-;;   "Return some kind of \"default\" action to be performed."
-;;   (second (assq (cvs-fileinfo->type fileinfo) cvs-states)))
-
-;; fileinfo pretty-printers:
-
 (defun cvs-add-face (str face &optional keymap)
   (when cvs-highlight
     (add-text-properties 0 (length str)
 			 (list* 'face face
 				(when keymap
-				  (list 'mouse-face 'highlight
-					'local-map keymap)))
+				  (list* 'mouse-face 'highlight
+					 (when (keymapp keymap)
+					   (list 'keymap keymap)))))
 			 str))
   str)
 
-;;----------
 (defun cvs-fileinfo-pp (fileinfo)
   "Pretty print FILEINFO.  Insert a printed representation in current buffer.
 For use by the cookie package."
@@ -357,7 +339,7 @@ For use by the cookie package."
      (case type
        (DIRCHANGE (concat "In directory "
 			  (cvs-add-face (cvs-fileinfo->full-path fileinfo)
-					'cvs-header-face cvs-dirname-map)
+					'cvs-header-face t)
 			  ":"))
        (MESSAGE
 	(cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo))
@@ -367,7 +349,7 @@ For use by the cookie package."
 			   (cvs-add-face "*" 'cvs-marked-face)
 			 " "))
 	       (file (cvs-add-face (cvs-fileinfo->pp-name fileinfo)
-				   'cvs-filename-face cvs-filename-map))
+				   'cvs-filename-face t))
 	       (base (or (cvs-fileinfo->base-rev fileinfo) ""))
 	       (head (cvs-fileinfo->head-rev fileinfo))
 	       (type
@@ -375,10 +357,12 @@ For use by the cookie package."
 			     ;;(MOD-CONFLICT "Not Removed")
 			     (DEAD	  "")
 			     (t (capitalize (symbol-name type)))))
-		      (face (case type
-			      (UP-TO-DATE 'cvs-handled-face)
-			      (UNKNOWN 'cvs-unknown-face)
-			      (t 'cvs-need-action-face))))
+		      (face (let ((sym (intern
+					(concat "cvs-fi-"
+						(downcase (symbol-name type))
+						"-face"))))
+			      (or (and (boundp sym) (symbol-value sym))
+				  'cvs-need-action-face))))
 		  (cvs-add-face str face cvs-status-map)))
 	       (side (or
 		      ;; maybe a subtype
@@ -405,7 +389,6 @@ For use by the cookie package."
      ((memq type '(UP-TO-DATE NEED-UPDATE))
       (setf (cvs-fileinfo->merge fi) nil)))))
 
-;;----------
 (defun cvs-fileinfo< (a b)
   "Compare fileinfo A with fileinfo B and return t if A is `less'.
 The ordering defined by this function is such that directories are
@@ -425,6 +408,73 @@ fileinfo will appear first, followed by all files (alphabetically)."
      ;; All files are sorted by file name.
      ((string< (cvs-fileinfo->file a) (cvs-fileinfo->file b))))))
 
+;;;
+;;; 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 optional, 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 (nth 5 (file-attributes (concat dir f))))
+		      (system-time-locale "C"))
+		  (equal (setq timestamp (format-time-string "%c" mtime 'utc))
+			 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))
+
 (provide 'pcvs-info)
 
 ;;; pcl-cvs-info.el ends here