xemacs-beta: lisp/pcl-cvs/pcl-cvs.el comparison

comparison lisp/pcl-cvs/pcl-cvs.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14

author	cvs
date	Mon, 13 Aug 2007 08:45:50 +0200
parents
children	49a24b4fd526

comparison

equal deleted inserted replaced

--1:000000000000
+:376386a54a3c
+;;;
+;;;#ident "@(#)OrigId: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp "
+;;;
+;;;#ident "@(#)cvs/contrib/pcl-cvs:$Name: r19-14 $:$Id: pcl-cvs.el,v 1.1.1.1 1996/12/18 03:32:27 steve Exp $"
+;;;
+;;; pcl-cvs.el -- A Front-end to CVS 1.3 or later.
+;;; Release 1.05-CVS-$Name: r19-14 $.
+;;; Copyright (C) 1991, 1992, 1993  Per Cederqvist
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+;;; See below for installation instructions.
+;;; There is an TeXinfo file that describes this package.  You should read it
+;;; to get the most from this package.
+;;; Mail questions and bug reports regarding this version (as included in
+;;; CVS-1.7 or newer) to the pcl-cvs support team at <pcl-cvs@cyclic.com>.
+;;; Don't try to use this with CVS 1.2 or earlier.  It won't work.  Get CVS 1.7
+;;; or newer.  Use the version of RCS best suited for the version of CVS you're
+;;; using.
+; (require 'cookie)			; from ELIB-1.0
+(load "cookie.el")
+(require 'add-log)			; for all the ChangeLog goodies
+(provide 'pcl-cvs)
+;;; -------------------------------------------------------
+;;;	    START OF THINGS TO CHECK WHEN INSTALLING
+;; also use $GNU here, since may folks might install CVS as a GNU package
+;;
+(defvar local-path (cond
+		      ((getenv "LOCAL")
+		       (getenv "LOCAL"))
+		      ((getenv "GNU")
+		       (getenv "GNU"))
+		      (t
+		       "/usr/local"))
+"*Path prefix for most locally installed things.")
+;; this isn't likely to be right all the time....
+;;
+(defvar local-gnu-path (cond
+		      ((getenv "GNU")
+		       (getenv "GNU"))
+		      (t
+		       "/usr/local"))	; or "/usr/gnu"?
+"*Path prefix for locally installed GNU software.")
+(defvar cvs-program (concat local-path "/bin/cvs")
+"*Full path to the cvs executable.")
+;; SunOS-4.1.1_U1 has "diff.c 1.12 88/08/04 SMI; from UCB 4.6 86/04/03"
+;;
+(defvar cvs-diff-program (concat local-gnu-path "/bin/diff")
+"*Full path to the best diff program you've got.
+NOTE:  there are some nasty bugs in the context diff variants of some vendor
+versions, such as the one in SunOS-4.1.1_U1")
+(defvar cvs-rmdir-program "/bin/rmdir"
+"*Full path to the rmdir program.  Typically /bin/rmdir.")
+(defvar cvs-shell "/bin/sh"
+"*Full path to a shell that can do redirection on stdout.")
+;;; Options to control various features:
+(defvar cvs-changelog-full-paragraphs t
+"If non-nil, include full ChangeLog paragraphs in the CVS log.
+This may be set in the ``local variables'' section of a ChangeLog, to
+indicate the policy for that ChangeLog.
+A ChangeLog paragraph is a bunch of log text containing no blank lines;
+a paragraph usually describes a set of changes with a single purpose,
+but perhaps spanning several functions in several files.  Changes in
+different paragraphs are unrelated.
+You could argue that the CVS log entry for a file should contain the
+full ChangeLog paragraph mentioning the change to the file, even though
+it may mention other files, because that gives you the full context you
+need to understand the change.  This is the behaviour you get when this
+variable is set to t.
+On the other hand, you could argue that the CVS log entry for a change
+should contain only the text for the changes which occurred in that
+file, because the CVS log is per-file.  This is the behaviour you get
+when this variable is set to nil.")
+(defvar cvs-cvsroot-required nil
+"*Specifies whether CVS needs to be told where the repository is.
+In CVS 1.3, if your CVSROOT environment variable is not set, and you
+do not set the `cvs-cvsroot' lisp variable, CVS will have no idea
+where to find the repository, and refuse to run.  CVS 1.4 and later
+store the repository path with the working directories, so most
+operations don't need to be told where the repository is.
+If you work with multiple repositories with CVS 1.4, it's probably
+advisable to leave your CVSROOT environment variable unset, set this
+variable to nil, and let CVS figure out where the repository is for
+itself.")
+(defvar cvs-cvsroot nil
+"*Specifies where the (current) cvs master repository is.
+Overrides the $CVSROOT variable by sending \" -d dir\" to all cvs commands.
+This switch is useful if you have multiple CVS repositories, and are not using
+a modern version of CVS that stores the current repository in CVS/Root.")
+;; Uncomment the following line if you are running on 18.57 or earlier.
+;(setq delete-exited-processes nil)
+;; Emacs version 18.57 and earlier is likely to crash if
+;; delete-exited-processes is t, since the sentinel uses lots of
+;; memory, and 18.57 forgets to GCPROT a variable if
+;; delete-exited-processes is t.
+;;;	     END OF THINGS TO CHECK WHEN INSTALLING
+;;; --------------------------------------------------------
+(defconst pcl-cvs-version "1.05-CVS-$Name: r19-14 $"
+"A string denoting the current release version of pcl-cvs.")
+;; You are NOT allowed to disable this message by default.  However, you
+;; are encouraged to inform your users that by adding
+;;	(setq cvs-inhibit-copyright-message t)
+;; to their .emacs they can get rid of it.  Just don't add that line
+;; to your default.el!
+(defvar cvs-inhibit-copyright-message nil
+"*Non-nil means don't display a Copyright message in the ``*cvs*'' buffer.")
+(defconst cvs-startup-message
+(if cvs-inhibit-copyright-message
+"PCL-CVS release 1.05-CVS-$Name: r19-14 $"
+"PCL-CVS release 1.05 from CVS release $Name: r19-14 $.
+Copyright (C) 1992, 1993 Per Cederqvist
+Pcl-cvs comes with absolutely no warranty; for details consult the manual.
+This is free software, and you are welcome to redistribute it under certain
+conditions; again, consult the TeXinfo manual for details.")
+"*Startup message for CVS.")
+(defconst pcl-cvs-bugs-address "pcl-cvs-auto-bugs@cyclic.com"
+"The destination address used for the default bug report form.")
+(defvar cvs-stdout-file nil
+"Name of the file that holds the output that CVS sends to stdout.
+This variable is buffer local.")
+(defvar cvs-lock-file nil
+"Full path to a lock file that CVS is waiting for (or was waiting for).")
+(defvar cvs-bakprefix ".#"
+"The prefix that CVS prepends to files when rcsmerge'ing.")
+(defvar cvs-erase-input-buffer nil
+"*Non-nil if input buffers should be cleared before asking for new info.")
+(defvar cvs-auto-remove-handled nil
+"*Non-nil if cvs-mode-remove-handled should be called automatically.
+If this is set to any non-nil value, entries that do not need to be checked in
+will be removed from the *cvs* buffer after every cvs-mode-commit command.")
+(defvar cvs-auto-remove-handled-directories nil
+"*Non-nil if cvs-mode-remove-handled and cvs-update should automatically
+remove empty directories.
+If this is set to any non-nil value, directories that do not contain any files
+to be checked in will be removed from the *cvs* buffer.")
+(defvar cvs-sort-ignore-file t
+"*Non-nil if cvs-mode-ignore should sort the .cvsignore automatically.")
+(defvar cvs-auto-revert-after-commit t
+"*Non-nil if committed buffers should be automatically reverted.")
+(defconst cvs-cursor-column 14
+"Column to position cursor in in cvs-mode.
+Column 0 is left-most column.")
+(defvar cvs-mode-map nil
+"Keymap for the cvs mode.")
+(defvar cvs-edit-mode-map nil
+"Keymap for the cvs edit mode (used when editing cvs log messages).")
+(defvar cvs-buffer-name "*cvs*"
+"Name of the cvs buffer.")
+(defvar cvs-commit-prompt-buffer "*cvs-commit-message*"
+"Name of buffer in which the user is prompted for a log message when
+committing files.")
+(defvar cvs-commit-buffer-require-final-newline t
+"*t says silently put a newline at the end of commit log messages.
+Non-nil but not t says ask user whether to add a newline in each such case.
+nil means don't add newlines.")
+(defvar cvs-temp-buffer-name "*cvs-tmp*"
+"*Name of the cvs temporary buffer.
+Output from cvs is placed here by synchronous commands.")
+(defvar cvs-diff-ignore-marks nil
+"*Non-nil if cvs-diff and cvs-mode-diff-backup should ignore any marked files.
+Normally they run diff on the files that are marked (with cvs-mode-mark),
+or the file under the cursor if no files are marked.  If this variable
+is set to a non-nil value they will always run diff on the file on the
+current line.")
+;;; (setq cvs-status-flags '("-v"))
+(defvar cvs-status-flags '("-v")
+"*List of flags to pass to ``cvs status''.  Default is \"-v\".")
+;;; (setq cvs-log-flags nil)
+(defvar cvs-log-flags nil
+"*List of flags to pass to ``cvs log''.  Default is none.")
+;;; (setq cvs-tag-flags nil)
+(defvar cvs-tag-flags nil
+"*List of extra flags to pass to ``cvs tag''.  Default is none.")
+;;; (setq cvs-rtag-flags nil)
+(defvar cvs-rtag-flags nil
+"*List of extra flags to pass to ``cvs rtag''.  Default is none.")
+;;; (setq cvs-diff-flags '("-u"))
+(defvar cvs-diff-flags '("-u")
+"*List of flags to use as flags to pass to ``diff'' and ``cvs diff''.
+Used by cvs-mode-diff-cvs and cvs-mode-diff-backup.  Default is \"-u\".
+Set this to \"-u\" to get a Unidiff format, or \"-c\" to get context diffs.")
+;;; (setq cvs-update-optional-flags nil)
+(defvar cvs-update-optional-flags nil
+"*List of strings to use as optional flags to pass to ``cvs update''.  Used
+by cvs-do-update, called by cvs-update, cvs-update-other-window,
+cvs-mode-update-no-prompt, and cvs-examine.  Default is none.
+For example set this to \"-j VENDOR_PREV_RELEASE -j VENDOR_TOP_RELEASE\" to
+perform an update after a new vendor release has been imported.
+To restrict the update to the current working directory, set this to \"-l\".")
+(defvar cvs-update-prog-output-skip-regexp "$"
+"*A regexp that matches the end of the output from all cvs update programs.
+That is, output from any programs that are run by CVS (by the flag -u in the
+`modules' file - see cvs(5)) when `cvs update' is performed should terminate
+with a line that this regexp matches.  It is enough that some part of the line
+is matched.
+The default (a single $) fits programs without output.")
+;;; --------------------------------------------------------
+;;; The variables below are used internally by pcl-cvs.  You should
+;;; never change them.
+(defvar cvs-buffers-to-delete nil
+"List of temporary buffers that should be discarded as soon as possible.
+Due to a bug in emacs 18.57 the sentinel can't discard them reliably.")
+(defvar cvs-update-running nil
+"This is set to nil when no process is running, and to
+the process when a cvs update process is running.")
+(defvar cvs-cookie-handle nil
+"Handle for the cookie structure that is displayed in the *cvs* buffer.")
+(defvar cvs-commit-list nil
+"Used internally by pcl-cvs.")
+;;; The cvs data structure:
+;;;
+;;; When the `cvs update' is ready we parse the output.  Every file
+;;; that is affected in some way is added as a cookie of fileinfo
+;;; (as defined below).
+;;;
+;;; cvs-fileinfo
+;;; Constructor:
+(defun cvs-create-fileinfo (type
+			    dir
+			    file-name
+			    full-log)
+"Create a fileinfo from all parameters.
+Arguments:  TYPE DIR FILE-NAME FULL-LOG.
+A fileinfo is a vector with the following fields:
+[0]  handled	      True if this file doesn't require further action.
+[1]  marked	      t/nil
+[2]  type	      One of
+			UPDATED	   - file copied from repository
+			PATCHED	   - file update with patch from repository
+			MODIFIED   - modified by you, unchanged in
+				     repository
+			ADDED	   - added by you, not yet committed
+			REMOVED	   - removed by you, not yet committed
+			CVS-REMOVED- removed, since file no longer exists
+				     in the repository.
+			MERGED	   - successful merge
+			CONFLICT   - conflict when merging (if pcl-cvs did it)
+			REM-CONFLICT-removed in repository, but altered
+				     locally.
+			MOD-CONFLICT-removed locally, changed in repository.
+REM-EXIST  - removed locally, but still exists.
+			DIRCHANGE  - A change of directory.
+			UNKNOWN	   - An unknown file.
+			UNKNOWN-DIR- An unknown directory.
+			MOVE-AWAY  - A file that is in the way.
+			REPOS-MISSING- The directory has vanished from the
+				       repository.
+MESSAGE    - This is a special fileinfo that is used
+				       to display a text that should be in
+full-log.
+[3]  dir	      Directory the file resides in.  Should not end with slash.
+[4]  file-name	      The file name.
+[5]  backup-file      The name of a backup file created during a merge.
+Only valid for MERGED and CONFLICT files.
+[6]  base-revision    The revision that the working file was based on.
+Only valid for MERGED and CONFLICT files.
+[7]  head-revision    The revision that the newly merged changes came from
+Only valid for MERGED and CONFLICT files.
+[8]  backup-revision  The revision of the cvs backup file (original working rev.)
+Only valid for MERGED and CONFLICT files.
+[9]  cvs-diff-buffer  A buffer that contains a 'cvs diff file'.
+[10] vendor-diff-buffer  A buffer that contains a 'diff base-file head-file'.
+[11] backup-diff-buffer  A buffer that contains a 'diff file backup-file'.
+[12] full-log	      The output from cvs, unparsed.
+[13] mod-time	      Modification time of file used for *-diff-buffer."
+(cons
+'CVS-FILEINFO
+(vector nil nil type dir file-name nil nil nil nil nil nil nil full-log nil nil)))
+;;; Selectors:
+(defun cvs-fileinfo->handled (cvs-fileinfo)
+"Get the  `handled' field from CVS-FILEINFO."
+(elt (cdr cvs-fileinfo) 0))
+(defun cvs-fileinfo->marked (cvs-fileinfo)
+"Check if CVS-FILEINFO is marked."
+(elt (cdr cvs-fileinfo) 1))
+(defun cvs-fileinfo->type (cvs-fileinfo)
+"Get type from CVS-FILEINFO.
+Type is one of UPDATED, PATCHED, MODIFIED, ADDED, REMOVED, CVS-REMOVED, MERGED,
+CONFLICT, REM-CONFLICT, MOD-CONFLICT, REM-EXIST, DIRCHANGE, UNKNOWN,
+UNKNOWN-DIR, MOVE-AWAY, REPOS-MISSING or MESSAGE."
+(elt (cdr cvs-fileinfo) 2))
+(defun cvs-fileinfo->dir (cvs-fileinfo)
+"Get dir from CVS-FILEINFO.
+The directory name does not end with a slash."
+(elt (cdr cvs-fileinfo) 3))
+(defun cvs-fileinfo->file-name (cvs-fileinfo)
+"Get file-name from CVS-FILEINFO."
+(elt (cdr cvs-fileinfo) 4))
+(defun cvs-fileinfo->backup-file (cvs-fileinfo)
+"Get backup-file from CVS-FILEINFO."
+(elt (cdr cvs-fileinfo) 5))
+(defun cvs-fileinfo->base-revision (cvs-fileinfo)
+"Get the base revision from CVS-FILEINFO."
+(elt (cdr cvs-fileinfo) 6))
+(defun cvs-fileinfo->head-revision (cvs-fileinfo)
+"Get the head revision from CVS-FILEINFO."
+(elt (cdr cvs-fileinfo) 7))
+(defun cvs-fileinfo->backup-revision (cvs-fileinfo)
+"Get the backup revision from CVS-FILEINFO."
+(elt (cdr cvs-fileinfo) 8))
+(defun cvs-fileinfo->cvs-diff-buffer (cvs-fileinfo)
+"Get cvs-diff-buffer from CVS-FILEINFO."
+(elt (cdr cvs-fileinfo) 9))
+(defun cvs-fileinfo->vendor-diff-buffer (cvs-fileinfo)
+"Get backup-diff-buffer from CVS-FILEINFO."
+(elt (cdr cvs-fileinfo) 10))
+(defun cvs-fileinfo->backup-diff-buffer (cvs-fileinfo)
+"Get backup-diff-buffer from CVS-FILEINFO."
+(elt (cdr cvs-fileinfo) 11))
+(defun cvs-fileinfo->full-log (cvs-fileinfo)
+"Get full-log from CVS-FILEINFO."
+(elt (cdr cvs-fileinfo) 12))
+(defun cvs-fileinfo->mod-time (cvs-fileinfo)
+"Get mod-time from CVS-FILEINFO."
+(elt (cdr cvs-fileinfo) 13))
+;;; Modifiers:
+(defun cvs-set-fileinfo->handled (cvs-fileinfo newval)
+"Set handled in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 0 newval))
+(defun cvs-set-fileinfo->marked (cvs-fileinfo newval)
+"Set marked in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 1 newval))
+(defun cvs-set-fileinfo->type (cvs-fileinfo newval)
+"Set type in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 2 newval))
+(defun cvs-set-fileinfo->dir (cvs-fileinfo newval)
+"Set dir in CVS-FILEINFO to NEWVAL.
+The directory should now end with a slash."
+(aset (cdr cvs-fileinfo) 3 newval))
+(defun cvs-set-fileinfo->file-name (cvs-fileinfo newval)
+"Set file-name in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 4 newval))
+(defun cvs-set-fileinfo->backup-file (cvs-fileinfo newval)
+"Set backup-file in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 5 newval))
+(defun cvs-set-fileinfo->base-revision (cvs-fileinfo newval)
+"Set base-revision in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 6 newval))
+(defun cvs-set-fileinfo->head-revision (cvs-fileinfo newval)
+"Set head-revision in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 7 newval))
+(defun cvs-set-fileinfo->backup-revision (cvs-fileinfo newval)
+"Set backup-revision in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 8 newval))
+(defun cvs-set-fileinfo->cvs-diff-buffer (cvs-fileinfo newval)
+"Set cvs-diff-buffer in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 9 newval))
+(defun cvs-set-fileinfo->vendor-diff-buffer (cvs-fileinfo newval)
+"Set vendor-diff-buffer in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 10 newval))
+(defun cvs-set-fileinfo->backup-diff-buffer (cvs-fileinfo newval)
+"Set backup-diff-buffer in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 11 newval))
+(defun cvs-set-fileinfo->full-log (cvs-fileinfo newval)
+"Set full-log in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 12 newval))
+(defun cvs-set-fileinfo->mod-time (cvs-fileinfo newval)
+"Set full-log in CVS-FILEINFO to NEWVAL."
+(aset (cdr cvs-fileinfo) 13 newval))
+;;; Predicate:
+(defun cvs-fileinfo-p (object)
+"Return t if OBJECT is a cvs-fileinfo."
+(eq (car-safe object) 'CVS-FILEINFO))
+;;;; End of types.
+;;----------
+(defun cvs-use-temp-buffer ()
+"Display a temporary buffer in another window and select it.
+The selected window will not be changed.  The temporary buffer will
+be erased and writable."
+(let ((dir default-directory))
+(display-buffer (get-buffer-create cvs-temp-buffer-name))
+(set-buffer cvs-temp-buffer-name)
+(setq buffer-read-only nil)
+(setq default-directory dir)
+(erase-buffer)))
+;;----------
+(defun cvs-examine (directory &optional local)
+"Run a 'cvs -n update' in the current working directory.
+That is, check what needs to be done, but don't change the disc.
+Feed the output to a *cvs* buffer and run cvs-mode on it.
+If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run.
+WARNING:  this doesn't work very well yet...."
+;; TODO:  this should do everything cvs-update does...
+;; for example, for CONFLICT files, it should setup fileinfo appropriately
+(interactive (list (read-file-name "CVS Update (directory): "
+				     nil default-directory nil)
+		     current-prefix-arg))
+(cvs-do-update directory local 'noupdate))
+;;----------
+;;;###autoload
+(defun cvs-update (directory &optional local)
+"Run a 'cvs update' in the current working directory.  Feed the
+output to a *cvs* buffer and run cvs-mode on it.
+If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run."
+(interactive (list (read-file-name "CVS Update (directory): "
+				     nil default-directory nil)
+		     current-prefix-arg))
+(cvs-do-update directory local nil)
+(switch-to-buffer cvs-buffer-name))
+;;----------
+;;;###autoload
+(defun cvs-update-other-window (directory &optional local)
+"Run a 'cvs update' in the current working directory.  Feed the
+output to a *cvs* buffer, display it in the other window, and run
+cvs-mode on it.
+If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run."
+(interactive (list (read-file-name "CVS Update other window (directory): "
+				     nil default-directory nil)
+		     current-prefix-arg))
+(cvs-do-update directory local nil)
+(switch-to-buffer-other-window cvs-buffer-name))
+;;----------
+(defun cvs-filter (predicate list &rest extra-args)
+"Apply PREDICATE to each element on LIST.
+Args:  PREDICATE LIST &rest EXTRA-ARGS.
+Return a new list consisting of those elements that PREDICATE
+returns non-nil for.
+If more than two arguments are given the remaining args are
+passed to PREDICATE."
+;; Avoid recursion - this should work for LONG lists also!
+(let* ((head (cons 'dummy-header nil))
+	 (tail head))
+(while list
+(if (apply predicate (car list) extra-args)
+	  (setq tail (setcdr tail (list (car list)))))
+(setq list (cdr list)))
+(cdr head)))
+;;----------
+(defun cvs-mode-update-no-prompt ()
+"Run cvs update in current directory."
+(interactive)
+(cvs-do-update default-directory nil nil))
+;;----------
+(defun cvs-do-update (directory local dont-change-disc)
+"Do a 'cvs update' in DIRECTORY.
+Args:  DIRECTORY LOCAL DONT-CHANGE-DISC.
+If LOCAL is non-nil 'cvs update -l' is executed.
+If DONT-CHANGE-DISC is non-nil 'cvs -n update' is executed.
+Both LOCAL and DONT-CHANGE-DISC may be non-nil simultaneously.
+*Note*:  DONT-CHANGE-DISC does not yet work.  The parser gets confused."
+(save-some-buffers)
+;; Ensure that it is safe to do an update.  If not, ask user
+;; for confirmation.
+(if (and (boundp 'cvs-cookie-handle) (collection-buffer cvs-cookie-handle))
+(if (collection-collect-tin
+	   cvs-cookie-handle
+	   '(lambda (cookie) (eq (cvs-fileinfo->type cookie) 'CONFLICT)))
+	  (if (not
+	       (yes-or-no-p
+		"Only update if conflicts have been resolved.  Continue? "))
+	      (error "Update aborted by user request."))))
+(if (not (file-exists-p cvs-program))
+(error "%s: file not found (check setting of cvs-program)"
+	     cvs-program))
+(let* ((this-dir (file-name-as-directory (expand-file-name directory)))
+	 (update-buffer (generate-new-buffer
+			 (concat " " (file-name-nondirectory
+				      (substring this-dir 0 -1))
+				 "-update")))
+	 (temp-name (make-temp-name
+		     (concat (file-name-as-directory
+			      (or (getenv "TMPDIR") "/tmp"))
+			     "pcl-cvs.")))
+	 (args nil))
+;; Check that this-dir exists and is a directory that is under CVS contr.
+(if (not (file-directory-p this-dir))
+	(error "%s is not a directory." this-dir))
+(if (not (file-directory-p (concat this-dir "CVS")))
+	(error "%s does not contain CVS controlled files." this-dir))
+(if (file-readable-p (concat this-dir "CVS/Root"))
+	(save-excursion		; read CVS/Root into cvs-cvsroot
+	  (find-file (concat this-dir "CVS/Root"))
+	  (goto-char (point-min))
+	  (setq cvs-cvsroot (buffer-substring (point)
+					      (progn (end-of-line) (point))))
+	  (if (not cvs-cvsroot)
+	      (error "Invalid contents of %sCVS/Root" this-dir))
+	  (kill-buffer (current-buffer)))
+(if (and cvs-cvsroot-required
+	       (not (or (getenv "CVSROOT") cvs-cvsroot)))
+	  (error "Both cvs-cvsroot and environment variable CVSROOT are unset, and no CVS/Root.")))
+;; Check that at most one `cvs update' is run at any time.
+(if (and cvs-update-running (process-status cvs-update-running)
+	     (or (eq (process-status cvs-update-running) 'run)
+		 (eq (process-status cvs-update-running) 'stop)))
+	(error "Can't run two `cvs update' simultaneously."))
+(if (not (listp cvs-update-optional-flags))
+	(error "cvs-update-optional-flags should be set using cvs-set-update-optional-flags"))
+;; Generate "-d /master -n update -l".
+(setq args (concat (if cvs-cvsroot (concat " -d " cvs-cvsroot))
+		       (if dont-change-disc " -n ")
+		       " update "
+		       (if local " -l ")
+		       (if cvs-update-optional-flags
+			   (mapconcat 'identity
+				      (copy-sequence cvs-update-optional-flags)
+				      " "))))
+;; Set up the buffer that receives the stderr output from "cvs update".
+(set-buffer update-buffer)
+(setq default-directory this-dir)
+(make-local-variable 'cvs-stdout-file)
+(setq cvs-stdout-file temp-name)
+(setq cvs-update-running
+	  (let ((process-connection-type nil)) ; Use a pipe, not a pty.
+	    (start-process "cvs" update-buffer cvs-shell "-c"
+			   (concat cvs-program " " args " > " temp-name))))
+(setq mode-line-process
+	  (concat ": "
+		  (symbol-name (process-status cvs-update-running))))
+; XEmacs change
+(redraw-modeline)	; Update the mode line.
+(set-process-sentinel cvs-update-running 'cvs-sentinel)
+(set-process-filter cvs-update-running 'cvs-update-filter)
+(set-marker (process-mark cvs-update-running) (point-min))
+(save-excursion
+(set-buffer (get-buffer-create cvs-buffer-name))
+(setq buffer-read-only nil)
+(erase-buffer)
+(cvs-mode))
+(setq cvs-cookie-handle
+	  (collection-create
+	   cvs-buffer-name 'cvs-pp
+	   cvs-startup-message		;See comment above cvs-startup-message.
+	   "---------- End -----"))
+(cookie-enter-first
+cvs-cookie-handle
+(cvs-create-fileinfo
+'MESSAGE nil nil (concat "\n    Running `cvs " args "' in " this-dir
+			       "...\n")))
+(save-excursion
+(set-buffer cvs-buffer-name)
+(setq mode-line-process
+	    (concat ": "
+		    (symbol-name (process-status cvs-update-running))))
+; XEmacs change
+(redraw-modeline)	; Update the mode line.
+(setq buffer-read-only t))
+;; Work around a bug in emacs 18.57 and earlier.
+(setq cvs-buffers-to-delete
+	  (cvs-delete-unused-temporary-buffers cvs-buffers-to-delete)))
+;; The following line is said to improve display updates on some
+;; emacses.  It shouldn't be needed, but it does no harm.
+(sit-for 0))
+;;----------
+(defun cvs-delete-unused-temporary-buffers (list)
+"Delete all buffers on LIST that is not visible.
+Return a list of all buffers that still is alive."
+(cond
+((null list) nil)
+((get-buffer-window (car list))
+(cons (car list)
+	  (cvs-delete-unused-temporary-buffers (cdr list))))
+(t
+(kill-buffer (car list))
+(cvs-delete-unused-temporary-buffers (cdr list)))))
+;;----------
+(put 'cvs-mode 'mode-class 'special)
+;;----------
+(defun cvs-mode ()
+"\\<cvs-mode-map>Mode used for pcl-cvs, a front-end to CVS.
+To get to the \"*cvs*\" buffer you should use ``\\[execute-extended-command] cvs-update''.
+Full documentation is in the Texinfo file.  Here are the most useful commands:
+\\[cvs-mode-previous-line] Move up.                    \\[cvs-mode-next-line] Move down.
+\\[cvs-mode-commit]   Commit file.                \\[cvs-mode-update-no-prompt]   Re-update directory.
+\\[cvs-mode-mark]   Mark file/dir.              \\[cvs-mode-unmark]   Unmark file/dir.
+\\[cvs-mode-mark-all-files]   Mark all files.             \\[cvs-mode-unmark-all-files]   Unmark all files.
+\\[cvs-mode-find-file]   Edit file/run Dired.        \\[cvs-mode-find-file-other-window]   Find file or run Dired in other window.
+\\[cvs-mode-ignore]   Add file to ./.cvsignore.   \\[cvs-mode-add-change-log-entry-other-window]   Write ChangeLog in other window.
+\\[cvs-mode-add]   Add to repository.          \\[cvs-mode-remove-file]   Remove file.
+\\[cvs-mode-diff-cvs]   Diff with base revision.    \\[cvs-mode-diff-backup]   Diff backup file.
+\\[cvs-mode-ediff]   Ediff base rev & backup.    \\[cvs-mode-diff-vendor]   Show merge from vendor branch.
+\\[cvs-mode-emerge]   Emerge base rev & backup.   \\[cvs-mode-diff-backup]   Diff backup file.
+\\[cvs-mode-acknowledge] Delete line from buffer.    \\[cvs-mode-remove-handled]   Remove processed entries.
+\\[cvs-mode-log]   Run ``cvs log''.            \\[cvs-mode-status]   Run ``cvs status''.
+\\[cvs-mode-tag]   Run ``cvs tag''.            \\[cvs-mode-rtag]   Run ``cvs rtag''.
+\\[cvs-mode-changelog-commit]   Like \\[cvs-mode-commit], but get default log text from ChangeLog.
+\\[cvs-mode-undo-local-changes]   Revert the last checked in version - discard your changes to the file.
+Entry to this mode runs cvs-mode-hook.
+This description is updated for release 1.05-CVS-$Name: r19-14 $ of pcl-cvs.
+All bindings:
+\\{cvs-mode-map}"
+(interactive)
+(setq major-mode 'cvs-mode)
+(setq mode-name "CVS")
+(setq mode-line-process nil)
+;; for older v18 emacs
+;;(buffer-flush-undo (current-buffer))
+(buffer-disable-undo (current-buffer))
+(make-local-variable 'goal-column)
+(setq goal-column cvs-cursor-column)
+(use-local-map cvs-mode-map)
+(run-hooks 'cvs-mode-hook))
+;;----------
+(defun cvs-sentinel (proc msg)
+"Sentinel for the cvs update process.
+This is responsible for parsing the output from the cvs update when
+it is finished."
+(cond
+((null (buffer-name (process-buffer proc)))
+;; buffer killed
+(set-process-buffer proc nil))
+((memq (process-status proc) '(signal exit))
+(let* ((obuf (current-buffer))
+	   (omax (point-max))
+	   (opoint (point)))
+;; save-excursion isn't the right thing if
+;;  process-buffer is current-buffer
+(unwind-protect
+	  (progn
+	    (set-buffer (process-buffer proc))
+	    (setq mode-line-process
+		  (concat ": "
+			  (symbol-name (process-status proc))))
+	    (let* ((out-file cvs-stdout-file)
+		   (stdout-buffer (find-file-noselect out-file)))
+	      (save-excursion
+		(set-buffer stdout-buffer)
+		(rename-buffer (concat " "
+				       (file-name-nondirectory out-file)) t))
+	      (cvs-parse-update stdout-buffer (process-buffer proc))
+	      (setq cvs-buffers-to-delete
+		    (cons (process-buffer proc)
+			  (cons stdout-buffer
+				cvs-buffers-to-delete)))
+	      (delete-file out-file)))
+	(message "CVS update process has completed.")   ; XEmacs
+	(set-buffer-modified-p (buffer-modified-p))
+	(setq cvs-update-running nil))
+(if (equal obuf (process-buffer proc))
+	  nil
+	(set-buffer (process-buffer proc))
+	(if (< opoint omax)
+	    (goto-char opoint))
+	(set-buffer obuf))))))
+;;----------
+(defun cvs-update-filter (proc string)
+"Filter function for pcl-cvs.
+This function gets the output that CVS sends to stderr.  It inserts it
+into (process-buffer proc) but it also checks if CVS is waiting for a
+lock file.  If so, it inserts a message cookie in the *cvs* buffer."
+(let ((old-buffer (current-buffer))
+	(data (match-data)))
+(unwind-protect
+	(progn
+	  (set-buffer (process-buffer proc))
+	  (save-excursion
+	    ;; Insert the text, moving the process-marker.
+	    (goto-char (process-mark proc))
+	    (insert string)
+	    (set-marker (process-mark proc) (point))
+	    ;; Delete any old lock message
+	    (if (tin-nth cvs-cookie-handle 1)
+		(tin-delete cvs-cookie-handle
+			    (tin-nth cvs-cookie-handle 1)))
+	    ;; Check if CVS is waiting for a lock.
+	    (beginning-of-line 0)	;Move to beginning of last
+					;complete line.
+	    (cond
+	     ((looking-at
+	       "^cvs \\(update\\|server\\): \\[..:..:..\\] waiting for \\(.*\\)lock in \\(.*\\)$")
+	      (setq cvs-lock-file (buffer-substring (match-beginning 3)
+						    (match-end 3)))
+	      (cookie-enter-last
+	       cvs-cookie-handle
+	       (cvs-create-fileinfo
+		'MESSAGE nil nil
+		(concat "\tWaiting for "
+			(buffer-substring (match-beginning 2)
+					  (match-end 2))
+			"lock in " cvs-lock-file
+			".\n\t (type M-x cvs-delete-lock to delete it)")))))))
+(store-match-data data)
+(set-buffer old-buffer))))
+;;----------
+(defun cvs-delete-lock ()
+"Delete the lock file that CVS is waiting for.
+Note that this can be dangerous.  You should only do this
+if you are convinced that the process that created the lock is dead."
+(interactive)
+(cond
+((not (or (file-exists-p
+	      (concat (file-name-as-directory cvs-lock-file) "#cvs.lock"))
+	     (cvs-filter (function cvs-lock-file-p)
+			 (directory-files cvs-lock-file))))
+(error "No lock files found."))
+((yes-or-no-p (concat "Really delete locks in " cvs-lock-file "? "))
+;; Re-read the directory -- the locks might have disappeared.
+(let ((locks (cvs-filter (function cvs-lock-file-p)
+			     (directory-files cvs-lock-file))))
+(while locks
+	(delete-file (concat (file-name-as-directory cvs-lock-file)
+			     (car locks)))
+	(setq locks (cdr locks)))
+(cvs-remove-directory
+(concat (file-name-as-directory cvs-lock-file) "#cvs.lock"))))))
+;;----------
+(defun cvs-remove-directory (dir)
+"Remove a directory."
+(if (file-directory-p dir)
+(call-process cvs-rmdir-program nil nil nil dir)
+(error "Not a directory: %s" dir))
+(if (file-exists-p dir)
+(error "Could not remove directory %s" dir)))
+;;----------
+(defun cvs-lock-file-p (file)
+"Return true if FILE looks like a CVS lock file."
+(or
+(string-match "^#cvs.tfl.[0-9]+$" file)
+(string-match "^#cvs.rfl.[0-9]+$" file)
+(string-match "^#cvs.wfl.[0-9]+$" file)))
+;;----------
+(defun cvs-quote-multiword-string (str)
+"Return STR surrounded in single quotes if it contains whitespace."
+(cond ((string-match "[ \t\n]" str)
+	 (concat "'" str "'"))
+	(t
+	 str)))
+;;----------
+;; this should be in subr.el or some similar place....
+(defun parse-string (str &optional regexp)
+"Explode the string STR into a list of words ala strtok(3).  Optional REGEXP
+defines regexp matching word separator, which defaults to \"[ \\t\\n]+\"."
+(let (str-list			; new list
+	str-token			; "index" of next token
+	(str-start 0)			; "index" of current token
+	(str-sep (if regexp
+		     regexp
+		   "[ \t\n]+")))
+(while (setq str-token (string-match str-sep str str-start))
+(setq str-list
+	    (nconc str-list
+		   (list (substring str str-start str-token))))
+(setq str-start (match-end 0)))
+;; tag on the remainder as the final item
+(if (not (>= str-start (length str)))
+	(setq str-list
+	      (nconc str-list
+		     (list (substring str str-start)))))
+str-list))
+;;----------
+(defun cvs-make-list (str)
+"Return list of words made from the string STR."
+(cond ((string-match "[ \t\n]+" str)
+	 (let ((new-str (parse-string str "[ \t\n]+")))
+	   ;; this is ugly, but assume if the first element is empty, there are
+	   ;; no more elements.
+	   (cond ((string= (car new-str) "")
+		  nil)
+		 (t
+		  new-str))))
+	((string= str "")
+	 nil)
+	(t
+	 (list str))))
+;;----------
+(defun cvs-skip-line (stdout stderr regexp &optional arg)
+"Like forward-line, but check that the skipped line matches REGEXP.
+Args:  STDOUT STDERR REGEXP &optional ARG.
+If it doesn't match REGEXP a bug report is generated and displayed.
+STDOUT and STDERR is only used to do that.
+If optional ARG, a number, is given the ARGth parenthesized expression
+in the REGEXP is returned as a string.
+Point should be in column 1 when this function is called."
+(cond
+((looking-at regexp)
+(forward-line 1)
+(if arg
+	(buffer-substring (match-beginning arg)
+			  (match-end arg))))
+(t
+(cvs-parse-error stdout
+		     stderr
+		     (if (eq (current-buffer) stdout)
+			 'STDOUT
+		       'STDERR)
+		     (point)
+		     regexp))))
+;;----------
+(defun cvs-get-current-dir (root-dir dirname)
+"Return current working directory, suitable for cvs-parse-update.
+Args:  ROOT-DIR DIRNAME.
+Concatenates ROOT-DIR and DIRNAME to form an absolute path."
+(if (string= "." dirname)
+(substring root-dir 0 -1)
+(concat root-dir dirname)))
+;;----------
+(defun cvs-compare-fileinfos (a b)
+"Compare fileinfo A with fileinfo B and return t if A is `less'."
+(cond
+;; Sort acording to directories.
+((string< (cvs-fileinfo->dir a) (cvs-fileinfo->dir b)) t)
+((not (string= (cvs-fileinfo->dir a) (cvs-fileinfo->dir b))) nil)
+;; The DIRCHANGE entry is always first within the directory.
+((and (eq (cvs-fileinfo->type a) 'DIRCHANGE)
+	 (not (eq (cvs-fileinfo->type b) 'DIRCHANGE))) t)
+((and (eq (cvs-fileinfo->type b) 'DIRCHANGE)
+	 (not (eq (cvs-fileinfo->type a) 'DIRCHANGE))) nil)
+;; All files are sorted by file name.
+((string< (cvs-fileinfo->file-name a) (cvs-fileinfo->file-name b)))))
+;;----------
+(defun cvs-parse-error (stdout-buffer stderr-buffer err-buf pos &optional indicator)
+"Handle a parse error when parsing the output from cvs.
+Args:  STDOUT-BUFFER STDERR-BUFFER ERR-BUF POS &optional INDICATOR.
+ERR-BUF should be 'STDOUT or 'STDERR."
+(setq pos (1- pos))
+(set-buffer cvs-buffer-name)
+(setq buffer-read-only nil)
+(erase-buffer)
+(insert "To: " pcl-cvs-bugs-address "\n")
+(insert "Subject: pcl-cvs release" pcl-cvs-version " parse error.\n")
+(insert (concat mail-header-separator "\n"))
+(insert "This bug report is automatically generated by pcl-cvs\n")
+(insert "because it doesn't understand some output from CVS.  Below\n")
+(insert "is detailed information about the error.  Please send\n")
+(insert "this, together with any information you think might be\n")
+(insert "useful for me to fix the bug, to the address above.  But\n")
+(insert "please check the \"known problems\" section of the\n")
+(insert "documentation first.  Note that this buffer contains\n")
+(insert "information that you might consider confidential.  You\n")
+(insert "are encouraged to read through it before sending it.\n")
+(insert "\n")
+(insert "Press C-c C-c to send this email.\n\n")
+(insert "Please state the version of these programs you are using:\n\n")
+(insert "RCS:  \ndiff: \n\n")
+(let* ((stdout (save-excursion (set-buffer stdout-buffer) (buffer-string)))
+	 (stderr (save-excursion (set-buffer stderr-buffer) (buffer-string)))
+	 (errstr (if (eq err-buf 'STDOUT) stdout stderr))
+	 (errline-end (string-match "\n" errstr pos))
+	 (errline (substring errstr pos errline-end)))
+(insert (format "Offending line (%d chars): >" (- errline-end pos)))
+(insert errline)
+(insert "<\n")
+(insert "Sent to " (symbol-name err-buf) " at pos " (format "%d\n" pos))
+(if indicator
+	(insert "Optional args: \"" indicator "\".\n"))
+(insert "\nEmacs-version: " (emacs-version) "\n")
+(insert "Pcl-cvs Version: "
+	    "@(#)OrigId: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp\n")
+(insert "CVS Version: "
+	    "@(#)cvs/contrib/pcl-cvs:$Name: r19-14 $:$Id: pcl-cvs.el,v 1.1.1.1 1996/12/18 03:32:27 steve Exp $\n\n")
+(insert (format "--- Contents of stdout buffer (%d chars) ---\n"
+		    (length stdout)))
+(insert stdout)
+(insert "--- End of stdout buffer ---\n")
+(insert (format "--- Contents of stderr buffer (%d chars) ---\n"
+		    (length stderr)))
+(insert stderr)
+(insert "--- End of stderr buffer ---\n")
+(insert "\nEnd of bug report.\n")
+(require 'sendmail)
+(mail-mode)
+(error "CVS parse error - please report this bug.")))
+;;----------
+(defun cvs-parse-update (stdout-buffer stderr-buffer)
+"Parse the output from `cvs update'.
+Args:  STDOUT-BUFFER STDERR-BUFFER.
+This functions parses the from `cvs update' (which should be
+separated in its stdout- and stderr-components) and prints a
+pretty representation of it in the *cvs* buffer.
+Signals an error if unexpected output was detected in the buffer."
+(let* ((head (cons 'dummy nil))
+	 (tail (cvs-parse-stderr stdout-buffer stderr-buffer
+				 head default-directory))
+	 (root-dir default-directory))
+(cvs-parse-stdout stdout-buffer stderr-buffer tail root-dir)
+(setq head (sort (cdr head) (function cvs-compare-fileinfos)))
+(collection-clear cvs-cookie-handle)
+(collection-append-cookies cvs-cookie-handle head)
+(cvs-remove-stdout-shadows)
+(if cvs-auto-remove-handled-directories
+	(cvs-remove-empty-directories))
+(set-buffer cvs-buffer-name)
+(cvs-mode)
+;; XEmacs - tedium should let you know when it's ended...
+(if (pos-visible-in-window-p (point-min))
+	nil                             ; assume that the user will see it...
+(ding t 'ready)
+(message "CVS update is ready."))
+(goto-char (point-min))
+(tin-goto-previous cvs-cookie-handle (point-min) 1)
+(setq default-directory root-dir)))
+;;----------
+(defun cvs-remove-stdout-shadows ()
+"Remove entries in the *cvs* buffer that comes from both stdout and stderr.
+If there is two entries for a single file the second one should be
+deleted.  (Remember that sort uses a stable sort algorithm, so one can
+be sure that the stderr entry is always first)."
+(collection-filter-tins cvs-cookie-handle
+			  (function
+			   (lambda (tin)
+			     (not (cvs-shadow-entry-p tin))))))
+;;----------
+(defun cvs-shadow-entry-p (tin)
+"Return non-nil if TIN is a shadow entry.
+Args:  TIN.
+A TIN is a shadow entry if the previous tin contains the same file."
+(let* ((previous-tin (tin-previous cvs-cookie-handle tin))
+	 (curr (tin-cookie cvs-cookie-handle tin))
+	 (prev (and previous-tin
+		    (tin-cookie cvs-cookie-handle previous-tin))))
+(and
+prev curr
+(string= (cvs-fileinfo->file-name prev)
+	      (cvs-fileinfo->file-name curr))
+(string= (cvs-fileinfo->dir prev)
+	      (cvs-fileinfo->dir curr))
+(or
+(and (eq (cvs-fileinfo->type prev) 'CONFLICT)
+	   (eq (cvs-fileinfo->type curr) 'CONFLICT))
+(and (eq (cvs-fileinfo->type prev) 'MERGED)
+	   (eq (cvs-fileinfo->type curr) 'MODIFIED))
+(and (eq (cvs-fileinfo->type prev) 'REM-EXIST)
+	   (eq (cvs-fileinfo->type curr) 'REMOVED))))))
+;;----------
+(defun cvs-find-backup-file (filename &optional dirname)
+"Look for a backup file for FILENAME, optionally in directory DIRNAME, and if
+there is one, return the name of the first file found as a string."
+(if (eq dirname nil)
+(setq dirname default-directory))
+(car (directory-files dirname nil (concat "^\\" cvs-bakprefix filename
+					    "\\."))))
+;;----------
+(defun cvs-find-backup-revision (filename)
+"Take FILENAME as the name of a cvs backup file and return the revision of
+that file as a string."
+(substring filename
+	       (+ 1 (string-match "\\.\\([0-9.]+\\)$" filename))))
+;;----------
+(defun cvs-parse-stderr (stdout-buffer stderr-buffer head dir)
+"Parse the output from CVS that is written to stderr.
+Args:  STDOUT-BUFFER STDERR-BUFFER HEAD DIR
+STDOUT-BUFFER holds the output that cvs sent to stdout.  It is only
+used to create a bug report in case there is a parse error.
+STDERR-BUFFER is the buffer that holds the output to parse.
+HEAD is a cons-cell, the head of the list that is built.
+DIR is the directory the `cvs update' was run in.
+This function returns the last cons-cell in the list that is built."
+(save-window-excursion
+(set-buffer stderr-buffer)
+(goto-char (point-min))
+(let ((current-dir dir)
+	  (root-dir dir))
+(while (< (point) (point-max))
+	(cond
+	 ;; CVS is descending a subdirectory.
+	 ((looking-at
+	   "^cvs \\(server\\|update\\): Updating \\(.*\\)$")
+	  (setq current-dir
+		(cvs-get-current-dir
+		 root-dir
+		 (buffer-substring (match-beginning 2) (match-end 2))))
+	  (setcdr head (list (cvs-create-fileinfo
+			      'DIRCHANGE
+			      current-dir
+			      "."	; the old version had nil here???
+			      (buffer-substring (match-beginning 0)
+						(match-end 0)))))
+	  (setq head (cdr head))
+	  (forward-line 1))
+	 ;; File removed, since it is removed (by third party) in repository.
+	 ((or (looking-at
+	       "^cvs \\(update\\|server\\): warning: \\(.*\\) is not (any longer) pertinent")
+	      (looking-at
+	       "^cvs \\(update\\|server\\): \\(.*\\) is no longer in the repository"))
+	  (setcdr head (list (cvs-create-fileinfo
+			      'CVS-REMOVED
+			      current-dir
+			      (file-name-nondirectory
+			       (buffer-substring (match-beginning 2)
+						 (match-end 2)))
+			      (buffer-substring (match-beginning 0)
+						(match-end 0)))))
+	  (setq head (cdr head))
+	  (forward-line 1))
+	 ;; File removed by you, but recreated by cvs.  Ignored.  Will say
+	 ;; "Updated" on the next line.
+	 ((looking-at
+	   "^cvs \\(update\\|server\\): warning: .* was lost$")
+	  (forward-line 1))
+	 ;; File unknown for some reason.
+	 ;; FIXME:  is it really a good idea to add this as unknown here?
+	 ((looking-at
+	   "cvs \\(update\\|server\\): nothing known about \\(.*\\)$")
+	  (let ((filename (buffer-substring (match-beginning 2)
+					    (match-end 2))))
+	    (if (file-directory-p filename)
+		(setcdr head (list (cvs-create-fileinfo
+				    'UNKNOWN-DIR
+				    current-dir
+				    "."
+				    (buffer-substring (match-beginning 0)
+						      (match-end 0)))))
+	      (setcdr head (list (cvs-create-fileinfo
+				  'UNKNOWN
+				  current-dir
+				  (file-name-nondirectory filename)
+				  (buffer-substring (match-beginning 0)
+						    (match-end 0)))))))
+	  (setq head (cdr head))
+	  (forward-line 1))
+	 ;; A file that has been created by you, but added to the cvs
+	 ;; repository by another.
+	 ((looking-at
+	   "^cvs \\(update\\|server\\): move away \\(.*\\); it is in the way$")
+	  (setcdr head (list (cvs-create-fileinfo
+			      'MOVE-AWAY
+			      current-dir
+			      (file-name-nondirectory
+			       (buffer-substring (match-beginning 2)
+						 (match-end 2)))
+			      (buffer-substring (match-beginning 0)
+						(match-end 0)))))
+	  (setq head (cdr head))
+	  (forward-line 1))
+	 ;; Cvs waits for a lock.  Ignore.
+	 ((looking-at
+	   "^cvs \\(update\\|server\\): \\[..:..:..\\] waiting for .*lock in ")
+	  (forward-line 1))
+	 ;; File removed in repository, but edited by you.
+	 ((looking-at
+	   "^cvs \\(update\\|server\\): conflict: \\(.*\\) is modified but no longer in the repository$")
+	  (setcdr head (list
+			(cvs-create-fileinfo
+			 'REM-CONFLICT
+			 current-dir
+			 (file-name-nondirectory
+			  (buffer-substring (match-beginning 2)
+					    (match-end 2)))
+			 (buffer-substring (match-beginning 0)
+					   (match-end 0)))))
+	  (setq head (cdr head))
+	  (forward-line 1))
+	 ;; File removed in repository, but edited by someone else.
+	 ((looking-at
+	   "^cvs \\(update\\|server\\): conflict: removed \\(.*\\) was modified by second party")
+	  (setcdr head
+		  (list
+		   (cvs-create-fileinfo
+		    'MOD-CONFLICT
+		    current-dir
+		    (buffer-substring (match-beginning 1)
+				      (match-end 1))
+		    (buffer-substring (match-beginning 0)
+				      (match-end 0)))))
+	  (setq head (cdr head))
+	  (forward-line 1))
+	 ;; File removed in repository, but not in local directory.
+	 ((looking-at
+	   "^cvs \\(update\\|server\\): \\(.*\\) should be removed and is still there")
+	  (setcdr head
+		  (list
+		   (cvs-create-fileinfo
+		    'REM-EXIST
+		    current-dir
+		    (buffer-substring (match-beginning 2)
+				      (match-end 2))
+		    (buffer-substring (match-beginning 0)
+				      (match-end 0)))))
+	  (setq head (cdr head))
+	  (forward-line 1))
+	 ;; Error searching for repository
+	 ((looking-at
+	   "^cvs \\(update\\|server\\): in directory ")
+	  (let ((start (point)))
+	    (forward-line 1)
+	    (cvs-skip-line stdout-buffer stderr-buffer
+			   (regexp-quote "cvs [update aborted]: there is no repository "))
+	    (setcdr head (list (cvs-create-fileinfo
+				'REPOS-MISSING
+				current-dir
+				nil
+				(buffer-substring start (point)))))
+	    (setq head (cdr head))))
+	 ;; Silly warning from attempted conflict resolution.  Ignored.
+	 ;; FIXME:  Should it be?
+	 ;; eg.:  "cvs update: cannot find revision APC-web-update in file .cvsignore"
+	 ;;
+	 ((looking-at
+	   "^cvs \\(update\\|server\\): cannot find revision \\(.*\\) in file \\(.*\\)$")
+	  (forward-line 1)
+	  (message "%s" (buffer-substring (match-beginning 0) (match-end 0))))
+	 ;; CVS has decided to merge someone elses changes into this document.
+	 ;; About to start an rcsmerge operation...
+	 ;;
+	 ((looking-at
+	   "^RCS file: ")
+	  ;; skip the "RCS file:" line...
+	  (forward-line 1)
+	  (let ((complex-start (point))
+		base-revision		; the first revision retrieved to merge from
+		head-revision		; the second revision retrieved to merge from
+		filename		; the name of the file being merged
+		backup-file		; the name of the backup of the working file
+		backup-revision)	; the revision of the original working file
+	    (setq base-revision
+		  (cvs-skip-line stdout-buffer stderr-buffer
+				 "^retrieving revision \\(.*\\)$"
+				 1))
+	    (setq head-revision
+		  (cvs-skip-line stdout-buffer stderr-buffer
+				 "^retrieving revision \\(.*\\)$"
+				 1))
+	    (setq filename
+		  (cvs-skip-line stdout-buffer stderr-buffer
+				 "^Merging differences between [0-9.]+ and [0-9.]+ into \\(.*\\)$"
+				 1))
+	    (setq backup-file
+		  (cvs-find-backup-file filename current-dir))
+	    (setq backup-revision
+		  (cvs-find-backup-revision backup-file))
+	     ;; Was there a conflict during the merge?
+	    (cond
+	     ;;;; From CVS-1.3 & RCS-5.6.0.1 with GNU-Diffutils-2.5:
+	     ;;;; "cvs update -j OLD-REV -j NEW-REV ."
+	     ;;
+	     ;; RCS file: /big/web-CVS/apc/cmd/Main/logout.sh,v
+	     ;; retrieving revision 1.1.1.1
+	     ;; retrieving revision 1.1.1.2
+	     ;; Merging differences between 1.1.1.1 and 1.1.1.2 into logout.sh
+	     ;; rcsmerge warning: overlaps during merge
+	     ((looking-at
+	       ;; Allow both RCS 5.5 and 5.6.  (5.6 prints "rcs" and " warning").
+	       "^\\(rcs\\)?merge[:]*\\( warning\\)?: \\((overlaps\\|conflicts\\) during merge$")
+	      ;; Yes, this is a conflict.
+	      (cvs-skip-line stdout-buffer stderr-buffer
+			     "^\\(rcs\\)?merge[:]*\\( warning\\)?: \\(overlaps\\|conflicts\\) during merge$")
+	      ;; this line doesn't seem to appear in all cases -- perhaps only
+	      ;; in "-j A -j B" usage, in which case this indicates ????
+	      (cvs-skip-line stdout-buffer stderr-buffer
+			     "^cvs \\(update\\|server\\): conflicts found in ")
+	      (let ((fileinfo
+		     (cvs-create-fileinfo
+		      'CONFLICT current-dir
+		      filename
+		      (buffer-substring complex-start (point)))))
+		;; squirrel away info about the files that were retrieved for merging
+		(cvs-set-fileinfo->base-revision fileinfo base-revision)
+		(cvs-set-fileinfo->head-revision fileinfo head-revision)
+		(cvs-set-fileinfo->backup-revision fileinfo backup-revision)
+		(cvs-set-fileinfo->backup-file fileinfo backup-file)
+		(setcdr head (list fileinfo))
+		(setq head (cdr head))))
+	     ;; Was it a conflict, and was RCS compiled without DIFF3_BIN, in
+	     ;; which case this is a failed conflict resolution?
+	     ((looking-at
+	       ;; Allow both RCS 5.5 and 5.6.  (5.6 prints "rcs" and " warning").
+	       "^\\(rcs\\)?merge\\( warning\\)?: overlaps or other problems during merge$")
+	      (cvs-skip-line stdout-buffer stderr-buffer
+			     "^\\(rcs\\)?merge\\( warning\\)?: overlaps or other problems during merge$")
+	      (cvs-skip-line stdout-buffer stderr-buffer
+			     "^cvs update: could not merge ")
+	      (cvs-skip-line stdout-buffer stderr-buffer
+			     "^cvs update: restoring .* from backup file ")
+	      (let ((fileinfo
+		     (cvs-create-fileinfo
+		      'CONFLICT current-dir
+		      filename
+		      (buffer-substring complex-start (point)))))
+		(setcdr head (list fileinfo))
+		(setq head (cdr head))))
+	     ;; Not a conflict; it must be a succesful merge.
+	     (t
+	      (let ((fileinfo
+		     (cvs-create-fileinfo
+		      'MERGED current-dir
+		      filename
+		      (buffer-substring complex-start (point)))))
+		(cvs-set-fileinfo->base-revision fileinfo base-revision)
+		(cvs-set-fileinfo->head-revision fileinfo head-revision)
+		(cvs-set-fileinfo->backup-revision fileinfo backup-revision)
+		(cvs-set-fileinfo->backup-file fileinfo backup-file)
+		(setcdr head (list fileinfo))
+		(setq head (cdr head)))))))
+	 ;; Error messages from CVS (incomplete)
+	 ((looking-at
+	   "^cvs \\(update\\|server\\): \\(invalid option .*\\)$")
+	  (error "Interface problem with CVS: %s"
+		 (buffer-substring (match-beginning 2) (match-end 2))))
+	 ;; network errors
+	 ;; Kerberos connection attempted but failed.  This is not
+;; really an error, as CVS will automatically fall back to
+;; rsh.  Plus it tries kerberos, if available, even when rsh
+;; is what you really wanted.
+	 ((looking-at
+	   "^cvs update: kerberos connect:.*$")
+	  (forward-line 1)
+	  (message "Remote CVS: %s"
+		   (buffer-substring (match-beginning 0) (match-end 0))))
+;; And when kerberos *does* fail, cvs prints out some stuff
+;; as it tries rsh.  Ignore that stuff too.
+	 ((looking-at
+	   "^cvs update: trying to start server using rsh$")
+	  (forward-line 1))
+	 ((looking-at
+	   "^\\([^:]*\\) Connection timed out")
+	  (error "Remote CVS: %s"
+		   (buffer-substring (match-beginning 0) (match-end 0))))
+	 ((looking-at
+	   "^Permission denied.")
+	  (error "Remote CVS: %s"
+		 (buffer-substring (match-beginning 0) (match-end 0))))
+	 ((looking-at
+	   "^cvs \\[update aborted\\]: premature end of file from server")
+	  (error "Remote CVS: %s"
+		 (buffer-substring (match-beginning 0) (match-end 0))))
+	 ;; Empty line.  Probably inserted by mistake by user (or developer :-)
+	 ;; Ignore.
+	 ((looking-at
+	   "^$")
+	  (forward-line 1))
+	 ;; top-level parser (cond) default clause
+	 (t
+	  (cvs-skip-line stdout-buffer stderr-buffer
+			 "^UN-MATCHABLE-OUTPUT"))))))
+;; cause this function to return the head of the parser output list
+head)
+;;----------
+(defun cvs-parse-stdout (stdout-buffer stderr-buffer head root-dir)
+"Parse the output from CVS that is written to stderr.
+Args:  STDOUT-BUFFER STDERR-BUFFER HEAD ROOT-DIR
+STDOUT-BUFFER is the buffer that holds the output to parse.
+STDERR-BUFFER holds the output that cvs sent to stderr.  It is only
+used to create a bug report in case there is a parse error.
+HEAD is a cons-cell, the head of the list that is built.
+ROOT-DIR is the directory the `cvs update' was run in.
+This function doesn't return anything particular."
+(save-window-excursion
+(set-buffer stdout-buffer)
+(goto-char (point-min))
+(while (< (point) (point-max))
+(cond
+;; M:  The file is modified by the user, and untouched in the repository.
+;; A:  The file is "cvs add"ed, but not "cvs ci"ed.
+;; R:  The file is "cvs remove"ed, but not "cvs ci"ed.
+;; C:  Conflict (only useful if a join was done and stderr has info...)
+;; U:  The file is copied from the repository.
+;; ?:  Unknown file or directory.
+((looking-at
+	 "^\\([MARCUP?]\\) \\(.*\\)$")
+	(let*
+	    ((c (char-after (match-beginning 1)))
+	     (full-path (concat (file-name-as-directory root-dir)
+				(buffer-substring (match-beginning 2)
+						  (match-end 2))))
+	     (isdir (file-directory-p full-path))
+	     (fileinfo (cvs-create-fileinfo
+			(cond ((eq c ?M) 'MODIFIED)
+			      ((eq c ?A) 'ADDED)
+			      ((eq c ?R) 'REMOVED)
+			      ((eq c ?C) 'CONFLICT)
+			      ((eq c ?U) 'UPDATED)
+			      ((eq c ?P) 'PATCHED)
+			      ((eq c ??) (if isdir
+					     'UNKNOWN-DIR
+					   'UNKNOWN)))
+			(substring (file-name-directory full-path) 0 -1)
+			(file-name-nondirectory full-path)
+			(buffer-substring (match-beginning 0) (match-end 0)))))
+	  ;; Updated and Patched files require no further action.
+	  (if (memq c '(?U ?P))
+	      (cvs-set-fileinfo->handled fileinfo t))
+	  ;; Link this last on the list.
+	  (setcdr head (list fileinfo))
+	  (setq head (cdr head))
+	  (forward-line 1)))
+;; Executing a program because of the -u option in modules.
+((looking-at
+	 "^cvs \\(update\\|server\\): Executing")
+	;; Skip by any output the program may generate to stdout.
+	;; Note that pcl-cvs will get seriously confused if the
+	;; program prints anything to stderr.
+	(re-search-forward cvs-update-prog-output-skip-regexp)
+	(forward-line 1))
+(t
+	(cvs-parse-error stdout-buffer stderr-buffer 'STDOUT (point)
+			 "cvs-parse-stdout"))))))
+;;----------
+(defun cvs-pp (fileinfo)
+"Pretty print FILEINFO.  Insert a printed representation in current buffer.
+For use by the cookie package."
+(let ((a (cvs-fileinfo->type fileinfo))
+(s (if (cvs-fileinfo->marked fileinfo)
+"*" " "))
+(f (cvs-fileinfo->file-name fileinfo))
+(ci (if (cvs-fileinfo->handled fileinfo)
+"  " "ci")))
+(insert
+(cond
+((eq a 'UPDATED)
+(format "%s Updated     %s" s f))
+((eq a 'PATCHED)
+(format "%s Patched     %s" s f))
+((eq a 'MODIFIED)
+(format "%s Modified %s %s" s ci f))
+((eq a 'MERGED)
+(format "%s Merged   %s %s" s ci f))
+((eq a 'CONFLICT)
+(format "%s Conflict    %s" s f))
+((eq a 'ADDED)
+(format "%s Added    %s %s" s ci f))
+((eq a 'REMOVED)
+(format "%s Removed  %s %s" s ci f))
+((eq a 'UNKNOWN)
+(format "%s Unknown     %s" s f))
+((eq a 'UNKNOWN-DIR)
+(format "%s Unknown dir %s" s f))
+((eq a 'CVS-REMOVED)
+(format "%s Removed from repository:  %s" s f))
+((eq a 'REM-CONFLICT)
+(format "%s Conflict: Removed from repository, changed by you: %s" s f))
+((eq a 'MOD-CONFLICT)
+(format "%s Conflict: Removed by you, changed in repository: %s" s f))
+((eq a 'REM-EXIST)
+(format "%s Conflict: Removed by you, but still exists: %s" s f))
+((eq a 'DIRCHANGE)
+(format "\nIn directory %s:" (cvs-fileinfo->dir fileinfo)))
+((eq a 'MOVE-AWAY)
+(format "%s Move away %s - it is in the way" s f))
+((eq a 'REPOS-MISSING)
+(format "  This repository directory is missing!  Remove this directory manually."))
+((eq a 'MESSAGE)
+(cvs-fileinfo->full-log fileinfo))
+(t
+(format "%s Internal error!  %s" s f))))))
+;;; You can define your own keymap in .emacs.  pcl-cvs.el won't overwrite it.
+(if cvs-mode-map
+nil
+(setq cvs-mode-map (make-keymap))
+(suppress-keymap cvs-mode-map)
+(define-prefix-command 'cvs-mode-map-control-c-prefix)
+(define-key cvs-mode-map "\C-?"	'cvs-mode-unmark-up)
+(define-key cvs-mode-map "\C-k"	'cvs-mode-acknowledge)
+(define-key cvs-mode-map "\C-n"	'cvs-mode-next-line)
+(define-key cvs-mode-map "\C-p"	'cvs-mode-previous-line)
+;; ^C- keys are used to set various flags to control CVS features
+(define-key cvs-mode-map "\C-c"	'cvs-mode-map-control-c-prefix)
+(define-key cvs-mode-map "\C-cc"	'cvs-change-cvsroot)
+(define-key cvs-mode-map "\C-cd"	'cvs-set-diff-flags)
+(define-key cvs-mode-map "\C-cl"	'cvs-set-log-flags)
+(define-key cvs-mode-map "\C-cs"	'cvs-set-status-flags)
+(define-key cvs-mode-map "\C-cu"	'cvs-set-update-optional-flags)
+;; M- keys are usually those that operate on modules
+(define-key cvs-mode-map "\M-\C-?"	'cvs-mode-unmark-all-files)
+(define-key cvs-mode-map "\M-C"	'cvs-mode-rcs2log) ; i.e. "Create a ChangeLog"
+(define-key cvs-mode-map "\M-a"	'cvs-mode-admin)
+(define-key cvs-mode-map "\M-c"	'cvs-mode-checkout)
+(define-key cvs-mode-map "\M-o"	'cvs-mode-checkout-other-window)
+(define-key cvs-mode-map "\M-p"	'cvs-mode-rdiff) ; i.e. "create a Patch"
+(define-key cvs-mode-map "\M-r"	'cvs-mode-release)
+(define-key cvs-mode-map "\M-t"	'cvs-mode-rtag)
+;; keys that operate on files
+(define-key cvs-mode-map " "	'cvs-mode-next-line)
+(define-key cvs-mode-map "?"	'describe-mode)
+(define-key cvs-mode-map "A"	'cvs-mode-add-change-log-entry-other-window)
+(define-key cvs-mode-map "B"	'cvs-mode-byte-compile-files)
+(define-key cvs-mode-map "C"  'cvs-mode-changelog-commit)
+(define-key cvs-mode-map "E"	'cvs-mode-emerge)
+(define-key cvs-mode-map "G"	'cvs-update)
+(define-key cvs-mode-map "M"	'cvs-mode-mark-all-files)
+(define-key cvs-mode-map "Q"	'cvs-examine)
+(define-key cvs-mode-map "R"	'cvs-mode-revert-updated-buffers)
+(define-key cvs-mode-map "U"	'cvs-mode-undo-local-changes)
+(define-key cvs-mode-map "a"	'cvs-mode-add)
+(define-key cvs-mode-map "b"	'cvs-mode-diff-backup)
+(define-key cvs-mode-map "c"	'cvs-mode-commit)
+(define-key cvs-mode-map "d"	'cvs-mode-diff-cvs)
+(define-key cvs-mode-map "e"	'cvs-mode-ediff)
+(define-key cvs-mode-map "f"	'cvs-mode-find-file)
+(define-key cvs-mode-map "g"	'cvs-mode-update-no-prompt)
+(define-key cvs-mode-map "i"	'cvs-mode-ignore)
+(define-key cvs-mode-map "l"	'cvs-mode-log)
+(define-key cvs-mode-map "m"	'cvs-mode-mark)
+(define-key cvs-mode-map "n"	'cvs-mode-next-line)
+(define-key cvs-mode-map "o"	'cvs-mode-find-file-other-window)
+(define-key cvs-mode-map "p"	'cvs-mode-previous-line)
+(define-key cvs-mode-map "q"	'bury-buffer)
+(define-key cvs-mode-map "r"	'cvs-mode-remove-file)
+(define-key cvs-mode-map "s"	'cvs-mode-status)
+(define-key cvs-mode-map "t"	'cvs-mode-tag)
+(define-key cvs-mode-map "u"	'cvs-mode-unmark)
+(define-key cvs-mode-map "v"	'cvs-mode-diff-vendor)
+(define-key cvs-mode-map "x"	'cvs-mode-remove-handled))
+;;----------
+(defun cvs-get-marked (&optional ignore-marks ignore-contents)
+"Return a list of all selected tins.
+Args:  &optional IGNORE-MARKS IGNORE-CONTENTS.
+If there are any marked tins, and IGNORE-MARKS is nil, return them.  Otherwise,
+if the cursor selects a directory, return all files in it, unless there are
+none, in which case just return the directory; or unless IGNORE-CONTENTS is not
+nil, in which case also just return the directory.  Otherwise return (a list
+containing) the file the cursor points to, or an empty list if it doesn't point
+to a file at all."
+(cond
+;; Any marked cookies?
+((and (not ignore-marks)
+	 (collection-collect-tin cvs-cookie-handle 'cvs-fileinfo->marked)))
+;; Nope.
+((and (not ignore-contents)
+	 (let ((sel (tin-locate cvs-cookie-handle (point))))
+	   (cond
+	    ;; If a directory is selected, all it members are returned.
+	    ((and sel (eq (cvs-fileinfo->type (tin-cookie cvs-cookie-handle
+							  sel))
+			  'DIRCHANGE))
+	     (let ((retsel
+		    (collection-collect-tin cvs-cookie-handle
+					    'cvs-dir-member-p
+					    (cvs-fileinfo->dir (tin-cookie
+								cvs-cookie-handle sel)))))
+	       (if retsel
+		   retsel
+		 (list sel))))
+	    (t
+	     (list sel))))))
+(t
+(list (tin-locate cvs-cookie-handle (point))))))
+;;----------
+(defun cvs-dir-member-p (fileinfo dir)
+"Return true if FILEINFO represents a file in directory DIR."
+(and (not (eq (cvs-fileinfo->type fileinfo) 'DIRCHANGE))
+(string= (cvs-fileinfo->dir fileinfo) dir)))
+;;----------
+(defun cvs-dir-empty-p (tin)
+"Return non-nil if TIN is a directory that is empty.
+Args:  CVS-BUF TIN."
+(and (eq (cvs-fileinfo->type (tin-cookie cvs-cookie-handle tin)) 'DIRCHANGE)
+(or (not (tin-next cvs-cookie-handle tin))
+	   (eq (cvs-fileinfo->type
+		(tin-cookie cvs-cookie-handle
+				    (tin-next cvs-cookie-handle tin)))
+	       'DIRCHANGE))))
+;;----------
+(defun cvs-mode-revert-updated-buffers ()
+"Revert any buffers that are UPDATED, PATCHED, MERGED or CONFLICT."
+(interactive)
+(cookie-map (function cvs-revert-fileinfo) cvs-cookie-handle))
+;;----------
+(defun cvs-revert-fileinfo (fileinfo)
+"Revert the buffer that holds the file in FILEINFO if it has changed,
+and if the type is UPDATED, PATCHED, MERGED or CONFLICT."
+(let* ((type (cvs-fileinfo->type fileinfo))
+	 (file (cvs-fileinfo->full-path fileinfo))
+	 (buffer (get-file-buffer file)))
+;; For a revert to happen...
+(cond
+((and
+;; ...the type must be one that justifies a revert...
+(or (eq type 'UPDATED)
+	   (eq type 'PATCHED)
+	   (eq type 'MERGED)
+	   (eq type 'CONFLICT))
+;; ...and the user must be editing the file...
+buffer)
+(save-excursion
+	(set-buffer buffer)
+	(cond
+	 ((buffer-modified-p)
+	  (error "%s: edited since last cvs-update."
+		 (buffer-file-name)))
+	 ;; Go ahead and revert the file.
+	 (t (revert-buffer 'dont-use-auto-save-file 'dont-ask))))))))
+;;----------
+(defun cvs-mode-remove-handled ()
+"Remove all lines that are handled.
+Empty directories are removed."
+(interactive)
+;; Pass one:  remove files that are handled.
+(collection-filter-cookies cvs-cookie-handle
+			     (function
+			      (lambda (fileinfo)
+				(not (cvs-fileinfo->handled fileinfo)))))
+;; Pass two:  remove empty directories.
+(if cvs-auto-remove-handled-directories
+(cvs-remove-empty-directories)))
+;;----------
+(defun cvs-remove-empty-directories ()
+"Remove empty directories in the *cvs* buffer."
+(collection-filter-tins cvs-cookie-handle
+			  (function
+			   (lambda (tin)
+			     (not (cvs-dir-empty-p tin))))))
+;;----------
+(defun cvs-mode-mark (pos)
+"Mark a fileinfo.
+Args:  POS.
+If the fileinfo is a directory, all the contents of that directory are marked
+instead.  A directory can never be marked.  POS is a buffer position."
+(interactive "d")
+(let* ((tin (tin-locate cvs-cookie-handle pos))
+	 (sel (tin-cookie cvs-cookie-handle tin)))
+(cond
+;; Does POS point to a directory?  If so, mark all files in that directory.
+((eq (cvs-fileinfo->type sel) 'DIRCHANGE)
+(cookie-map
+(function (lambda (f dir)
+		   (cond
+		    ((cvs-dir-member-p f dir)
+		     (cvs-set-fileinfo->marked f t)
+		     t))))		; Tell cookie to redisplay this cookie.
+cvs-cookie-handle
+(cvs-fileinfo->dir sel)))
+(t
+(cvs-set-fileinfo->marked sel t)
+(tin-invalidate cvs-cookie-handle tin)
+(tin-goto-next cvs-cookie-handle pos 1)))))
+;;----------
+(defun cvs-committable (tin)
+"Check if the TIN is committable.
+It is committable if it
+a) is not handled and
+b) is either MODIFIED, ADDED, REMOVED, MERGED or CONFLICT."
+(let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
+	 (type (cvs-fileinfo->type fileinfo)))
+(and (not (cvs-fileinfo->handled fileinfo))
+	 (or (eq type 'MODIFIED)
+	     (eq type 'ADDED)
+	     (eq type 'REMOVED)
+	     (eq type 'MERGED)
+	     (eq type 'CONFLICT)))))
+;;----------
+(defun cvs-mode-commit ()
+"Check in all marked files, or the current file.
+The user will be asked for a log message in a buffer.
+If cvs-erase-input-buffer is non-nil that buffer will be erased.
+Otherwise mark and point will be set around the entire contents of the
+buffer so that it is easy to kill the contents of the buffer with \\[kill-region]."
+(interactive)
+(let* ((cvs-buf (current-buffer))
+	 (marked (cvs-filter (function cvs-committable)
+			     (cvs-get-marked))))
+(if (null marked)
+	(error "Nothing to commit!")
+(pop-to-buffer (get-buffer-create cvs-commit-prompt-buffer))
+(goto-char (point-min))
+(if cvs-erase-input-buffer
+	  (erase-buffer)
+	(push-mark (point-max)))
+(cvs-edit-mode)
+(make-local-variable 'cvs-commit-list)
+(setq cvs-commit-list marked)
+(message "Press C-c C-c when you are done editing."))))
+;;----------
+(defun cvs-edit-done ()
+"Commit the files to the repository."
+(interactive)
+(if (null cvs-commit-list)
+(error "You have already committed the files"))
+(if (and (> (point-max) 1)
+	   (/= (char-after (1- (point-max))) ?\n)
+	   (or (eq cvs-commit-buffer-require-final-newline t)
+	       (and cvs-commit-buffer-require-final-newline
+		    (yes-or-no-p
+		     (format "Buffer %s does not end in newline.  Add one? "
+			     (buffer-name))))))
+(save-excursion
+	(goto-char (point-max))
+	(insert ?\n)))
+(save-some-buffers)
+(let ((cc-list cvs-commit-list)
+	(cc-buffer (get-buffer cvs-buffer-name))
+	(msg-buffer (current-buffer))
+	(msg (buffer-substring (point-min) (point-max))))
+(pop-to-buffer cc-buffer)
+(bury-buffer msg-buffer)
+(cvs-use-temp-buffer)
+(message "Committing...")
+(if (cvs-execute-list cc-list cvs-program
+			  (if cvs-cvsroot
+			      (list "-d" cvs-cvsroot "commit" "-m" msg)
+			    (list "commit" "-m" msg))
+			  "Committing %s...")
+	(error "Something went wrong.  Check the %s buffer carefully."
+	       cvs-temp-buffer-name))
+;; FIXME: don't do any of this if the commit fails.
+(let ((ccl cc-list))
+(while ccl
+	(cvs-after-commit-function (tin-cookie cvs-cookie-handle (car ccl)))
+	(setq ccl (cdr ccl))))
+(apply 'tin-invalidate cvs-cookie-handle cc-list)
+(set-buffer msg-buffer)
+(setq cvs-commit-list nil)
+(set-buffer cc-buffer)
+(if cvs-auto-remove-handled
+	(cvs-mode-remove-handled)))
+(message "Committing... Done."))
+;;----------
+(defun cvs-after-commit-function (fileinfo)
+"Do everything that needs to be done when FILEINFO has been committed.
+The fileinfo->handle is set, and if the buffer is present it is reverted."
+(cvs-set-fileinfo->handled fileinfo t)
+(if cvs-auto-revert-after-commit
+(let* ((file (cvs-fileinfo->full-path fileinfo))
+	     (buffer (get-file-buffer file)))
+	;; For a revert to happen...
+	(if buffer
+	    ;; ...the user must be editing the file...
+	    (save-excursion
+	      (set-buffer buffer)
+	      (if (not (buffer-modified-p))
+		  ;; ...but it must be unmodified.
+		  (revert-buffer 'dont-use-auto-save-file 'dont-ask)))))))
+;;----------
+(defun cvs-execute-list (tin-list program constant-args &optional message-fmt)
+"Run PROGRAM on all elements on TIN-LIST.
+Args:  TIN-LIST PROGRAM CONSTANT-ARGS.
+The PROGRAM will be called with pwd set to the directory the files reside
+in.  CONSTANT-ARGS should be a list of strings.  The arguments given to the
+program will be CONSTANT-ARGS followed by all the files (from TIN-LIST) that
+resides in that directory.  If the files in TIN-LIST resides in different
+directories the PROGRAM will be run once for each directory (if all files in
+the same directory appears after each other).
+Any output from PROGRAM will be inserted in the current buffer.
+This function return nil if all went well, or the numerical exit status or a
+signal name as a string.  Note that PROGRAM might be called several times.  This
+will return non-nil if something goes wrong, but there is no way to know which
+process that failed.
+If MESSAGE-FMT is not nil, then message is called to display progress with
+MESSAGE-FMT as the string.  MESSAGE-FMT should contain one %s for the arg-list
+being passed to PROGRAM."
+;; FIXME:  something seems wrong with the error checking here....
+(let ((exitstatus nil))
+(while tin-list
+(let ((current-dir (cvs-fileinfo->dir (tin-cookie cvs-cookie-handle
+							(car tin-list))))
+	    arg-list
+	    arg-str)
+	;; Collect all marked files in this directory.
+	(while (and tin-list
+		    (string= current-dir
+			     (cvs-fileinfo->dir (tin-cookie cvs-cookie-handle
+							    (car tin-list)))))
+	  (setq arg-list
+		(cons (cvs-fileinfo->file-name
+		       (tin-cookie cvs-cookie-handle (car tin-list)))
+		      arg-list))
+	  (setq tin-list (cdr tin-list)))
+	(setq arg-list (nreverse arg-list))
+	;; Execute the command on all the files that were collected.
+	(if message-fmt
+	    (message message-fmt
+		     (mapconcat 'cvs-quote-multiword-string
+				arg-list
+				" ")))
+	(setq default-directory (file-name-as-directory current-dir))
+	(insert (format "=== cd %s\n" default-directory))
+	(insert (format "=== %s %s\n\n"
+			program
+			(mapconcat 'cvs-quote-multiword-string
+				   (nconc (copy-sequence constant-args)
+					  arg-list)
+				   " ")))
+	(let ((res (apply 'call-process program nil t t
+			  (nconc (copy-sequence constant-args) arg-list))))
+	  ;; Remember the first, or highest, exitstatus.
+	  (if (and (not (and (integerp res) (zerop res)))
+		   (or (null exitstatus)
+		       (and (integerp exitstatus) (= 1 exitstatus))))
+	      (setq exitstatus res)))
+	(goto-char (point-max))
+	(if message-fmt
+	    (message message-fmt
+		     (mapconcat 'cvs-quote-multiword-string
+				(nconc (copy-sequence arg-list) '("Done."))
+				" ")))
+	exitstatus))))
+;;----------
+;;;; +++ not currently used!
+(defun cvs-execute-single-file-list (tin-list extractor program constant-args
+					      &optional cleanup message-fmt)
+"Run PROGRAM on all elements on TIN-LIST.
+Args:  TIN-LIST EXTRACTOR PROGRAM CONSTANT-ARGS &optional CLEANUP.
+The PROGRAM will be called with pwd set to the directory the files
+reside in.  CONSTANT-ARGS is a list of strings to pass as arguments to
+PROGRAM.  The arguments given to the program will be CONSTANT-ARGS
+followed by the list that EXTRACTOR returns.
+EXTRACTOR will be called once for each file on TIN-LIST.  It is given
+one argument, the cvs-fileinfo.  It can return t, which means ignore
+this file, or a list of arguments to send to the program.
+If CLEANUP is not nil, the filenames returned by EXTRACTOR are deleted.
+If MESSAGE-FMT is not nil, then message is called to display progress with
+MESSAGE-FMT as the string.  MESSAGE-FMT should contain one %s for the arg-list
+being passed to PROGRAM."
+(while tin-list
+(let ((current-dir (file-name-as-directory
+			  (cvs-fileinfo->dir
+			   (tin-cookie cvs-cookie-handle
+				       (car tin-list)))))
+	    (arg-list
+	     (funcall extractor
+		      (tin-cookie cvs-cookie-handle (car tin-list)))))
+	;; Execute the command unless extractor returned t.
+	(if (eq arg-list t)
+	    nil
+	  (setq default-directory current-dir)
+	  (insert (format "=== cd %s\n" default-directory))
+	  (insert (format "=== %s %s\n\n"
+			  program
+			  (mapconcat 'cvs-quote-multiword-string
+				     (nconc (copy-sequence constant-args)
+					    arg-list)
+				     " ")))
+	  (if message-fmt
+	      (message message-fmt (mapconcat 'cvs-quote-multiword-string
+					      arg-list
+					      " ")))
+	  (apply 'call-process program nil t t
+		 (nconc (copy-sequence constant-args) arg-list))
+	  (goto-char (point-max))
+	  (if message-fmt
+	      (message message-fmt (mapconcat 'cvs-quote-multiword-string
+					      (nconc arg-list '("Done."))
+					      " ")))
+	  (if cleanup
+	      (while arg-list
+;;;;		(kill-buffer ?????)
+		(delete-file (car arg-list))
+		(setq arg-list (cdr arg-list))))))
+(setq tin-list (cdr tin-list))))
+;;----------
+(defun cvs-edit-mode ()
+"\\<cvs-edit-mode-map>Mode for editing cvs log messages.
+Commands:
+\\[cvs-edit-done] checks in the file when you are ready.
+This mode is based on fundamental mode."
+(interactive)
+(use-local-map cvs-edit-mode-map)
+(setq major-mode 'cvs-edit-mode)
+(setq mode-name "CVS Log")
+(auto-fill-mode 1))
+;;----------
+(if cvs-edit-mode-map
+nil
+(setq cvs-edit-mode-map (make-sparse-keymap))
+(define-prefix-command 'cvs-edit-mode-control-c-prefix)
+(define-key cvs-edit-mode-map "\C-c" 'cvs-edit-mode-control-c-prefix)
+(define-key cvs-edit-mode-map "\C-c\C-c" 'cvs-edit-done))
+;;----------
+(defun cvs-diffable (tins)
+"Return a list of all tins on TINS that it makes sense to run
+``cvs diff'' on."
+;; +++ There is an unnecessary (nreverse) here.  Get the list the
+;; other way around instead!
+(let ((result nil))
+(while tins
+(let ((type (cvs-fileinfo->type
+		   (tin-cookie cvs-cookie-handle (car tins)))))
+	(if (or (eq type 'MODIFIED)
+		(eq type 'UPDATED)
+		(eq type 'PATCHED)
+		(eq type 'MERGED)
+		(eq type 'CONFLICT)
+		(eq type 'REMOVED)	;+++Does this line make sense?
+		(eq type 'ADDED))	;+++Does this line make sense?
+	    (setq result (cons (car tins) result)))
+	(setq tins (cdr tins))))
+(nreverse result)))
+;;----------
+(defun cvs-mode-diff-cvs (&optional ignore-marks)
+"Diff the selected files against the head revisions in the repository.
+If the variable cvs-diff-ignore-marks is non-nil any marked files will not be
+considered to be selected.  An optional prefix argument will invert the
+influence from cvs-diff-ignore-marks.
+The flags in the variable cvs-diff-flags will be passed to ``cvs diff''.
+The resulting diffs are placed in the cvs-fileinfo->cvs-diff-buffer."
+(interactive "P")
+(if (not (listp cvs-diff-flags))
+(error "cvs-diff-flags should be set using cvs-set-diff-flags."))
+(save-some-buffers)
+(message "cvsdiffing...")
+(let ((marked-file-list (cvs-diffable
+		 (cvs-get-marked
+		  (or (and ignore-marks (not cvs-diff-ignore-marks))
+		      (and (not ignore-marks) cvs-diff-ignore-marks))))))
+(while marked-file-list
+(let ((fileinfo-to-diff (tin-cookie cvs-cookie-handle
+					  (car marked-file-list)))
+	    (local-def-directory (file-name-as-directory
+				  (cvs-fileinfo->dir
+				   (tin-cookie cvs-cookie-handle
+					       (car marked-file-list))))))
+	(message "cvsdiffing %s..."
+		 (cvs-fileinfo->file-name fileinfo-to-diff))
+	;; FIXME:  this seems messy to test and set buffer name at this point....
+	(if (not (cvs-fileinfo->cvs-diff-buffer fileinfo-to-diff))
+	    (cvs-set-fileinfo->cvs-diff-buffer fileinfo-to-diff
+					       (concat "*cvs-diff-"
+						       (cvs-fileinfo->file-name
+							fileinfo-to-diff)
+						       "-in-"
+						       local-def-directory
+						       "*")))
+	(display-buffer (get-buffer-create
+			 (cvs-fileinfo->cvs-diff-buffer fileinfo-to-diff)))
+	(set-buffer (cvs-fileinfo->cvs-diff-buffer fileinfo-to-diff))
+	(setq buffer-read-only nil)
+	(setq default-directory local-def-directory)
+	(erase-buffer)
+	(insert (format "=== cd %s\n" default-directory))
+	(insert (format "=== cvs %s\n\n"
+			(mapconcat 'cvs-quote-multiword-string
+				   (nconc (if cvs-cvsroot
+					      (list "-d" cvs-cvsroot "diff")
+					    '("diff"))
+					  (copy-sequence cvs-diff-flags)
+					  (list (cvs-fileinfo->file-name
+						 fileinfo-to-diff)))
+				   " ")))
+	(if (apply 'call-process cvs-program nil t t
+		   (nconc (if cvs-cvsroot
+			      (list "-d" cvs-cvsroot "diff")
+			    '("diff"))
+			  (copy-sequence cvs-diff-flags)
+			  (list (cvs-fileinfo->file-name fileinfo-to-diff))))
+	    (message "cvsdiffing %s... Done."
+		     (cvs-fileinfo->file-name fileinfo-to-diff))
+	  (message "cvsdiffing %s... No differences found."
+		   (cvs-fileinfo->file-name fileinfo-to-diff)))
+	(goto-char (point-max))
+	(setq marked-file-list (cdr marked-file-list)))))
+(message "cvsdiffing... Done."))
+;;----------
+(defun cvs-mode-diff-backup (&optional ignore-marks)
+"Diff the files against the backup file.
+This command can be used on files that are marked with \"Merged\"
+or \"Conflict\" in the *cvs* buffer.
+If the variable cvs-diff-ignore-marks is non-nil any marked files will
+not be considered to be selected.  An optional prefix argument will
+invert the influence from cvs-diff-ignore-marks.
+The flags in cvs-diff-flags will be passed to ``diff''.
+The resulting diffs are placed in the cvs-fileinfo->backup-diff-buffer."
+(interactive "P")
+(if (not (listp cvs-diff-flags))
+(error "cvs-diff-flags should be set using cvs-set-diff-flags."))
+(save-some-buffers)
+(let ((marked-file-list (cvs-filter
+			   (function cvs-backup-diffable)
+			   (cvs-get-marked
+			    (or
+			     (and ignore-marks (not cvs-diff-ignore-marks))
+			     (and (not ignore-marks) cvs-diff-ignore-marks))))))
+(if (null marked-file-list)
+	(error "No ``Conflict'' or ``Merged'' file selected!"))
+(message "backup diff...")
+(while marked-file-list
+(let ((fileinfo-to-diff (tin-cookie cvs-cookie-handle
+					  (car marked-file-list)))
+	    (local-def-directory (file-name-as-directory
+				  (cvs-fileinfo->dir
+				   (tin-cookie cvs-cookie-handle
+					       (car marked-file-list)))))
+	    (backup-temp-files (cvs-diff-backup-extractor
+				(tin-cookie cvs-cookie-handle
+					    (car marked-file-list)))))
+	(message "backup diff %s..."
+		 (cvs-fileinfo->file-name fileinfo-to-diff))
+	;; FIXME:  this seems messy to test and set buffer name at this point....
+	(if (not (cvs-fileinfo->backup-diff-buffer fileinfo-to-diff))
+	    (cvs-set-fileinfo->backup-diff-buffer fileinfo-to-diff
+						  (concat "*cvs-diff-"
+							  (cvs-fileinfo->backup-file
+							   fileinfo-to-diff)
+							  "-to-"
+							  (cvs-fileinfo->file-name
+							   fileinfo-to-diff)
+							  "-in"
+							  local-def-directory
+							  "*")))
+	(display-buffer (get-buffer-create
+			 (cvs-fileinfo->backup-diff-buffer fileinfo-to-diff)))
+	(set-buffer (cvs-fileinfo->backup-diff-buffer fileinfo-to-diff))
+	(setq buffer-read-only nil)
+	(setq default-directory local-def-directory)
+	(erase-buffer)
+	(insert (format "=== cd %s\n" default-directory))
+	(insert (format "=== %s %s\n\n"
+			cvs-diff-program
+			(mapconcat 'cvs-quote-multiword-string
+				   (nconc (copy-sequence cvs-diff-flags)
+					  backup-temp-files)
+				   " ")))
+	(apply 'call-process cvs-diff-program nil t t
+	       (nconc (copy-sequence cvs-diff-flags) backup-temp-files))
+	(goto-char (point-max))
+	(message "backup diff %s... Done."
+		 (cvs-fileinfo->file-name fileinfo-to-diff))
+	(setq marked-file-list (cdr marked-file-list)))))
+(message "backup diff... Done."))
+;;----------
+(defun cvs-mode-diff-vendor (&optional ignore-marks)
+"Diff the revisions merged into the current file.  I.e. show what changes
+were merged in.
+This command can be used on files that are marked with \"Merged\"
+or \"Conflict\" in the *cvs* buffer.
+If the variable cvs-diff-ignore-marks is non-nil any marked files will
+not be considered to be selected.  An optional prefix argument will
+invert the influence from cvs-diff-ignore-marks.
+The flags in cvs-diff-flags will be passed to ``diff''.
+The resulting diffs are placed in the cvs-fileinfo->vendor-diff-buffer."
+(interactive "P")
+(if (not (listp cvs-diff-flags))
+(error "cvs-diff-flags should be set using cvs-set-diff-flags."))
+(save-some-buffers)
+(let ((marked-file-list (cvs-filter
+			   (function cvs-vendor-diffable)
+			   (cvs-get-marked
+			    (or
+			     (and ignore-marks (not cvs-diff-ignore-marks))
+			     (and (not ignore-marks) cvs-diff-ignore-marks))))))
+(if (null marked-file-list)
+	(error "No ``Conflict'' or ``Merged'' file selected!"))
+(message "vendor diff...")
+(while marked-file-list
+(let ((fileinfo-to-diff (tin-cookie cvs-cookie-handle
+					  (car marked-file-list)))
+	    (local-def-directory (file-name-as-directory
+				  (cvs-fileinfo->dir
+				   (tin-cookie cvs-cookie-handle
+					       (car marked-file-list)))))
+	    (vendor-temp-files (cvs-diff-vendor-extractor
+				(tin-cookie cvs-cookie-handle
+					    (car marked-file-list)))))
+	(message "vendor diff %s..."
+		     (cvs-fileinfo->file-name fileinfo-to-diff))
+	(if (not (cvs-fileinfo->vendor-diff-buffer fileinfo-to-diff))
+	    (cvs-set-fileinfo->vendor-diff-buffer fileinfo-to-diff
+						  (concat "*cvs-diff-"
+							  (cvs-fileinfo->file-name
+							   fileinfo-to-diff)
+							  "-of-"
+							  (cvs-fileinfo->base-revision
+							   fileinfo-to-diff)
+							  "-to-"
+							  (cvs-fileinfo->head-revision
+							   fileinfo-to-diff)
+							  "-in-"
+							  local-def-directory
+							  "*")))
+	(display-buffer (get-buffer-create
+			 (cvs-fileinfo->vendor-diff-buffer fileinfo-to-diff)))
+	(set-buffer (cvs-fileinfo->vendor-diff-buffer fileinfo-to-diff))
+	(setq buffer-read-only nil)
+	(setq default-directory local-def-directory)
+	(erase-buffer)
+	(insert (format "=== cd %s\n" default-directory))
+	(insert (format "=== %s %s\n\n"
+			cvs-diff-program
+			(mapconcat 'cvs-quote-multiword-string
+				   (nconc (copy-sequence cvs-diff-flags)
+					  vendor-temp-files)
+				   " ")))
+	(apply 'call-process cvs-diff-program nil t t
+	       (nconc (copy-sequence cvs-diff-flags) vendor-temp-files))
+	(goto-char (point-max))
+	(message "vendor diff %s... Done."
+		     (cvs-fileinfo->file-name fileinfo-to-diff))
+	(while vendor-temp-files
+	  (cvs-kill-buffer-visiting (car vendor-temp-files))
+	  (delete-file (car vendor-temp-files))
+	  (setq vendor-temp-files (cdr vendor-temp-files)))
+	(setq marked-file-list (cdr marked-file-list)))))
+(message "vendor diff... Done."))
+;;----------
+(defun cvs-backup-diffable (tin)
+"Check if the TIN is backup-diffable.
+It must have a backup file to be diffable."
+(file-readable-p
+(cvs-fileinfo->backup-file (tin-cookie cvs-cookie-handle tin))))
+;;----------
+(defun cvs-vendor-diffable (tin)
+"Check if the TIN is vendor-diffable.
+It must have head and base revision info to be diffable."
+(and
+(cvs-fileinfo->base-revision (tin-cookie cvs-cookie-handle tin))
+(cvs-fileinfo->head-revision (tin-cookie cvs-cookie-handle tin))))
+;;----------
+(defun cvs-diff-backup-extractor (fileinfo)
+"Return the filename and the name of the backup file as a list.
+Signal an error if there is no backup file."
+(if (not (file-readable-p (cvs-fileinfo->backup-file fileinfo)))
+(error "%s has no backup file."
+	     (concat
+	      (file-name-as-directory (cvs-fileinfo->dir fileinfo))
+	      (cvs-fileinfo->file-name fileinfo))))
+(list	(cvs-fileinfo->backup-file fileinfo)
+	 (cvs-fileinfo->file-name fileinfo)))
+;;----------
+(defun cvs-diff-vendor-extractor (fileinfo)
+"Retrieve and return the filenames of the vendor branch revisions as a list.
+Signal an error if there is no info for the vendor revisions."
+(list (cvs-retrieve-revision-to-tmpfile fileinfo
+					  (cvs-fileinfo->base-revision
+					   fileinfo))
+	(cvs-retrieve-revision-to-tmpfile fileinfo
+					  (cvs-fileinfo->head-revision
+					   fileinfo))))
+;;----------
+(defun cvs-mode-find-file-other-window (pos)
+"Select a buffer containing the file in another window.
+Args:  POS."
+(interactive "d")
+(let ((tin (tin-locate cvs-cookie-handle pos)))
+(if tin
+	(let ((type (cvs-fileinfo->type (tin-cookie cvs-cookie-handle tin))))
+	  (cond
+	   ((or (eq type 'REMOVED)
+		(eq type 'CVS-REMOVED))
+	    (error "Can't visit a removed file."))
+	   ((eq type 'DIRCHANGE)
+	    (let ((obuf (current-buffer))
+		  (odir default-directory))
+	      (setq default-directory
+		    (file-name-as-directory
+		     (cvs-fileinfo->dir
+		      (tin-cookie cvs-cookie-handle tin))))
+	      (dired-other-window default-directory)
+	      (set-buffer obuf)
+	      (setq default-directory odir)))
+	   (t
+	    (find-file-other-window (cvs-full-path tin)))))
+(error "There is no file to find."))))
+;;----------
+(defun cvs-fileinfo->full-path (fileinfo)
+"Return the full path for the file that is described in FILEINFO."
+(concat
+(file-name-as-directory
+(cvs-fileinfo->dir fileinfo))
+(cvs-fileinfo->file-name fileinfo)))
+;;----------
+(defun cvs-full-path (tin)
+"Return the full path for the file that is described in TIN."
+(cvs-fileinfo->full-path (tin-cookie cvs-cookie-handle tin)))
+;;----------
+(defun cvs-mode-find-file (pos)
+"Select a buffer containing the file in another window.
+Args:  POS."
+(interactive "d")
+(let* ((cvs-buf (current-buffer))
+	 (tin (tin-locate cvs-cookie-handle pos)))
+(if tin
+	(let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
+	       (type (cvs-fileinfo->type fileinfo)))
+	  (cond
+	   ((or (eq type 'REMOVED)
+		(eq type 'CVS-REMOVED))
+	    (error "Can't visit a removed file."))
+	   ((eq type 'DIRCHANGE)
+	    (let ((odir default-directory))
+	      (setq default-directory
+		    (file-name-as-directory (cvs-fileinfo->dir fileinfo)))
+	      (dired default-directory)
+	      (set-buffer cvs-buf)
+	      (setq default-directory odir)))
+	   (t
+	    (find-file (cvs-full-path tin)))))
+(error "There is no file to find."))))
+;;----------
+(defun cvs-mode-mark-all-files ()
+"Mark all files.
+Directories are not marked."
+(interactive)
+(cookie-map (function (lambda (cookie)
+			  (cond
+			   ((not (eq (cvs-fileinfo->type cookie) 'DIRCHANGE))
+			    (cvs-set-fileinfo->marked cookie t)
+			    t))))
+	      cvs-cookie-handle))
+;;----------
+(defun cvs-mode-unmark (pos)
+"Unmark a fileinfo.
+Args:  POS."
+(interactive "d")
+(let* ((tin (tin-locate cvs-cookie-handle pos))
+	 (sel (tin-cookie cvs-cookie-handle tin)))
+(cond
+((eq (cvs-fileinfo->type sel) 'DIRCHANGE)
+(cookie-map
+(function (lambda (f dir)
+		   (cond
+		    ((cvs-dir-member-p f dir)
+		     (cvs-set-fileinfo->marked f nil)
+		     t))))
+cvs-cookie-handle
+(cvs-fileinfo->dir sel)))
+(t
+(cvs-set-fileinfo->marked sel nil)
+(tin-invalidate cvs-cookie-handle tin)
+(tin-goto-next cvs-cookie-handle pos 1)))))
+;;----------
+(defun cvs-mode-unmark-all-files ()
+"Unmark all files.
+Directories are also unmarked, but that doesn't matter, since
+they should always be unmarked."
+(interactive)
+(cookie-map (function (lambda (cookie)
+			  (cvs-set-fileinfo->marked cookie nil)
+			  t))
+	      cvs-cookie-handle))
+;;----------
+(defun cvs-do-removal (tins)
+"Remove files.
+Args:  TINS.
+TINS is a list of tins that the user wants to delete.  The files are deleted.
+If the type of the tin is 'UNKNOWN or 'UNKNOWN-DIR the tin is removed from the
+buffer.  If it is anything else the file is added to a list that should be `cvs
+remove'd and the tin is changed to be of type 'REMOVED.
+Returns a list of tins files that should be `cvs remove'd."
+(cvs-use-temp-buffer)
+(mapcar 'cvs-insert-full-path tins)
+(cond
+((and tins (yes-or-no-p (format "Delete %d files? " (length tins))))
+(let (files-to-remove)
+(while tins
+	(let* ((tin (car tins))
+	       (fileinfo (tin-cookie cvs-cookie-handle tin))
+	       (filepath (cvs-full-path tin))
+	       (type (cvs-fileinfo->type fileinfo)))
+	  (if (or (eq type 'REMOVED)
+		  (eq type 'CVS-REMOVED))
+	      nil
+	    ;; if it doesn't exist, as a file or directory, ignore it
+	    (cond ((file-directory-p filepath)
+		   (call-process cvs-rmdir-program nil nil nil filepath))
+		  ((file-exists-p filepath)
+		   (delete-file filepath)))
+	    (if (or (eq type 'UNKNOWN)
+		     (eq type 'UNKNOWN-DIR)
+		     (eq type 'MOVE-AWAY))
+		(tin-delete cvs-cookie-handle tin)
+	      (setq files-to-remove (cons tin files-to-remove))
+	      (cvs-set-fileinfo->type fileinfo 'REMOVED)
+	      (cvs-set-fileinfo->handled fileinfo nil)
+	      (tin-invalidate cvs-cookie-handle tin))))
+	(setq tins (cdr tins)))
+files-to-remove))
+(t nil)))
+;;----------
+(defun cvs-mode-remove-file ()
+"Remove all marked files."
+(interactive)
+(let ((files-to-remove (cvs-do-removal (cvs-get-marked))))
+(if (null files-to-remove)
+	nil
+(cvs-use-temp-buffer)
+(message "removing from repository...")
+(if (cvs-execute-list files-to-remove cvs-program
+			    (if cvs-cvsroot
+				(list "-d" cvs-cvsroot "remove")
+			      '("remove"))
+			    "removing %s from repository...")
+	  (error "CVS exited with non-zero exit status.")
+	(message "removing from repository... Done.")))))
+;;----------
+(defun cvs-mode-undo-local-changes ()
+"Undo local changes to all marked files.
+The file is removed and `cvs update FILE' is run."
+(interactive)
+(let ((tins-to-undo (cvs-get-marked)))
+(cvs-use-temp-buffer)
+(mapcar 'cvs-insert-full-path tins-to-undo)
+(cond
+((and tins-to-undo (yes-or-no-p (format "Undo changes to %d files? "
+					     (length tins-to-undo))))
+(let (files-to-update)
+	(while tins-to-undo
+	  (let* ((tin (car tins-to-undo))
+		 (fileinfo (tin-cookie cvs-cookie-handle tin))
+		 (type (cvs-fileinfo->type fileinfo)))
+	    (cond
+	     ((or
+	       (eq type 'UPDATED)
+	       (eq type 'PATCHED)
+	       (eq type 'MODIFIED)
+	       (eq type 'MERGED)
+	       (eq type 'CONFLICT)
+	       (eq type 'CVS-REMOVED)
+	       (eq type 'REM-CONFLICT)
+	       (eq type 'MOVE-AWAY)
+	       (eq type 'REMOVED))
+	      (if (not (eq type 'REMOVED))
+		  (delete-file (cvs-full-path tin)))
+	      (setq files-to-update (cons tin files-to-update))
+	      (cvs-set-fileinfo->type fileinfo 'UPDATED)
+	      (cvs-set-fileinfo->handled fileinfo t)
+	      (tin-invalidate cvs-cookie-handle tin))
+	     ((eq type 'MOD-CONFLICT)
+	      (error "Use cvs-mode-add instead on %s."
+		     (cvs-fileinfo->file-name fileinfo)))
+	     ((eq type 'REM-CONFLICT)
+	      (error "Can't deal with a file you have removed and recreated."))
+	     ((eq type 'DIRCHANGE)
+	      (error "Undo on directories not supported (yet)."))
+	     ((eq type 'ADDED)
+	      (error "There is no old revision to get for %s"
+		     (cvs-fileinfo->file-name fileinfo)))
+	     (t (error "cvs-mode-undo-local-changes: can't handle an %s"
+		       type)))
+	    (setq tins-to-undo (cdr tins-to-undo))))
+	(cvs-use-temp-buffer)
+	(message "Re-getting files from repository...")
+	(if (cvs-execute-list files-to-update cvs-program
+			      (if cvs-cvsroot
+				  (list "-d" cvs-cvsroot "update")
+				'("update"))
+			      "Re-getting %s from repository...")
+	    (error "CVS exited with non-zero exit status.")
+	  (message "Re-getting files from repository... Done.")))))))
+;;----------
+(defun cvs-mode-acknowledge ()
+"Remove all marked files from the buffer."
+(interactive)
+(mapcar (function (lambda (tin)
+		      (tin-delete cvs-cookie-handle tin)))
+	  (cvs-get-marked)))
+;;----------
+(defun cvs-mode-unmark-up (pos)
+"Unmark the file on the previous line.
+Takes one argument POS, a buffer position."
+(interactive "d")
+(let ((tin (tin-goto-previous cvs-cookie-handle pos 1)))
+(cond
+(tin
+(cvs-set-fileinfo->marked (tin-cookie cvs-cookie-handle tin)
+				nil)
+(tin-invalidate cvs-cookie-handle tin)))))
+;;----------
+(defun cvs-mode-previous-line (arg)
+"Go to the previous line.
+If a prefix argument is given, move by that many lines."
+(interactive "p")
+(tin-goto-previous cvs-cookie-handle (point) arg))
+;;----------
+(defun cvs-mode-next-line (arg)
+"Go to the next line.
+If a prefix argument is given, move by that many lines."
+(interactive "p")
+(tin-goto-next cvs-cookie-handle (point) arg))
+;;----------
+(defun cvs-add-file-update-buffer (tin)
+"Sub-function to cvs-mode-add.  Internal use only.  Update the display.  Return
+non-nil if `cvs add' should be called on this file.
+Args:  TIN.
+Returns 'DIR, 'ADD, 'ADD-DIR, or 'RESURRECT."
+(let ((fileinfo (tin-cookie cvs-cookie-handle tin)))
+(cond
+((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN-DIR)
+(cvs-set-fileinfo->full-log fileinfo "new directory added with cvs-mode-add")
+'ADD-DIR)
+((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN)
+(cvs-set-fileinfo->type fileinfo 'ADDED)
+(cvs-set-fileinfo->full-log fileinfo "new file added with cvs-mode-add")
+(tin-invalidate cvs-cookie-handle tin)
+'ADD)
+((eq (cvs-fileinfo->type fileinfo) 'REMOVED)
+(cvs-set-fileinfo->type fileinfo 'UPDATED)
+(cvs-set-fileinfo->full-log fileinfo "file resurrected with cvs-mode-add")
+(cvs-set-fileinfo->handled fileinfo t)
+(tin-invalidate cvs-cookie-handle tin)
+'RESURRECT))))
+;;----------
+(defun cvs-add-sub (cvs-buf candidates)
+"Internal use only.
+Args:  CVS-BUF CANDIDATES.
+CANDIDATES is a list of tins.  Updates the CVS-BUF and returns a list of lists.
+The first list is unknown tins that shall be `cvs add -m msg'ed.
+The second list is unknown directory tins that shall be `cvs add -m msg'ed.
+The third list is removed files that shall be `cvs add'ed (resurrected)."
+(let (add add-dir resurrect)
+(while candidates
+(let ((type (cvs-add-file-update-buffer (car candidates))))
+	(cond ((eq type 'ADD)
+	       (setq add (cons (car candidates) add)))
+	      ((eq type 'ADD-DIR)
+	       (setq add-dir (cons (car candidates) add-dir)))
+	      ((eq type 'RESURRECT)
+	       (setq resurrect (cons (car candidates) resurrect)))))
+(setq candidates (cdr candidates)))
+(list add add-dir resurrect)))
+;;----------
+(defun cvs-mode-add ()
+"Add marked files to the cvs repository."
+(interactive)
+(let* ((buf (current-buffer))
+	 (marked (cvs-get-marked))
+	 (result (cvs-add-sub buf marked))
+	 (added (car result))
+	 (newdirs (car (cdr result)))
+	 (resurrect (car (cdr (cdr result))))
+	 (msg (if (or added newdirs)
+		  (read-from-minibuffer "Enter description: "))))
+(if (or resurrect (or added newdirs))
+	(cvs-use-temp-buffer))
+(cond (resurrect
+	   (message "Resurrecting files from repository...")
+	   (if (cvs-execute-list resurrect
+				 cvs-program
+				 (if cvs-cvsroot
+				     (list "-d" cvs-cvsroot "add")
+				   '("add"))
+				 "Resurrecting %s from repository...")
+	       (error "CVS exited with non-zero exit status.")
+	     (message "Resurrecting files from repository... Done."))))
+(cond (added
+	   (message "Adding new files to repository...")
+	   (if (cvs-execute-list added
+				 cvs-program
+				 (if cvs-cvsroot
+				     (list "-d" cvs-cvsroot "add" "-m" msg)
+				   (list "add" "-m" msg))
+				 "Adding %s to repository...")
+	       (error "CVS exited with non-zero exit status.")
+	     (message "Adding new files to repository... Done."))))
+(cond (newdirs
+	   (message "Adding new directories to repository...")
+	   (if (cvs-execute-list newdirs
+				 cvs-program
+				 (if cvs-cvsroot
+				     (list "-d" cvs-cvsroot "add" "-m" msg)
+				   (list "add" "-m" msg))
+				 "Adding %s to repository...")
+	       (error "CVS exited with non-zero exit status.")
+	     (while newdirs
+	       (let* ((tin (car newdirs))
+		      (fileinfo (tin-cookie cvs-cookie-handle tin))
+		      (newdir (cvs-fileinfo->file-name fileinfo)))
+		 (cvs-set-fileinfo->dir fileinfo
+					(concat (cvs-fileinfo->dir fileinfo)
+						"/"
+						newdir))
+		 (cvs-set-fileinfo->type fileinfo 'DIRCHANGE)
+		 (cvs-set-fileinfo->file-name fileinfo ".")
+		 (tin-invalidate cvs-cookie-handle tin)
+		 (setq newdirs (cdr newdirs))))
+	     ;; FIXME: this should really run cvs-update-no-prompt on the
+	     ;; subdir and insert everthing in the current list.
+	     (message "You must re-update to visit the new directories."))))))
+;;----------
+(defun cvs-mode-ignore ()
+"Arrange so that CVS ignores the selected files and directories.
+This command ignores files/dirs that are flagged as `Unknown'."
+(interactive)
+(mapcar (function (lambda (tin)
+		      (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
+			     (type (cvs-fileinfo->type fileinfo)))
+			(cond ((or (eq type 'UNKNOWN)
+				   (eq type 'UNKNOWN-DIR))
+			       (cvs-append-to-ignore fileinfo)
+			       (tin-delete cvs-cookie-handle tin))))))
+	  (cvs-get-marked)))
+;;----------
+(defun cvs-append-to-ignore (fileinfo)
+"Append the file in fileinfo to the .cvsignore file"
+(save-window-excursion
+(set-buffer (find-file-noselect (concat (file-name-as-directory
+					     (cvs-fileinfo->dir fileinfo))
+					    ".cvsignore")))
+(goto-char (point-max))
+(if (not (zerop (current-column)))
+	(insert "\n"))
+(insert (cvs-fileinfo->file-name fileinfo) "\n")
+(if cvs-sort-ignore-file
+	(sort-lines nil (point-min) (point-max)))
+(save-buffer)))
+;;----------
+(defun cvs-mode-status ()
+"Show cvs status for all marked files."
+(interactive)
+(save-some-buffers)
+(if (not (listp cvs-status-flags))
+(error "cvs-status-flags should be set using cvs-set-status-flags."))
+(let ((marked (cvs-get-marked nil t)))
+(cvs-use-temp-buffer)
+(message "Running cvs status ...")
+(if (cvs-execute-list marked
+			  cvs-program
+			  (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
+				  (list "-Q" "status")
+				  cvs-status-flags)
+			  "Running cvs -Q status %s...")
+	(error "CVS exited with non-zero exit status.")
+(message "Running cvs -Q status ... Done."))))
+;;----------
+(defun cvs-mode-log ()
+"Display the cvs log of all selected files."
+(interactive)
+(if (not (listp cvs-log-flags))
+(error "cvs-log-flags should be set using cvs-set-log-flags."))
+(let ((marked (cvs-get-marked nil t)))
+(cvs-use-temp-buffer)
+(message "Running cvs log ...")
+(if (cvs-execute-list marked
+			  cvs-program
+			  (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
+				  (list "log")
+				  cvs-log-flags)
+			  "Running cvs log %s...")
+	(error "CVS exited with non-zero exit status.")
+(message "Running cvs log ... Done."))))
+;;----------
+(defun cvs-mode-tag ()
+"Run 'cvs tag' on all selected files."
+(interactive)
+(if (not (listp cvs-tag-flags))
+(error "cvs-tag-flags should be set using cvs-set-tag-flags."))
+(let ((marked (cvs-get-marked nil t))
+	(tag-args (cvs-make-list (read-string "Tag name (and flags): "))))
+(cvs-use-temp-buffer)
+(message "Running cvs tag ...")
+(if (cvs-execute-list marked
+			  cvs-program
+			  (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
+				  (list "tag")
+				  cvs-tag-flags
+				  tag-args)
+			  "Running cvs tag %s...")
+	(error "CVS exited with non-zero exit status.")
+(message "Running cvs tag ... Done."))))
+;;----------
+(defun cvs-mode-rtag ()
+"Run 'cvs rtag' on all selected files."
+(interactive)
+(if (not (listp cvs-rtag-flags))
+(error "cvs-rtag-flags should be set using cvs-set-rtag-flags."))
+(let ((marked (cvs-get-marked nil t))
+	;; FIXME:  should give selection from the modules file
+	(module-name (read-string "Module name: "))
+	;; FIXME:  should also ask for an existing tag *or* date
+	(rtag-args (cvs-make-list (read-string "Tag name (and flags): "))))
+(cvs-use-temp-buffer)
+(message "Running cvs rtag ...")
+(if (cvs-execute-list marked
+			  cvs-program
+			  (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
+				  (list "rtag")
+				  cvs-rtag-flags
+				  rtag-args
+				  (list module-name))
+			  "Running cvs rtag %s...")
+	(error "CVS rtag exited with non-zero exit status.")
+(message "Running cvs rtag ... Done."))))
+;;----------
+(defun cvs-mode-byte-compile-files ()
+"Run byte-compile-file on all selected files that end in '.el'."
+(interactive)
+(let ((marked (cvs-get-marked)))
+(while marked
+(let ((filename (cvs-full-path (car marked))))
+	(if (string-match "\\.el$" filename)
+	    (byte-compile-file filename)))
+(setq marked (cdr marked)))))
+;;----------
+(defun cvs-insert-full-path (tin)
+"Insert full path to the file described in TIN in the current buffer."
+(insert (format "%s\n" (cvs-full-path tin))))
+;;----------
+(defun cvs-mode-add-change-log-entry-other-window (pos)
+"Add a ChangeLog entry in the ChangeLog of the current directory.
+Args:  POS."
+(interactive "d")
+(let* ((cvs-buf (current-buffer))
+	 (odir default-directory)
+	 (obfname buffer-file-name)
+	 (tin (tin-locate cvs-cookie-handle pos))
+	 (fileinfo (tin-cookie cvs-cookie-handle tin))
+	 (fname (cvs-fileinfo->file-name fileinfo))
+	 (dname (file-name-as-directory (cvs-fileinfo->dir fileinfo))))
+(setq change-log-default-name nil)	; this rarely correct in 19.28
+(setq buffer-file-name (cond (fname
+				   fname)
+				  (t
+				   nil)))
+(setq default-directory (cond (dname
+				    dname)
+				   (t
+				    odir)))
+(add-change-log-entry-other-window)
+(set-buffer cvs-buf)
+(setq default-directory odir)
+(setq buffer-file-name obfname)))
+;;----------
+(defun print-cvs-tin (foo)
+"Debug utility."
+(let ((cookie (tin-cookie cvs-cookie-handle foo))
+	(stream (get-buffer-create "pcl-cvs-debug")))
+(princ "==============\n" stream)
+(princ (cvs-fileinfo->file-name cookie) stream)
+(princ "\n" stream)
+(princ (cvs-fileinfo->dir cookie) stream)
+(princ "\n" stream)
+(princ (cvs-fileinfo->full-log cookie) stream)
+(princ "\n" stream)
+(princ (cvs-fileinfo->marked cookie) stream)
+(princ "\n" stream)))
+;;----------
+;; NOTE: the variable cvs-emerge-tmp-head-file will be "free" when compiling
+(defun cvs-mode-emerge (pos)
+"Emerge appropriate revisions of the selected file.
+Args:  POS."
+(interactive "d")
+(let* ((cvs-buf (current-buffer))
+	 (tin (tin-locate cvs-cookie-handle pos)))
+(if (boundp 'cvs-emerge-tmp-head-file)
+	(error "There can only be one emerge session active at a time."))
+(if tin
+	(let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
+	       (type (cvs-fileinfo->type fileinfo)))
+	  (cond
+	   ((eq type 'MODIFIED)		; merge repository head rev. with working file
+	    (require 'emerge)
+	    (setq cvs-emerge-tmp-head-file ; trick to prevent multiple runs
+		  (cvs-retrieve-revision-to-tmpfile fileinfo))
+	    (unwind-protect
+		(if (not (emerge-files
+			  t						; arg
+			  (cvs-fileinfo->full-path fileinfo) 		; file-A
+			  ;; this is an un-avoidable compiler reference to a free variable
+			  cvs-emerge-tmp-head-file			; file-B
+			  (cvs-fileinfo->full-path fileinfo)		; file-out
+			  nil						; start-hooks
+			  '(lambda ()					; quit-hooks
+			     (delete-file cvs-emerge-tmp-head-file)
+			     (makunbound 'cvs-emerge-tmp-head-file))))
+		    (error "Emerge session failed"))))
+	   ;; re-do the same merge rcsmerge supposedly just did....
+	   ((or (eq type 'MERGED)
+		(eq type 'CONFLICT))	; merge backup-working=A, head=B, base=ancestor
+	    (require 'emerge)
+	    (setq cvs-emerge-tmp-head-file ; trick to prevent multiple runs
+		  (cvs-retrieve-revision-to-tmpfile fileinfo
+						    (cvs-fileinfo->head-revision
+						     fileinfo)))
+	    (let ((cvs-emerge-tmp-backup-working-file
+		   (cvs-fileinfo->backup-file fileinfo))
+		  (cvs-emerge-tmp-ancestor-file
+		   (cvs-retrieve-revision-to-tmpfile fileinfo
+						     (cvs-fileinfo->base-revision
+						      fileinfo))))
+	      (unwind-protect
+		  (if (not (emerge-files-with-ancestor
+			    t						; arg
+			    cvs-emerge-tmp-backup-working-file		; file-A
+			    ;; this is an un-avoidable compiler reference to a free variable
+			    cvs-emerge-tmp-head-file			; file-B
+			    cvs-emerge-tmp-ancestor-file		; file-ancestor
+			    (cvs-fileinfo->full-path fileinfo)		; file-out
+			    nil						; start-hooks
+			    '(lambda ()					; quit-hooks
+			       (delete-file cvs-emerge-tmp-backup-file)
+			       (delete-file cvs-emerge-tmp-ancestor-file)
+			       (delete-file cvs-emerge-tmp-head-file)
+			       (makunbound 'cvs-emerge-tmp-head-file))))
+		      (error "Emerge session failed")))))
+	   (t
+	    (error "Can only e-merge \"Modified\", \"Merged\" or \"Conflict\" files"))))
+(error "There is no file to e-merge."))))
+;;----------
+;; NOTE: the variable ediff-version may be "free" when compiling
+(defun cvs-mode-ediff (pos)
+"Ediff appropriate revisions of the selected file.
+Args:  POS."
+(interactive "d")
+(if (boundp 'cvs-ediff-tmp-head-file)
+(error "There can only be one ediff session active at a time."))
+(require 'ediff)
+(if (and (boundp 'ediff-version)
+	   (>= (string-to-number ediff-version) 2.0)) ; FIXME real number?
+(run-ediff-from-cvs-buffer pos)
+(cvs-old-ediff-interface pos)))
+(defun cvs-old-ediff-interface (pos)
+"Emerge like interface for older ediffs.
+Args:  POS"
+(let* ((cvs-buf (current-buffer))
+	 (tin (tin-locate cvs-cookie-handle pos)))
+(if tin
+	(let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
+	       (type (cvs-fileinfo->type fileinfo)))
+	  (cond
+	   ((eq type 'MODIFIED)		; diff repository head rev. with working file
+	    ;; should this be inside the unwind-protect, and should the
+	    ;; makeunbound be an unwindform?
+	    (setq cvs-ediff-tmp-head-file ; trick to prevent multiple runs
+		  (cvs-retrieve-revision-to-tmpfile fileinfo))
+	    (unwind-protect
+		(if (not (ediff-files	; check correct ordering of args
+			  (cvs-fileinfo->full-path fileinfo) 		; file-A
+			  ;; this is an un-avoidable compiler reference to a free variable
+			  cvs-ediff-tmp-head-file			; file-B
+			  '(lambda ()					; startup-hooks
+			     (make-local-hook 'ediff-cleanup-hooks)
+			     (add-hook 'ediff-cleanup-hooks
+				       '(lambda ()
+					  (ediff-janitor)
+					  (delete-file cvs-ediff-tmp-head-file)
+					  (makunbound 'cvs-ediff-tmp-head-file))
+				       nil t))))
+		    (error "Ediff session failed"))))
+	   ;; look at the merge rcsmerge supposedly just did....
+	   ((or (eq type 'MERGED)
+		(eq type 'CONFLICT))	; diff backup-working=A, head=B, base=ancestor
+	    (if (not (boundp 'ediff-version))
+		(error "ediff version way too old for 3-way diff"))
+	    (if (<= (string-to-number ediff-version) 1.9) ; FIXME real number?
+		(error "ediff version %s too old for 3-way diff" ediff-version))
+	    (setq cvs-ediff-tmp-head-file ; trick to prevent multiple runs
+		  (cvs-retrieve-revision-to-tmpfile fileinfo
+						    (cvs-fileinfo->head-revision
+						     fileinfo)))
+	    (let ((cvs-ediff-tmp-backup-working-file
+		   (cvs-fileinfo->backup-file fileinfo))
+		  (cvs-ediff-tmp-ancestor-file
+		   (cvs-retrieve-revision-to-tmpfile fileinfo
+						     (cvs-fileinfo->base-revision
+						      fileinfo))))
+	      (unwind-protect
+		  (if (not (ediff-files3 ; check correct ordering of args
+			    cvs-ediff-tmp-backup-working-file		; file-A
+			    ;; this is an un-avoidable compiler reference to a free variable
+			    cvs-ediff-tmp-head-file			; file-B
+			    cvs-ediff-tmp-ancestor-file			; file-ancestor
+			    '(lambda ()					; start-hooks
+			       (make-local-hook 'ediff-cleanup-hooks)
+			       (add-hook 'ediff-cleanup-hooks
+					 '(lambda ()
+					    (ediff-janitor)
+					    (delete-file cvs-ediff-tmp-backup-file)
+					    (delete-file cvs-ediff-tmp-ancestor-file)
+					    (delete-file cvs-ediff-tmp-head-file)
+					    (makunbound 'cvs-ediff-tmp-head-file))
+					 nil t))))
+		      (error "Ediff session failed")))))
+	   ((not (or (eq type 'UNKNOWN)
+		     (eq type 'UNKNOWN-DIR))) ; i.e. UPDATED or PATCHED ????
+	    ;; this should really diff the current working file with the previous
+	    ;; rev. on the current branch (i.e. not the head, since that's what
+	    ;; the current file should be)
+	    (setq cvs-ediff-tmp-head-file ; trick to prevent multiple runs
+		  (cvs-retrieve-revision-to-tmpfile fileinfo
+						    (read-string "Rev #/tag to diff against: "
+								 (cvs-fileinfo->head-revision
+								  fileinfo))))
+	    (unwind-protect
+		(if (not (ediff-files	; check correct ordering of args
+			  (cvs-fileinfo->full-path fileinfo)	 	; file-A
+			  ;; this is an un-avoidable compiler reference to a free variable
+			  cvs-ediff-tmp-head-file			; file-B
+			  '(lambda ()					; startup-hooks
+			     (make-local-hook 'ediff-cleanup-hooks)
+			     (add-hook 'ediff-cleanup-hooks
+				       '(lambda ()
+					  (ediff-janitor)
+					  (delete-file cvs-ediff-tmp-head-file)
+					  (makunbound 'cvs-ediff-tmp-head-file))
+				       nil t))))
+		    (error "Ediff session failed"))))
+	   (t
+	    (error "Can not ediff \"Unknown\" files"))))
+(error "There is no file to ediff."))))
+;;----------
+(defun cvs-retrieve-revision-to-tmpfile (fileinfo &optional revision)
+"Retrieve the latest revision of the file in FILEINFO to a temporary file.
+If second optional argument REVISION is given, retrieve that revision instead."
+(let
+((temp-name (make-temp-name
+		   (concat (file-name-as-directory
+			    (or (getenv "TMPDIR") "/tmp"))
+			   "pcl-cvs." revision))))
+(cvs-kill-buffer-visiting temp-name)
+(if (and revision
+	     (stringp revision)
+	     (not (string= revision "")))
+	(message "Retrieving revision %s..." revision)
+(message "Retrieving latest revision..."))
+(let ((res (call-process cvs-shell nil nil nil "-c"
+			     (concat cvs-program " update -p "
+				     (if (and revision
+					      (stringp revision)
+					      (not (string= revision "")))
+					 (concat "-r " revision " ")
+				       "")
+				     (cvs-fileinfo->full-path fileinfo)
+				     " > " temp-name))))
+(if (and res (not (and (integerp res) (zerop res))))
+	  (error "Something went wrong retrieving revision %s: %s"
+		 revision res))
+(if revision
+	  (message "Retrieving revision %s... Done." revision)
+	(message "Retrieving latest revision... Done."))
+(save-excursion
+	(set-buffer (find-file-noselect temp-name))
+	(rename-buffer (concat " " (file-name-nondirectory temp-name)) t))
+temp-name)))
+;;----------
+(defun cvs-kill-buffer-visiting (filename)
+"If there is any buffer visiting FILENAME, kill it (without confirmation)."
+(let ((l (buffer-list)))
+(while l
+(if (string= (buffer-file-name (car l)) filename)
+	  (kill-buffer (car l)))
+(setq l (cdr l)))))
+;;----------
+(defun cvs-change-cvsroot ()
+"Ask for a new cvsroot."
+(interactive)
+(cvs-set-cvsroot (read-file-name "New CVSROOT: " cvs-cvsroot)))
+;;----------
+(defun cvs-set-cvsroot (newroot)
+"Change the cvsroot."
+(if (or (file-directory-p (expand-file-name "CVSROOT" newroot))
+	  (y-or-n-p (concat "Warning:  no CVSROOT found inside repository."
+			    " Change cvs-cvsroot anyhow?")))
+(setq cvs-cvsroot newroot)))
+;;----------
+(defun cvs-set-diff-flags ()
+"Ask for new setting of cvs-diff-flags."
+(interactive)
+(let ((old-value (mapconcat 'identity
+			      (copy-sequence cvs-diff-flags) " ")))
+(setq cvs-diff-flags
+	  (cvs-make-list (read-string "Diff flags: " old-value)))))
+;;----------
+(defun cvs-set-update-optional-flags ()
+"Ask for new setting of cvs-update-optional-flags."
+(interactive)
+(let ((old-value (mapconcat 'identity
+			      (copy-sequence cvs-update-optional-flags) " ")))
+(setq cvs-update-optional-flags
+	  (cvs-make-list (read-string "Update optional flags: " old-value)))))
+;;----------
+(defun cvs-set-status-flags ()
+"Ask for new setting of cvs-status-flags."
+(interactive)
+(let ((old-value (mapconcat 'identity
+			      (copy-sequence cvs-status-flags) " ")))
+(setq cvs-status-flags
+	  (cvs-make-list (read-string "Status flags: " old-value)))))
+;;----------
+(defun cvs-set-log-flags ()
+"Ask for new setting of cvs-log-flags."
+(interactive)
+(let ((old-value (mapconcat 'identity
+			      (copy-sequence cvs-log-flags) " ")))
+(setq cvs-log-flags
+	  (cvs-make-list (read-string "Log flags: " old-value)))))
+;;----------
+(defun cvs-set-tag-flags ()
+"Ask for new setting of cvs-tag-flags."
+(interactive)
+(let ((old-value (mapconcat 'identity
+			      (copy-sequence cvs-tag-flags) " ")))
+(setq cvs-tag-flags
+	  (cvs-make-list (read-string "Tag flags: " old-value)))))
+;;----------
+(defun cvs-set-rtag-flags ()
+"Ask for new setting of cvs-rtag-flags."
+(interactive)
+(let ((old-value (mapconcat 'identity
+			      (copy-sequence cvs-rtag-flags) " ")))
+(setq cvs-rtag-flags
+	  (cvs-make-list (read-string "Rtag flags: " old-value)))))
+;;----------
+(if (string-match "XEmacs" emacs-version)
+(progn
+;; now marked to autload in pcl-cvs-xemacs
+;(autoload 'pcl-cvs-fontify "pcl-cvs-xemacs")
+(add-hook 'cvs-mode-hook 'pcl-cvs-fontify)))
+(defun cvs-changelog-name (directory)
+"Return the name of the ChangeLog file that handles DIRECTORY.
+This is in DIRECTORY or one of its parents.
+Signal an error if we can't find an appropriate ChangeLog file."
+(let ((dir (file-name-as-directory directory))
+file)
+(while (and dir
+(not (file-exists-p
+(setq file (expand-file-name "ChangeLog" dir)))))
+(let ((last dir))
+(setq dir (file-name-directory (directory-file-name dir)))
+(if (equal last dir)
+(setq dir nil))))
+(or dir
+(error "Can't find ChangeLog for %s" directory))
+file))
+(defun cvs-narrow-changelog ()
+"Narrow to the top page of the current buffer, a ChangeLog file.
+Actually, the narrowed region doesn't include the date line.
+A \"page\" in a ChangeLog file is the area between two dates."
+(or (eq major-mode 'change-log-mode)
+(error "cvs-narrow-changelog: current buffer isn't a ChangeLog"))
+(goto-char (point-min))
+;; Skip date line and subsequent blank lines.
+(forward-line 1)
+(if (looking-at "[ \t\n]*\n")
+(goto-char (match-end 0)))
+(let ((start (point)))
+(forward-page 1)
+(narrow-to-region start (point))
+(goto-char (point-min))))
+(defun cvs-changelog-paragraph ()
+"Return the bounds of the ChangeLog paragraph containing point.
+If we are between paragraphs, return the previous paragraph."
+(save-excursion
+(beginning-of-line)
+(if (looking-at "^[ \t]*$")
+(skip-chars-backward " \t\n" (point-min)))
+(list (progn
+(if (re-search-backward "^[ \t]*\n" nil 'or-to-limit)
+(goto-char (match-end 0)))
+(point))
+(if (re-search-forward "^[ \t\n]*$" nil t)
+(match-beginning 0)
+(point)))))
+(defun cvs-changelog-subparagraph ()
+"Return the bounds of the ChangeLog subparagraph containing point.
+A subparagraph is a block of non-blank lines beginning with an asterisk.
+If we are between sub-paragraphs, return the previous subparagraph."
+(save-excursion
+(end-of-line)
+(if (search-backward "*" nil t)
+(list (progn (beginning-of-line) (point))
+(progn
+(forward-line 1)
+(if (re-search-forward "^[ \t]*[\n*]" nil t)
+(match-beginning 0)
+(point-max))))
+(list (point) (point)))))
+(defun cvs-changelog-entry ()
+"Return the bounds of the ChangeLog entry containing point.
+The variable `cvs-changelog-full-paragraphs' decides whether an
+\"entry\" is a paragraph or a subparagraph; see its documentation string
+for more details."
+(if cvs-changelog-full-paragraphs
+(cvs-changelog-paragraph)
+(cvs-changelog-subparagraph)))
+;; NOTE: the variable user-full-name may be "free" when compiling
+(defun cvs-changelog-ours-p ()
+"See if ChangeLog entry at point is for the current user, today.
+Return non-nil iff it is."
+;; Code adapted from add-change-log-entry.
+(looking-at (concat (regexp-quote (substring (current-time-string)
+0 10))
+".* "
+(regexp-quote (substring (current-time-string) -4))
+"[ \t]+"
+		      (regexp-quote (if (and (boundp 'add-log-full-name)
+add-log-full-name)
+add-log-full-name
+user-full-name))
+"  <"
+		      (regexp-quote (if (and (boundp 'add-log-mailing-address)
+					     add-log-mailing-address)
+					add-log-mailing-address
+				      user-mail-address)))))
+(defun cvs-relative-path (base child)
+"Return a directory path relative to BASE for CHILD.
+If CHILD doesn't seem to be in a subdirectory of BASE, just return
+the full path to CHILD."
+(let ((base (file-name-as-directory (expand-file-name base)))
+(child (expand-file-name child)))
+(or (string= base (substring child 0 (length base)))
+(error "cvs-relative-path: %s isn't in %s" child base))
+(substring child (length base))))
+(defun cvs-changelog-entries (file)
+"Return the ChangeLog entries for FILE, and the ChangeLog they came from.
+The return value looks like this:
+(LOGBUFFER (ENTRYSTART . ENTRYEND) ...)
+where LOGBUFFER is the name of the ChangeLog buffer, and each
+\(ENTRYSTART . ENTRYEND\) pair is a buffer region."
+(save-excursion
+(set-buffer (find-file-noselect
+(cvs-changelog-name
+(file-name-directory
+(expand-file-name file)))))
+(or (eq major-mode 'change-log-mode)
+	(change-log-mode))
+(goto-char (point-min))
+(if (looking-at "[ \t\n]*\n")
+(goto-char (match-end 0)))
+(if (not (cvs-changelog-ours-p))
+(list (current-buffer))
+(save-restriction
+(cvs-narrow-changelog)
+(goto-char (point-min))
+;; Search for the name of FILE relative to the ChangeLog.  If that
+;; doesn't occur anywhere, they're not using full relative
+;; filenames in the ChangeLog, so just look for FILE; we'll accept
+;; some false positives.
+(let ((pattern (cvs-relative-path
+(file-name-directory buffer-file-name) file)))
+(if (or (string= pattern "")
+(not (save-excursion
+(search-forward pattern nil t))))
+(setq pattern file))
+(let (texts)
+(while (search-forward pattern nil t)
+(let ((entry (cvs-changelog-entry)))
+(setq texts (cons entry texts))
+(goto-char (elt entry 1))))
+(cons (current-buffer) texts)))))))
+(defun cvs-changelog-insert-entries (buffer regions)
+"Insert those regions in BUFFER specified in REGIONS.
+Sort REGIONS front-to-back first."
+(let ((regions (sort regions 'car-less-than-car))
+(last))
+(while regions
+(if (and last (< last (car (car regions))))
+(newline))
+(setq last (elt (car regions) 1))
+(apply 'insert-buffer-substring buffer (car regions))
+(setq regions (cdr regions)))))
+(defun cvs-union (set1 set2)
+"Return the union of SET1 and SET2, according to `equal'."
+(while set2
+(or (member (car set2) set1)
+(setq set1 (cons (car set2) set1)))
+(setq set2 (cdr set2)))
+set1)
+(defun cvs-insert-changelog-entries (files)
+"Given a list of files FILES, insert the ChangeLog entries for them."
+(let ((buffer-entries nil))
+;; Add each buffer to buffer-entries, and associate it with the list
+;; of entries we want from that file.
+(while files
+(let* ((entries (cvs-changelog-entries (car files)))
+(pair (assq (car entries) buffer-entries)))
+(if pair
+(setcdr pair (cvs-union (cdr pair) (cdr entries)))
+(setq buffer-entries (cons entries buffer-entries))))
+(setq files (cdr files)))
+;; Now map over each buffer in buffer-entries, sort the entries for
+;; each buffer, and extract them as strings.
+(while buffer-entries
+(cvs-changelog-insert-entries (car (car buffer-entries))
+(cdr (car buffer-entries)))
+(if (and (cdr buffer-entries) (cdr (car buffer-entries)))
+(newline))
+(setq buffer-entries (cdr buffer-entries)))))
+(defun cvs-edit-delete-common-indentation ()
+"Unindent the current buffer rigidly until at least one line is flush left."
+(save-excursion
+(let ((common 100000))
+(goto-char (point-min))
+(while (< (point) (point-max))
+(if (not (looking-at "^[ \t]*$"))
+(setq common (min common (current-indentation))))
+(forward-line 1))
+(indent-rigidly (point-min) (point-max) (- common)))))
+(defun cvs-mode-changelog-commit ()
+"Check in all marked files, or the current file.
+Ask the user for a log message in a buffer.
+This is just like `\\[cvs-mode-commit]', except that it tries to provide
+appropriate default log messages by looking at the ChangeLog.  The
+idea is to write your ChangeLog entries first, and then use this
+command to commit your changes.
+To select default log text, we:
+- find the ChangeLog entries for the files to be checked in,
+- verify that the top entry in the ChangeLog is on the current date
+and by the current user; if not, we don't provide any default text,
+- search the ChangeLog entry for paragraphs containing the names of
+the files we're checking in, and finally
+- use those paragraphs as the log text."
+(interactive)
+(let* ((cvs-buf (current-buffer))
+(marked (cvs-filter (function cvs-committable)
+(cvs-get-marked))))
+(if (null marked)
+(error "Nothing to commit!")
+(pop-to-buffer (get-buffer-create cvs-commit-prompt-buffer))
+(goto-char (point-min))
+(erase-buffer)
+(cvs-insert-changelog-entries
+(mapcar (lambda (tin)
+(let ((cookie (tin-cookie cvs-cookie-handle tin)))
+(expand-file-name
+(cvs-fileinfo->file-name cookie)
+(cvs-fileinfo->dir cookie))))
+marked))
+(cvs-edit-delete-common-indentation)
+(cvs-edit-mode)
+(make-local-variable 'cvs-commit-list)
+(setq cvs-commit-list marked)
+(message "Press C-c C-c when you are done editing."))))
+;;;; end of file pcl-cvs.el

Mercurial > hg > xemacs-beta

comparison lisp/pcl-cvs/pcl-cvs.el @ 0:376386a54a3c r19-14