Re: [Perlunit-devel] PDC_REFACTOR merged back

[Adam S. <ad...@sp...>]

Piers Cawley (pdc...@bo...) wrote:
> Adam Spiers <ad...@sp...> writes:
> > I use PCL-CVS under emacs (highly recommended), which amongst other
> > things makes it trivial to keep an eye out for files which should be
> > checked in but aren't. However for our peace of mind I've just done
> > a fresh checkout and it's all good.
> 
> I really must learn PCL-CVS properly. I use it but in a desultory
> fashion. 

I recently submitted a patch against emacs 21.1 to the maintainer,
which makes it quite a lot nicer (IMHO ;-)  A copy follows below, in
case you're interested.  Here is a breakdown of what it does:

  - Adds a custom variable `cvs-buffer-switch-list' controlling
    whether or not to switch to the new buffer created by a
    diff/status/log operation.

  - Adds bindings for C-up and C-down to move the point between
    directory fileinfos.

  - Adds a binding for M-t to move the point to the top directory
    fileinfo (i.e., the first node after the header).

  - Adds a binding for `.' to move to the containing (i.e. parent)
    directory.  If `.' is hit on the top-level directory, opens a new
    buffer for the parent directory.

  - Adds a binding for `v' to visit an arbitrary directory.  Defaults
    to the directory under the point.

  - Fixes the binding for RET to cvs-mode-find-file.

  - Allows the user to control whether "New directory `foo' -- ignored"
    messages appear or not, via cvs-parse-ignored-messages.  (The
    default is to display them, as before.)

And la piece de resistance ... ;-)

  - Adds the option of caching fileinfos on a per-buffer basis, for
    unbelievably quick start-up via cvs-quickdir on even huge CVS
    trees.

Index: pcvs-defs.el
===================================================================
RCS file: /share/cvsroot/adams/pcl-cvs/pcvs-defs.el,v
retrieving revision 1.1.1.3
diff -u -r1.1.1.3 pcvs-defs.el
--- pcvs-defs.el	2001/10/22 16:11:28	1.1.1.3
+++ pcvs-defs.el	2001/10/24 16:57:16
@@ -229,6 +229,14 @@
 			     (function-item cvs-status-trees)
 			     function)))))
 
+(defcustom cvs-buffer-switch-list nil
+  "*For each operation, decides whether or not to switch to the
+new buffer created when the operation is performed."
+  :group 'pcl-cvs
+  :type '(set (const "diff")
+	      (const "status")
+	      (const "log")))
+
 (defvar cvs-buffer-name '(expand-file-name "*cvs*" dir) ;; "*cvs*"
   "Name of the cvs buffer.
 This expression will be evaluated in an environment where DIR is set to
@@ -253,6 +261,22 @@
 (defvar cvs-mode-hook nil
   "Run after `cvs-mode' was setup.")
 
+(defcustom cvs-use-fileinfo-caches nil
+  "Non-nil means cache a buffer's fileinfos when it's killed, so that
+`cvs-quickdir' can retrieve them from the cache rather than from CVS/Entries
+when populating a new buffer.
+
+If you enable this, it is recommended that you add the value of
+`cvs-cache-filename' to your global .cvsignore file."
+  :group 'pcl-cvs
+  :type '(boolean))
+
+(defcustom cvs-cache-filename ".pcl-cvs-cache"
+  "The name for fileinfo cache files."
+  :group 'pcl-cvs
+  :type '(file))
+
+
 
 ;;;;
 ;;;; Internal variables, used in the process buffer.
@@ -339,6 +363,8 @@
     (" " .	cvs-mode-next-line)
     ("n" .	cvs-mode-next-line)
     ("p" .	cvs-mode-previous-line)
+    ([C-down] . cvs-mode-next-dir)
+    ([C-up]   . cvs-mode-previous-dir)
     ;; M- keys are usually those that operate on modules
     ;;("\M-C".	cvs-mode-rcs2log) ; i.e. "Create a ChangeLog"
     ;;("\M-t".	cvs-rtag)
@@ -348,6 +374,7 @@
     ("g" .	cvs-mode-revert-buffer)
     ("\M-u".	cvs-update)
     ("\M-s".	cvs-status)
+    ("\M-t".    cvs-mode-top-dir)
     ;; diff commands
     ("=" .	cvs-mode-diff)
     ("d" .	cvs-mode-diff-map)
@@ -365,19 +392,22 @@
     ("c" .	cvs-mode-commit)
     ("e" .	cvs-mode-examine)
     ("f" .	cvs-mode-find-file)
-    ([RET] .	cvs-mode-find-file)
+    ("\C-m" .	cvs-mode-find-file)
     ("i" .	cvs-mode-ignore)
     ("l" .	cvs-mode-log)
     ("o" .	cvs-mode-find-file-other-window)
     ("r" .	cvs-mode-remove)
     ("s" .	cvs-mode-status)
     ("t" .	cvs-mode-tag)
+    ("v" .      cvs-mode-examine-directory)
+    ("^" .      cvs-mode-examine-parent-directory)
+    ("." .      cvs-mode-up-level)
     ;;("v" .	cvs-mode-diff-vendor)
     ("x" .	cvs-mode-remove-handled)
     ;; cvstree bindings
     ("+" .	cvs-mode-tree)
     ;; mouse bindings
-    ([mouse-2] . cvs-mode-find-file)
+    ([(mouse-2)] . cvs-mode-find-file)
     ([(down-mouse-3)] . cvs-menu)
     ;; dired-like bindings
     ("\C-o" .   cvs-mode-display-file)
Index: pcvs-parse.el
===================================================================
RCS file: /share/cvsroot/adams/pcl-cvs/pcvs-parse.el,v
retrieving revision 1.1.1.2
retrieving revision 1.2
diff -u -r1.1.1.2 -r1.2
--- pcvs-parse.el	2001/10/22 16:11:28	1.1.1.2
+++ pcvs-parse.el	2001/10/03 15:45:47	1.2
@@ -4,7 +4,7 @@
 
 ;; Author: Stefan Monnier <mo...@cs...>
 ;; Keywords: pcl-cvs
-;; Revision: $Id: pcvs-parse.el,v 1.10 2001/09/24 16:39:23 monnier Exp $
+;; Revision: $Id: pcvs-parse.el,v 1.1 2001/10/03 13:35:56 adams Exp $
 
 ;; This file is part of GNU Emacs.
 
@@ -260,11 +260,6 @@
 	(cvs-match "\\(Examining\\|Updating\\) \\(.*\\)$" (dir 2))
 	(let ((dir (if (string= "." dir) "" (file-name-as-directory dir))))
 	  (cvs-parsed-fileinfo 'DIRCHANGE "." dir)))
-
-       ;; [-n update] A new (or pruned) directory appeared but isn't traversed
-       (and
-	(cvs-match "New directory `\\(.*\\)' -- ignored$" (dir 1))
-	(cvs-parsed-fileinfo 'MESSAGE " " (file-name-as-directory dir)))
 
        ;; File removed, since it is removed (by third party) in repository.
        (and
Index: pcvs.el
===================================================================
RCS file: /share/cvsroot/adams/pcl-cvs/pcvs.el,v
retrieving revision 1.1.1.2
retrieving revision 1.12
diff -u -r1.1.1.2 -r1.12
--- pcvs.el	2001/10/22 16:11:28	1.1.1.2
+++ pcvs.el	2001/10/24 16:58:07	1.12
@@ -873,6 +873,24 @@
   (interactive)
   (cvs-examine default-directory t))
 
+(defun cvs-mode-examine-directory (dir)
+  "Run `cvs-examine' on a specified directory with the default flags."
+  (interactive (list (cvs-query-directory-prompt "CVS Examine (directory): ")))
+  (cvs-examine dir t))
+  
+(defun cvs-mode-examine-parent-directory ()
+  "Run `cvs-examine' on a specified directory with the default flags."
+  (interactive)
+  (cvs-examine ".." t))
+  
+(defun cvs-query-directory-prompt (msg)
+  (let* ((cur-fi (ewoc-data (ewoc-locate cvs-cookies)))
+         (default-dir (if (cvs-fileinfo-p cur-fi)
+                          (expand-file-name (cvs-fileinfo->dir cur-fi)
+                                            default-directory)
+                        default-directory)))
+    (read-file-name msg default-dir default-dir nil)))
+  
 (defun cvs-query-directory (msg)
   ;; last-command-char = ?\r hints that the command was run via M-x
   (if (and (cvs-buffer-p)
@@ -881,6 +899,17 @@
       default-directory
     (read-file-name msg nil default-directory nil)))
 
+(defun cvs-cache-buffer-fileinfos ()
+  "Cache the buffer of fileinfos representing a directory's CVS status
+into a file whose name is defined by `cvs-cache-filename'."
+  (when (eq major-mode 'cvs-mode)
+    (let ((cookies cvs-cookies))
+      (with-temp-file (expand-file-name cvs-cache-filename)
+        (prin1 (ewoc-map 'identity cookies) (current-buffer))))))
+
+(add-hook 'kill-buffer-hook 'cvs-cache-buffer-fileinfos)
+(add-hook 'kill-emacs-hook  'cvs-cache-buffer-fileinfos)
+
 ;;;###autoload
 (defun cvs-quickdir (dir &optional flags noshow)
   "Open a *cvs* buffer on DIR without running cvs.
@@ -902,15 +931,28 @@
     (unless (file-directory-p (expand-file-name "CVS" dir))
       (error "%s does not contain CVS controlled files" dir))
     (set-buffer cvsbuf)
-    (dolist (fi (cvs-fileinfo-from-entries ""))
+    (dolist (fi (or (cvs-fileinfo-from-cache "")
+                    (cvs-fileinfo-from-entries "")))
       (setq last (cvs-addto-collection cvs-cookies fi last)))
     (cvs-cleanup-collection cvs-cookies
-			    (eq cvs-auto-remove-handled t)
-			    cvs-auto-remove-directories
-			    nil)
+                            (eq cvs-auto-remove-handled t)
+                            cvs-auto-remove-directories
+                            nil)
     (if noshow cvsbuf
       (let ((pop-up-windows nil)) (pop-to-buffer cvsbuf)))))
 
+(defun cvs-fileinfo-from-cache (dir)
+  "If caching is enabled and a cache file exists for the given
+directory DIR, reads fileinfos from it, and returns them.  Otherwise
+returns nil."
+  (and cvs-use-fileinfo-caches
+       (let ((cache (expand-file-name cvs-cache-filename dir)))
+         (and (file-readable-p cache)
+              (with-temp-buffer
+                (insert-file-contents cache)
+                (message (format "Reading fileinfos from %s" cache))
+                (read (buffer-substring 1 (point-max))))))))
+
 ;;;###autoload
 (defun cvs-examine (directory flags &optional noshow)
   "Run a `cvs -n update' in the specified DIRECTORY.
@@ -1093,6 +1135,64 @@
   (interactive "p")
   (ewoc-goto-next cvs-cookies arg))
 
+(defun cvs-mode-previous-dir ()
+  "Go to the previous directory.  Returns the destination node."
+  (interactive)
+  (catch 'end
+    (do* ((cur-node (ewoc-goto-prev cvs-cookies 1))
+          (cur-fi (ewoc-data cur-node)))
+        ((and (cvs-fileinfo-p cur-fi)
+              (eq (cvs-fileinfo->type cur-fi) 'DIRCHANGE))
+         cur-node)
+      (setq cur-node (ewoc-goto-prev cvs-cookies 1))
+      (setq cur-fi (ewoc-data cur-node))
+      (or (cvs-fileinfo-p cur-fi) (throw 'end cur-node)))))
+
+(defun cvs-mode-next-dir ()
+  "Go to the next directory.  Returns the destination node."
+  (interactive)
+  (catch 'end
+    ;; ewoc considers being in the header equivalent to being in
+    ;; the first node (doh), so we have to compare the point's
+    ;; position with the beginning of the first node
+    (let ((first-node (ewoc-nth cvs-cookies 0)))
+      (cond ((< (point) (marker-position (ewoc-location first-node)))
+             (ewoc-goto-node cvs-cookies first-node))
+            (t
+             (do* ((cur-node (ewoc-goto-next cvs-cookies 1))
+                   (cur-fi (ewoc-data cur-node)))
+                 ((and (cvs-fileinfo-p cur-fi)
+                       (eq (cvs-fileinfo->type cur-fi) 'DIRCHANGE))
+                  cur-node)
+               (setq cur-node (ewoc-goto-next cvs-cookies 1))
+               (setq cur-fi (ewoc-data cur-node))
+               (or (cvs-fileinfo-p cur-fi) (throw 'end cur-node))))))))
+
+(defun cvs-mode-up-level ()
+  "Go to the containing directory.  Returns the new node."
+  (interactive)
+  (let* ((orig-node (ewoc-locate cvs-cookies))
+         (orig-fi (ewoc-data (or orig-node (error "Not on a fileinfo"))))
+         (orig-dir (cvs-fileinfo->dir orig-fi)))
+    (if (and (eq (cvs-fileinfo->type orig-fi) 'DIRCHANGE)
+             (equal orig-dir ""))
+        (cvs-mode-examine-parent-directory)
+      (do* ((current-node (cvs-mode-previous-dir))
+            (current-fi (ewoc-data current-node))
+            (current-dir (cvs-fileinfo->dir current-fi)))
+          ((string-match (concat "^" (regexp-quote current-dir)) orig-dir)
+           current-node)
+        (setq current-node (cvs-mode-previous-dir))
+        (setq current-fi (ewoc-data current-node))
+        (setq current-dir (cvs-fileinfo->dir current-fi))))))
+
+(defun cvs-mode-top-dir ()
+  "Go to the top-level directory in the current buffer."
+  (interactive)
+  (goto-char 0)
+  (ewoc-goto-next cvs-cookies 1)
+  (forward-line -1))
+
 ;;;;
 ;;;; Mark handling
 ;;;;
@@ -1661,7 +1761,10 @@
       ;;(set (make-local-variable 'cvs-buffer) cvs-buf)
       (let ((inhibit-read-only t)) (erase-buffer))
       (message "Running cvs %s ..." cmd)
-      (cvs-run-process args fis postproc single-dir))))
+      (cvs-run-process args fis postproc single-dir))
+    (and (member cmd cvs-buffer-switch-list)
+         (let ((w (get-buffer-window buf)))
+           (and w (select-window (get-buffer-window buf)))))))
 
 
 (defun* cvs-mode-do (cmd flags filter
cvs diff: Diffing emacs-lisp
Index: emacs-lisp/ewoc.el
===================================================================
RCS file: /share/cvsroot/adams/pcl-cvs/emacs-lisp/ewoc.el,v
retrieving revision 1.1.1.2
retrieving revision 1.3
diff -u -r1.1.1.2 -r1.3
--- emacs-lisp/ewoc.el	2001/10/22 16:16:23	1.1.1.2
+++ emacs-lisp/ewoc.el	2001/10/24 16:33:45	1.3
@@ -396,14 +396,19 @@
 it returns, if it changes it.
 
 If more than two arguments are given, the remaining
-arguments will be passed to MAP-FUNCTION."
+arguments will be passed to MAP-FUNCTION.
+
+Returns a list of all the results from all the calls to MAP-FUNCTION."
   (ewoc--set-buffer-bind-dll-let* ewoc
       ((footer (ewoc--footer ewoc))
-       (node (ewoc--node-nth dll 1)))
+       (node (ewoc--node-nth dll 1))
+       (result nil))
     (while (not (eq node footer))
-      (if (apply map-function (ewoc--node-data node) args)
-	  (ewoc--refresh-node (ewoc--pretty-printer ewoc) node))
-      (setq node (ewoc--node-next dll node)))))
+      (let ((mapped (apply map-function (ewoc--node-data node) args)))
+        (setq result (append result (list mapped)))
+        (if mapped (ewoc--refresh-node (ewoc--pretty-printer ewoc) node)))
+      (setq node (ewoc--node-next dll node)))
+    result))
 
 (defun ewoc-filter (ewoc predicate &rest args)
   "Remove all elements in EWOC for which PREDICATE returns nil.