;;;; pcl-cvs.el -- A Front-end to CVS.  Release R-2_0-Beta_2.
;;;
;;;#ident	"@(#)R-2_0-Beta_2:pcl-cvs.el,v 1.117 1998/01/28 17:23:55 woods Exp"

(defconst pcl-cvs-version "R-2_0-Beta_2"
  "pcl-cvs.el,v 1.117 1998/01/28 17:23:55 woods Exp")

;; Copyright (C) 1991-1995  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.

;; There is an Texinfo file that describes this package.  The GNU
;; General Public License is included in that file.  You should read
;; it to get the most from this package.

;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com
;;	(Per Cederqvist) ceder@lysator.liu.se
;;	(Greg A. Woods) woods@weird.com
;;	(Jimb Blandy) jimb@cyclic.com
;;	(Karl Fogel) kfogel@floss.red-bean.com
;;	(Jim Kingdon) kingdon@cyclic.com
;; Maintainer: (Greg A. Woods) woods@weird.com
;; Version: R-2_0-Beta_2
;; Keywords: CVS, version control, release management

;;; Commentary:

;; This package requires ELIB-1.0 to run.  Elib is included in the
;; CVS distribution in the contrib/elib/ subdirectory, but you can
;; also download it at the following URL:
;;
;;	ftp://ftp.lysator.liu.se/pub/emacs/elib-1.0.tar.gz
;;

;; See below for installation instructions.

;; PCL-CVS requires GNU Emacs 19.28 or newer (or equivalent).

;; This version is tested against CVS-1.9 and is not guaranteed to work with
;; any version older than that.

;; Mail questions, suggestions, complaints, etc., to the PCL-CVS Support Team
;; at <pcl-cvs@cyclic.com>.  Mail bug reports to <pcl-cvs-auto-bugs@cyclic.com>
;; using the GNATS submit-pr tool (i.e. the cvsbug script).

;;; ToDo:

;; - Fix handling of marked items so that all directories with marked files are
;; handled by one command.  This may/will require changes to cvs to allow
;; specifying relative pathnames to files.

;; - Change the fileinfo stuff to eliminate the 'DIRCHANGE stuff.  We should
;; store the relative path inside the module with each item.

;;; Code:

(require 'cookie)			; provided by ELIB-1.0
(require 'add-log)			; for all the ChangeLog goodies


;;;; -------------------------------------------------------
;;;;	    START OF THINGS TO CHECK WHEN INSTALLING

(defvar cvs-program "cvs"
  "*Name or full path of the cvs executable.")

;; FIXME: this is only used by cvs-mode-diff-backup
(defvar cvs-diff-program "diff"
  "*Name or full path of 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.")

;;; There is normally no need to alter the following variables, but if
;;; your site has installed CVS in a non-standard way you might have
;;; to change them.

(defvar cvs-bakprefix ".#"
  "The prefix that CVS prepends to files when rcsmerge'ing.")

(defvar cvs-shell "/bin/sh"
  "*Full path to a shell that can redirect stdout. Typically /bin/sh.")

;;;	     END OF THINGS TO CHECK WHEN INSTALLING
;;; --------------------------------------------------------

;;;
;;;	User configuration variables:
;;;
;;; NOTE: these should be set in your ~/.emacs (or site-lisp/default.el) file.
;;;

(defvar cvs-cvsroot nil
  "*Specifies where the (current) cvs master repository is.
Overrides the environment variable $CVSROOT by sending \" -d dir\" to
all CVS commands. This switch is useful if you have multiple CVS
repositories. It can be set interactively with M-x cvs-change-cvsroot.
There is no need to set this if $CVSROOT is set to a correct value.") 

(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 does 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 t
  "*Non-nil if cvs-mode-remove-handled and cvs-update should automatically
remove empty directories from the display.
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.")

(defvar cvs-default-ignore-marks nil
  "*Non-nil if non-diffing cvs mode commands should ignore any marked files.
Normally they run 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 by default run on the file on the
current line.  See also `cvs-diff-ignore-marks'")

(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 by default run diff on the file on the
current line.")

;; NOTE: it's probably a good idea to always set cvs-diff-ignore-marks if you
;; set this too...
(defvar cvs-diff-unique-buffers t
  "*Non-nil if cvs-mode-diff* should create unique buffers instead of using the
default ``*cvs-tmp*'' buffer.")

(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-redo, 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.")

(defvar cvs-status-cmd-flags nil
  "*List of strings to pass to ``cvs status'' via cvs-status.")

(defvar cvs-checkout-cmd-flags nil
  "*List of strings to pass to ``cvs checkout'' via cvs-checkout.")

(defvar cvs-status-flags nil
  "*List of strings to pass to ``cvs status'' via cvs-mode-status.")

(defvar cvs-log-flags nil
  "*List of strings to pass to ``cvs log'' via cvs-mode-log.")

(defvar cvs-diff-flags '("-u")
  "*List of strings to use as flags to pass to ``diff'' and ``cvs diff''.  Used
by cvs-mode-diff-*.  The default is '(\"-u\").  Set this to '(\"-u\") to get a
Unidiff format, or '(\"-c\") to get context diffs.")

(defvar cvs-tag-flags nil
  "*List of extra flags to pass to ``cvs tag''.  Default is none.")

(defvar cvs-rtag-flags nil
  "*List of extra flags to pass to ``cvs rtag''.  Default is none.")

(defvar cvs-add-flags nil
  "*List of strings to use as flags to pass to ``cvs add''.
Default is none.")

(defvar cvs-commit-flags nil
  "*List of strings to use as flags to pass to ``cvs commit''.
Default is none.")

(defvar cvs-remove-flags nil
  "*List of strings to use as flags to pass to ``cvs remove''.
Default is none.")

(defvar cvs-undo-flags nil
  "*List of strings to use as flags to pass to ``cvs update'' from
`cvs-mode-undo-local-changes'.  Default is none.")

(defvar cvs-update-file-flags nil
  "*List of strings to use as flags to pass to ``cvs update'' from
`cvs-mode-update'.  Default is none.")

(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.")

(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 do not add newlines.")

(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-debug-parser nil
  "*List of parser clauses to debug.
If this variable is non-nil, it should be a list of symbols
used by the parse tables found in the variables `cvs-update-parse-table'
and `cvs-status-parse-table' to enable debugging of those clauses.")

;; 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.")



;;;
;;; Internal variables for the *cvs* buffer.
;;;

(defvar cvs-buffer-name "*cvs*"
  "Name of the cvs buffer. You should not rename this buffer.
In future versions of pcl-cvs you might be able to rename it, and you
might be able to run more than one cvs-update at the same time. For
the time being, dont try to do that.")

(defvar cvs-display-type nil
  "Type of the current display.  Either UPDATE or STATUS.")

(defvar cvs-dont-change-disc nil
  "Was ``cvs update'' called with ``-n''?")

(defvar cvs-lock-file nil
  "Full path to a lock file that CVS is waiting for (or was waiting for).
This variable is buffer local and only used in the *cvs* buffer.")

(defvar cvs-last-update-flags nil
  "Flags used by last `cvs-update', used by `cvs-mode-redo'.")

(defvar cvs-last-status-flags nil
  "Flags used by last `cvs-status', used by `cvs-mode-redo'.")

(defconst cvs-cursor-column 22
  "Column to position cursor in in cvs-mode.
Column 0 is left-most column.")

(defvar cvs-mode-map nil
  "Keymap for the cvs mode.")

;;;
;;; Internal variables for the *cvs-commit-message* buffer.
;;;

(defvar cvs-edit-mode-map nil
  "Keymap for the cvs edit mode (used when editing cvs log messages).")

(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-list nil
  "The files that are to be committed. Used internally by pcl-cvs.
This is a list of tins.")

(defvar cvs-commit-flags-to-use nil
  "The cvs flags to use for the commit. Used internally by pcl-cvs.")

;;;
;;; Internal variables for the *cvs-tmp* buffer.
;;;

(defvar cvs-temp-buffer-name "*cvs-tmp*"
  "*Name of the cvs temporary buffer.
Output from cvs is placed here by synchronous commands.")

;;;
;;; Global internal variables
;;;

(defvar cvs-process-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.")

(defconst cvs-startup-message
  (if cvs-inhibit-copyright-message
      "PCL-CVS release R-2_0-Beta_2"
    "PCL-CVS release R-2_0-Beta_2.  Copyright (C) 1991-1995 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.")

(defvar cvs-last-output-buffer nil
  "Name of the last output buffer used by `cvs-run-process'.
The output buffer is kept until the next update or status is run
to allow investigation of parse errors or sending bug reports.")

(defvar *result* nil
  "FIXME: some weird thing.")

(defvar *current-file* nil
  "FIXME: some weird thing.")

(defvar *current-dir* nil
  "FIXME: some weird thing.")

(defvar *start* nil
  "FIXME: some weird thing.")

(defvar *match-list* nil
  "List of all lists of matching fields.")

(defvar cvs-working-directory nil
  "Directory prefix for the current moudle.")

(defvar cvs-display-cvsroot nil
  "Location of the master CVS repository.
This is only used for display purposed, unlike `cvs-cvsroot'.")

(defconst cvs-vendor-branch "1.1.1"
  "The default branch used by CVS for vendor code.")

;;;
;;; Internal variables used for flags history.
;;;
(defvar cvs-status-cmd-flags-history nil)
(defvar cvs-checkout-cmd-flags-history nil)
(defvar cvs-status-flags-history nil)
(defvar cvs-log-flags-history nil)
(defvar cvs-tag-flags-history nil)
(defvar cvs-rtag-flags-history nil)
(defvar cvs-diff-flags-history nil)
(defvar cvs-update-optional-flags-history nil)
(defvar cvs-add-flags-history nil)
(defvar cvs-commit-flags-history nil)
(defvar cvs-remove-flags-history nil)
(defvar cvs-undo-flags-history   nil)
(defvar cvs-update-file-flags-history nil)



;;;; CVS Process Parser Tables:
;;;;
;;;; Parser tables for cvs-parse-process (as called from cvs-run-process)
;;;; for cvs-update and cvs-status.

(defconst cvs-update-parse-table
  '((ALT

     ;; CVS is descending a subdirectory.

     ((REGEXP "cvs \\(update\\|checkout\\|server\\): Updating \\(.*\\)$" 2)
      (PROG (setq *current-dir*
		  (cvs-get-current-dir *root-dir*
				       (car (car *match-list*)))))
      (PROG (setq *current-file* " "))
      (COLLECT
       (if (memq 'dirchange cvs-debug-parser) (debug))
       (cvs-create-fileinfo 'DIRCHANGE *current-dir* nil
			    (car (car *match-list*)))))

     ;; File removed, since it is removed (by third party) in repository.

     ((ALT
       ((REGEXP
	 "cvs \\(update\\|server\\): warning: \\(.*\\) is not (any longer) pertinent$"
	 2 0))
       ((REGEXP
	 "cvs \\(update\\|server\\): \\(.*\\) is no longer in the repository$"
	 2 0)))
      (PROG (setq *current-file* 
		  (file-name-nondirectory (car (car *match-list*)))))
      (COLLECT 
       (if (memq 'removed cvs-debug-parser) (debug))
       (let ((fileinfo (cvs-create-fileinfo 'REMOVED *current-dir*
					    (file-name-nondirectory
					     (car (car *match-list*)))
					    (buffer-substring *start*
							      (1- (point))))))
	 (cvs-set-fileinfo->handled fileinfo t)
	 (cvs-set-fileinfo->removed fileinfo t)
	 fileinfo)))

     ;; File removed by you, but recreated by cvs. Ignored.
     ;; FIXME: bug id 86 (note this is seen as UPDATED in stdout)

     ((REGEXP "cvs \\(update\\|server\\): warning: .* was lost$"))

     ;; File removed by you, but still exists.  Ignore (will be noted as removed).

     ((REGEXP "cvs \\(update\\|server\\): .* should be removed and is still there$"))

     ;; CVS waits for a lock - do nothing, handled in `cvs-update-filter'.

     ((REGEXP "cvs \\(update\\|server\\): \\[..:..:..\\] waiting for .*lock in .*$"))
     ((REGEXP "cvs \\(update\\|server\\): \\[..:..:..\\] obtained .*lock in .*$"))

     ;; File removed in repository, but edited by you.

     ((REGEXP "cvs \\(update\\|server\\): conflict: \\(.*\\) is modified but no longer in the repository$"
	      2 0)
      (PROG (setq *current-file*
		  (file-name-nondirectory (car (car *match-list*)))))
      (COLLECT
       (if (memq 'modified-and-removed cvs-debug-parser) (debug))
       (cvs-create-fileinfo 'MESSAGE *current-dir*
			    (file-name-nondirectory (car (car *match-list*)))
			    (buffer-substring *start* (1- (point))))))

     ;; A removed file modified by someone else

     ((REGEXP "cvs \\(update\\|server\\): conflict: removed \\(.*\\) was modified by second party$"
	      2 0)
      (PROG (setq *current-file* (car (car *match-list*))))
      (COLLECT
       (if (memq 'mod-conflict cvs-debug-parser) (debug))
       (cvs-create-fileinfo 'MOD-CONFLICT *current-dir*
			    (car (car *match-list*))
			    (car (cdr (car *match-list*))))))

     ;; Normal file state indicator.

     ((REGEXP "\\([MARCUp?]\\) \\(.*\\)$" 1 2)
      ;; 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
      ;; U: The file is copied from the repository.
      ;; P: The file was patched from the repository.
      ;; ?: Unknown file.
      (COLLECT
       (if (memq 'state-indicator cvs-debug-parser) (debug))
       (let*
	   ((c (car (car *match-list*)))
	    (full-path (concat (file-name-as-directory *root-dir*)
			       (car (cdr (car *match-list*)))))
	    (fileinfo
	     (progn (setq *current-dir*
			  (substring (file-name-directory full-path) 0 -1))
		    (setq *current-file* (file-name-nondirectory full-path))
		    (cvs-create-fileinfo (cond ((string= c "M") 'MODIFIED)
					       ((string= c "A") 'ADDED)
					       ((string= c "R") 'REMOVED)
					       ((string= c "C") 'CONFLICT)
					       ((string= c "U") 'UPDATED)
					       ((string= c "P") 'PATCHED)
					       ((string= c "?") 'UNKNOWN)
					       (t 'MESSAGE))
					 *current-dir* *current-file*
					 (buffer-substring *start*
							   (1- (point)))))))
	 ;; Updated/Patched files require no further action.
	 (if (or (string= c "U") (string= c "P"))
	     (cvs-set-fileinfo->handled fileinfo t))
	 fileinfo)))

     ;; CVS has decided to merge someone elses changes into this document.
     ;; About to start an rcsmerge operation...

     ((REGEXP "^RCS file: .*$")
      (REGEXP "retrieving revision \\([0-9.]+\\)$" 1) ; Initial (base) rev.
      (REGEXP "retrieving revision \\([0-9.]+\\)$" 1) ; New (head) rev.
      (REGEXP "Merging differences between [0-9.]+ and [0-9.]+ into \\(.*\\)$"
              1) ; Extract filename here.
      (COLLECT
       (let ((filename (car (car *match-list*)))
             (base-revision (car (car (cdr (cdr *match-list*)))))
             (head-revision (car (car (cdr *match-list*))))
             (merge-result 'MERGED)
             (handled nil))
         (setq *current-file* (car (car *match-list*)))

         ;; maybe skip over merge conflict warnings
         (if (and (looking-at 
                   "^\\(rcs\\)?merge[:]*\\( warning\\)?: \\(overlaps\\|conflicts\\) during merge$")
                  (save-excursion
                    (forward-line 1)
                    (looking-at (concat "^cvs \\(update\\|server\\): conflicts found in .*"
                                        (regexp-quote filename) "$"))))
             (progn
               (forward-line 2)
               (setq merge-result 'CONFLICT)))

         ;; Figure out the full path for the file, if we can.
         (if (or (looking-at (concat "^[CM] \\(.*" (regexp-quote filename) "\\)$"))
                 (looking-at (concat "^\\(.*" (regexp-quote filename)
                                     "\\) already contains the differences between .* and .*$")))
             (let ((full-path (concat (file-name-as-directory *root-dir*)
                                      (match-string 1))))
               (setq *current-dir*
                     (substring (file-name-directory full-path) 0 -1))
               (setq *current-file* (file-name-nondirectory full-path))))

         ;; Figure out result of merging (ie, was there a conflict?) and
         ;; squirrel away info about the files that were retrieved for merging
         ;; From above, we assume a MERGE which is not handled, and only
         ;; change what needs changing.
         (cond
          ;; Conflict
          ((looking-at (concat "^C \\(.*" (regexp-quote filename) "\\)$"))
           (forward-line 1)
           (setq merge-result 'CONFLICT))
          ;; Successful merge
          ((looking-at (concat "^M \\(.*" (regexp-quote filename) "\\)$"))
           (forward-line 1))
          ;; The file already contained the modifications
          ((looking-at (concat "^\\(.*" (regexp-quote filename)
                               "\\) already contains the differences between .* and .*$"))
           (forward-line 1)
           (setq handled t))
          ;; Not sure of the outcome, assume the file merged successfully.
          ;; Stupid CVS sometimes sends the message about the file already
          ;; containing the differences later, after intervening info on
          ;; other files.  We may be able to pick this up later and modify
          ;; the fileinfo's handled flag, see below.
          (t nil))

         (let ((fileinfo
                (cvs-create-fileinfo
                 merge-result *current-dir*
                 filename
                 (buffer-substring *start* (1- (point))))))
           (cvs-set-fileinfo->base-revision fileinfo base-revision)
           (cvs-set-fileinfo->head-revision fileinfo head-revision)
           (cvs-set-fileinfo->handled fileinfo handled)
           fileinfo))))

     ;; Patch informational message with CVS client.
     ;; This should have been grabbed in the merge case above,
     ;; but sometimes comes through separated from that info
     ;; by intervening info on other files.
     ;;
     ;; Try to find the fileinfo in question and set it's handled
     ;; flag to true.

     ((REGEXP "^\\(.*\\) already contains the differences between .* and .*$" 1)
      (PROG
       (let* ((full-path (concat (file-name-as-directory *root-dir*)
                                 (car (car *match-list*))))
              (this-dir (substring (file-name-directory full-path) 0 -1))
              (this-file (file-name-nondirectory full-path))
              (fileinfos the-result)) ;; Kludge: the-result bound by cvs-parse-buffer
         (while fileinfos
           (if (or (not (string= (cvs-fileinfo->dir (car fileinfos))
                                 this-dir))
                   (not (string= (cvs-fileinfo->file-name (car fileinfos))
                                 this-file)))
               (setq fileinfos (cdr fileinfos))
             (cvs-set-fileinfo->handled (car fileinfos) t)
             (setq fileinfos nil))))))

     ;; CVS is running a *info program.

     ((REGEXP "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.
      (PROG (re-search-forward cvs-update-prog-output-skip-regexp)))

     ;; This is a parse error.  Create a message-type fileinfo.

     ((REGEXP ".*$")
      (COLLECT
       (let* ((fileinfo
	       (cvs-create-fileinfo 'MESSAGE *current-dir* " "
				    (concat " Parser Error: '"
					    (buffer-substring *start*
							      (1- (point)))
					    "'"))))
	 ;; There is nothing you can do with an error message,
	 ;; so say that it is handled.
	 (cvs-set-fileinfo->handled fileinfo t)
	 fileinfo)))))
  "Parse table for `cvs update', used by cvs-parse-process.
See cvs-parse-once for parser language documentation.")

(defconst cvs-status-parse-table
  '((ALT

     ;; Waiting for lock -- handled in `cvs-update-filter'

     ((REGEXP "cvs \\(status\\|server\\): \\[..:..:..\\] waiting for .*lock in .*$"))
     ((REGEXP "cvs \\(status\\|server\\): \\[..:..:..\\] obtained .*lock in .*$"))

     ;; Directory change

     ((REGEXP "cvs \\(status\\|server\\): Examining \\(.*\\)$" 2)
      (PROG (setq *current-dir*
		  (cvs-get-current-dir *root-dir*
				       (car (car *match-list*)))))
      (PROG (setq *current-file* " "))
      (COLLECT (cvs-create-fileinfo 'DIRCHANGE *current-dir*
				    nil (car (car *match-list*)))))

     ;; Unknown files list the same as in the output of `cvs update'

     ((REGEXP "\\([?]\\) \\(.*\\)$" 1 2)
      ;; ?: Unknown file.
      (COLLECT
       (if (memq 'state-indicator cvs-debug-parser) (debug))
       (let*
	   ((c (car (car *match-list*)))
	    (full-path (concat (file-name-as-directory *root-dir*)
			       (car (cdr (car *match-list*)))))
	    (fileinfo
	     (progn
	       (setq *current-dir* (substring (file-name-directory full-path) 0 -1))
	       (setq *current-file* (file-name-nondirectory full-path))
	       (cvs-create-fileinfo (cond ((string= c "?") 'UNKNOWN)
					  (t 'MESSAGE))
				    *current-dir*
				    *current-file*
				    (buffer-substring *start*
						      (1- (point)))))))
	 fileinfo)))

     ;; The full report for a given file from 'cvs status'...

     ((REGEXP
       "===================================================================$")
      (ALT
       ;; This is never output by "cvs status .".  Sigh.
       ;; ((REGEXP "File: \\([^ \t]*\\)[ \t]+Status: Unknown$" 1)
       ;; (PROG (setq type 'UNKNOWN)))
       ((REGEXP "File: no file \\([^ \t]*\\)[ \t]+Status: Needs Checkout$" 1)
	(PROG (setq type 'NEED-REMOVE)))
       ((REGEXP "File: \\([^ \t]*\\)[ \t]+Status: Needs Checkout$" 1)
	(PROG (setq type 'NEED-UPDATE)))
       ((REGEXP "File: \\([^ \t]*\\)[ \t]+Status: Needs Patch$" 1)
	(PROG (setq type 'NEED-UPDATE)))
       ((REGEXP "File: \\([^ \t]*\\)[ \t]+Status: Unresolved Conflict$" 1)
	(PROG (setq type 'UNRES-CONFLICT)))
       ((REGEXP "File: \\([^ \t]*\\)[ \t]+Status: Locally Added$" 1)
	(PROG (setq type 'ADDED)))
       ((REGEXP "File: \\(no file[ \t]+\\)?\\([^ \t]*\\)[ \t]+Status: Locally Removed$" 2)
	(PROG (setq type 'REMOVED)))
       ((REGEXP "File: \\([^ \t]*\\)[ \t]+Status: Locally Modified$" 1)
	(PROG (setq type 'MODIFIED)))
       ((REGEXP "File: \\([^ \t]*\\)[ \t]+Status: Up-to-date$" 1)
	(PROG (setq type 'UP-TO-DATE)))
       ((REGEXP "File: \\([^ \t]*\\)[ \t]+Status: Needs Merge$" 1)
	(PROG (setq type 'NEED-MERGE))))
      (REGEXP "$")
      (ALT ;; version can have a leading `-' when the file is `cvs removed'.
       ((REGEXP " *Version:[ \t]*\\(-?[0-9.]+\\)[ \t]*.*$" 1))
       ;; NOTE: there's no date on the end of the following for server mode...
       ((REGEXP " *Working revision:[ \t]*\\(-?[0-9.]+\\)[ \t]*.*$" 1)))
      (ALT
       ((REGEXP " *RCS Version:[ \t]*\\([0-9.]+\\)[ \t]*.*$" 1))
       ((REGEXP " *Repository revision:[ \t]*\\([0-9.]+\\)[ \t]*\\(.*\\)$" 1 2)))
      (REGEXP " *Sticky Tag:[ \t]*\\(.*\\)$" 1)
      (REGEXP " *Sticky Date:[ \t]*\\(.*\\)$" 1)
      (REGEXP " *Sticky Options:[ \t]*\\(.*\\)$" 1)
      (REGEXP "$")
      (COLLECT
       (if (memq 'status-report cvs-debug-parser) (debug))
       (let* ((sticky-options (car (car *match-list*))) ; FIXME: use this
	      (sticky-tag (car (car (cdr *match-list*)))) ; FIXME: use this
	      (sticky-date (car (car (cdr (cdr *match-list*))))) ; FIXME: use this
	      (repo-path
	       (file-name-directory
		 (car (cdr (car (cdr (cdr (cdr *match-list*)))))))) ; any use?
              ;; WARNING: full-path may not be a full path, at least through
              ;; CVS 1.10 it will not be.
	      (full-path
	       (car (car (cdr (cdr (cdr (cdr (cdr *match-list*))))))))
	      (cdir (file-name-directory full-path))
	      (fileinfo
	       (progn
                 (if cdir ;; NB: only set if got a full path...
                     (setq *current-dir* (substring cdir 0 -1)))
		 (setq *current-file* (file-name-nondirectory full-path))
		 (cvs-create-fileinfo type
				      *current-dir*
				      *current-file*
				      (buffer-substring *start*
							(1- (point)))))))
	 (cvs-set-fileinfo->base-revision
	  fileinfo (car (car (cdr (cdr (cdr (cdr *match-list*)))))))
	 (cvs-set-fileinfo->head-revision
	  fileinfo (car (car (cdr (cdr (cdr *match-list*))))))
	 (cond
	  ((eq type 'UP-TO-DATE)
	   (cvs-set-fileinfo->handled fileinfo t)))
	 fileinfo)))

     ;; This is a parse error.  Create a message-type fileinfo.

     ((REGEXP ".*$")
      (COLLECT
       (let* ((fileinfo
	       (cvs-create-fileinfo 'MESSAGE *current-dir* " "
				    (concat " Parser Error: '"
					    (buffer-substring *start*
							      (1- (point)))
					    "'"))))
	 ;; There is nothing you can do with an error message,
	 ;; so say that it is handled.
	 (cvs-set-fileinfo->handled fileinfo t)
	 fileinfo)))))
  "Parse table for `cvs status', used by cvs-parse-process.
See cvs-parse-once for parser language documentation.")


;;;; The cvs-fileinfo data structure:
;;;;
;;;; When the `cvs update' is ready we parse the output.  Every file
;;;; that is affected in some way is added to the cookie collection as
;;;; a "fileinfo" (as defined below in cvs-create-fileinfo).

;;; FIXME: cvs-examine is an "update" with the viewpoint of a "status"

;;; Constructor:

(defun cvs-create-fileinfo (type
			    dir
			    file-name
			    full-log)
  "Create a fileinfo.
Arguments: TYPE DIR FILE-NAME FULL-LOG.

A fileinfo is a struct-like datatype that has the following fields:

Field name           values
----------           ------
  handled            t if this file doesn't require further action.
  marked	     t/nil.
  type		     See below
  dir		     Directory the file resides in. Should not end with slash.
  file-name	     The file name sans the directory.
  base-revision      During update: After a MERGE or CONFLICT this is
                     set to the (previous) base revision of the file.
                     During status: This is the revision that the
                     working file is based on.
  head-revision      During update: After a MERGE or CONFLICT this is
                     set to the head revision of the file, that is,
                     the revision that is merged into the file.
                     During status: This is the highest revision in
                     the repository.
  removed            t if the file no longer exists.
  full-log	     The output from cvs, unparsed.
  mod-time	     Not used.

In addition to the above, the following values can be extracted:

  full-path          The complete filename (beginning with a /).
  backup-file        For MERGED and CONFLICT files after a \"cvs update\",
                     this is a full path to the backup file where the
                     untouched version resides.

The meaning of the type field:

Value        ---Used by---   Explanation
             update status

NEED-UPDATE            x     file needs update
UPDATED	        x      x     file copied from repository
PATCHED	        x      x     diff applied from repository
MODIFIED        x      x     modified by you, unchanged in repository
ADDED	        x      x     added by you, not yet committed
NEED-REMOVE            x     rm'd, but not yet `cvs remove'd
REMOVED	        x      x     removed by you, not yet committed
NEED-MERGE             x     need merge
MERGED	        x      x     successful merge
CONFLICT        x            conflict when merging
UNRES-CONFLICT         x     conflict when merging
MOD-CONFLICT    x            removed locally, changed in repository.
DIRCHANGE       x      x     A change of directory.
UNKNOWN	        x            An unknown file.
UP-TO-DATE             x     The file is up-to-date.
MESSAGE         x      x     This is a special fileinfo that is used
                             to display a text that should be in
                             full-log."
  (cons
   'CVS-FILEINFO
   (vector nil nil type dir file-name nil nil nil full-log 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, NEED-UPDATE, UP-TO-DATE, PATCHED, MODIFIED, ADDED,
REMOVED, NEED-REMOVE, MERGED, NEED-MERGE, CONFLICT, MOD-CONFLICT,
UNRES-CONFLICT, DIRCHANGE, UNKNOWN, 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->base-revision (cvs-fileinfo)
  "Get the base revision from CVS-FILEINFO."
  (elt (cdr cvs-fileinfo) 5))

(defun cvs-fileinfo->head-revision (cvs-fileinfo)
  "Get head-revision from CVS-FILEINFO."
  (elt (cdr cvs-fileinfo) 6))

(defun cvs-fileinfo->removed (cvs-fileinfo)
  "Get removed from CVS-FILEINFO."
  (elt (cdr cvs-fileinfo) 7))

(defun cvs-fileinfo->full-log (cvs-fileinfo)
  "Get full-log from CVS-FILEINFO."
  (elt (cdr cvs-fileinfo) 8))

(defun cvs-fileinfo->mod-time (cvs-fileinfo)
  "Get mod-time from CVS-FILEINFO."
  (elt (cdr cvs-fileinfo) 9))

;;; Fake selectors:

(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-fileinfo->backup-file (fileinfo)
  "Construct the file name of the backup file for FILEINFO."
  (if (cvs-fileinfo->base-revision fileinfo)
      (concat (file-name-as-directory (cvs-fileinfo->dir fileinfo))
	      cvs-bakprefix (cvs-fileinfo->file-name fileinfo)
	      "." (cvs-fileinfo->base-revision fileinfo))))

;;; 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->base-revision (cvs-fileinfo newval)
  "Set base-revision in CVS-FILEINFO to NEWVAL."
  (aset (cdr cvs-fileinfo) 5 newval))

(defun cvs-set-fileinfo->head-revision (cvs-fileinfo newval)
  "Set head-revision in CVS-FILEINFO to NEWVAL."
  (aset (cdr cvs-fileinfo) 6 newval))

(defun cvs-set-fileinfo->removed (cvs-fileinfo newval)
  "Set removed in CVS-FILEINFO to NEWVAL."
  (aset (cdr cvs-fileinfo) 7 newval))

(defun cvs-set-fileinfo->full-log (cvs-fileinfo newval)
  "Set full-log in CVS-FILEINFO to NEWVAL."
  (aset (cdr cvs-fileinfo) 8 newval))

(defun cvs-set-fileinfo->mod-time (cvs-fileinfo newval)
  "Set full-log in CVS-FILEINFO to NEWVAL."
  (aset (cdr cvs-fileinfo) 9 newval))

;;; Predicate:

;;----------
(defun cvs-fileinfo-p (object)
  "Return t if OBJECT is a cvs-fileinfo."
  (eq (car-safe object) 'CVS-FILEINFO))

;;; fileinfo pretty-printers:

;;; FIXME: would it make more sense to have an EXAMINE display type too?
;;; Or perhaps cvs-examine should set the display type to STATUS????

;;----------
(defun cvs-file-name-relative-to-dir (file dir)
  (if (stringp cvs-working-directory)
      (let ((base (directory-file-name
                   (file-name-as-directory
                    (expand-file-name cvs-working-directory))))
            (child (expand-file-name file)))
        (if (and (>= (length child) (length base))
                 (string= base (substring child 0 (length base))))
            (concat "." (substring child (length base)))
          file))
    file))

;;----------
(defun cvs-update-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))
	(b (cvs-fileinfo->base-revision fileinfo))
	(h (cvs-fileinfo->head-revision fileinfo))
        (ci (if (cvs-fileinfo->handled fileinfo)
                "  " "ci"))
	(co (if (and (not (cvs-fileinfo->handled fileinfo))
		     cvs-dont-change-disc)
                "co" "  ")))		; for cvs-examine
    (if (null b) (setq b ""))
    (if (or (null h) (string= h b)) (setq h ""))
    (if (< (length b) 8)
	(setq b (substring (concat b "        ") 0 8)))
    (if (< (length h) 8)
	(setq h (substring (concat h "        ") 0 8)))
    (insert
     (cond
      ((eq a 'UPDATED)
       (format "%s %s Updated     %s %s %s" h s co b f))
      ((eq a 'PATCHED)
       (format "%s %s Patched     %s    %s" h s b f)) ; impossible in cvs-examine
      ((eq a 'MODIFIED)
       (format "%s %s Modified    %s %s %s" h s ci b f))
      ((eq a 'MERGED)
       (format "%s %s Merged      %s %s %s" h s ci b f))
      ((eq a 'CONFLICT)
       (format "%s %s Conflict    %s %s %s" h s ci b f))
      ((eq a 'ADDED)
       (format "%s %s Added       %s %s %s" h s ci b f))
      ((eq a 'REMOVED)
       (format "%s %s Removed     %s %s %s" h s ci b f))
      ((eq a 'UNKNOWN)
       (format "%s %s Unknown        %s %s" h s b f))
      ((eq a 'MOD-CONFLICT)
       (format "         %s Conflict: Removed by you, changed in repository: %s" s f))
      ((eq a 'DIRCHANGE)
       (format "\nIn directory %s:"
               (cvs-file-name-relative-to-dir
                (cvs-fileinfo->dir fileinfo)
                cvs-working-directory)))
      ((eq a 'MESSAGE)
       (format "\nMessage:\n%s"
	       (cvs-fileinfo->full-log fileinfo)))
      (t
       (format "         %s Internal error!   %s %s" s a f))))))

;;----------
(defun cvs-status-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))
	(b (cvs-fileinfo->base-revision fileinfo))
	(h (cvs-fileinfo->head-revision fileinfo))
        (ci (if (cvs-fileinfo->handled fileinfo)
                "  " "ci"))
	(co (if (cvs-fileinfo->handled fileinfo)
                "  " "co")))
    (if (null b) (setq b ""))
    (if (or (null h) (string= h b)) (setq h ""))
    (if (< (length b) 8)
	(setq b (substring (concat b "        ") 0 8)))
    (if (< (length h) 8)
	(setq h (substring (concat h "        ") 0 8)))
    (insert
     (cond
      ((eq a 'NEED-UPDATE)
       (format "%s %s Need-update %s %s %s" h s co b f))
      ((eq a 'UP-TO-DATE)
       (format "%s %s Up-to-date     %s %s" h s b f))
      ((eq a 'UPDATED)
       (format "%s %s Updated     %s %s %s" h s co b f))
      ((eq a 'PATCHED)
       (format "%s %s Patched     %s %s %s" h s co b f))
      ((eq a 'MODIFIED)
       (format "%s %s Modified    %s %s %s" h s ci b f))
      ((eq a 'NEED-MERGE)
       (format "%s %s Need-merge  %s %s %s" h s ci b f))
      ((eq a 'MERGED)
       (format "%s %s Merge       %s %s %s" h s co b f))
      ((eq a 'UNRES-CONFLICT)
       (format "%s %s Unresolved-conflict %s %s" h s b f))
      ((eq a 'CONFLICT)
       (format "%s %s Unresolved-conflict %s %s" h s b f))
      ((eq a 'ADDED)
       (format "%s %s Added       %s %s %s" h s ci b f))
      ((eq a 'NEED-REMOVE)
       (format "%s %s Need-remove %s %s %s" h s ci b f))
      ((eq a 'REMOVED)
       (format "%s %s Removed     %s %s %s" h s ci b f))
      ((eq a 'UNKNOWN)
       (format "%s %s Unknown        %s %s" h s b f))
      ((eq a 'MOD-CONFLICT)
       (format "%s Conflict: Removed by you, changed in repository: %s" s f))
      ((eq a 'DIRCHANGE)
       (format "\nIn directory %s:"
               (cvs-file-name-relative-to-dir
                (cvs-fileinfo->dir fileinfo)
                cvs-working-directory)))
      ((eq a 'MESSAGE)
       (format "\nMessage:\n%s"
	       (cvs-fileinfo->full-log fileinfo)))
      (t
       (format "%s Internal error!  %s %s" s a f))))))

;;;; End of the cvs-fileinfo type.

;;;; State table
;;;;
;;;; This state table holds information about what you can do.
;;;;
;;;; See the doc string for format.
;;;
;;; FIXME: currently there's no way for the user to see the
;;; applicable help string at a time when it would be useful.
;;;
;;; FIXME: this thing is very inconsistent and needs a good going
;;; over.

(defconst cvs-states
  '((NEED-UPDATE 
     t cvs-mode-do-update
     () (cvs-mode-do-update)
     (cvs-mode-diff-cvs cvs-mode-diff-head cvs-mode-diff-vendor
      cvs-mode-find-file cvs-mode-find-file-other-window)
     "A newer revision of the file exists in the repository.")
    (UPDATED
     nil nil
     () ()
     (cvs-mode-diff-head cvs-mode-diff-vendor
      cvs-mode-find-file cvs-mode-find-file-other-window)
     "The newest revision of the file has been retrieved from the repository.")
    (PATCHED
     nil nil
     () ()
     (cvs-mode-diff-head cvs-mode-diff-vendor
      cvs-mode-find-file cvs-mode-find-file-other-window)
     "The newest revision of the file has been retrieved from the repository by
means of a diff applied by the local patch program.")
    (MODIFIED
     cvs-mode-commit cvs-mode-commit
     () ()
     (cvs-mode-commit
      cvs-mode-diff-head cvs-mode-diff-vendor
      cvs-mode-find-file cvs-mode-find-file-other-window)
     "You have modified the file locally.")
    (ADDED
     cvs-mode-commit cvs-mode-commit
     () ()
     (cvs-mode-commit
      cvs-mode-find-file cvs-mode-find-file-other-window)
     "You have added the file, but not yet committed it.")
    (NEED-REMOVE
     t cvs-mode-remove-file
     t (cvs-mode-remove-file cvs-mode-add)
     ()
     "You have removed the file from your working copy, but not yet 
told CVS that you really want to remove the file.
\\[cvs-mode-remove-file]  Tell CVS to remove the file from the repository.
    (You will have to commit the removal before anybody else sees it).
\\[cvs-mode-add]  Retrieve the latest revision from the repository.")
    (REMOVED
     cvs-mode-commit cvs-mode-commit
     () ()
     (cvs-mode-commit)
     "The file is removed, but you need to commit the removal to the repository.")
    (NEED-MERGE
     t cvs-mode-do-update
     () (cvs-mode-do-update)
     (cvs-mode-diff-cvs cvs-mode-diff-head cvs-mode-diff-vendor
      cvs-mode-find-file cvs-mode-find-file-other-window)
     "The file is modified by you and a new revision is present in the repository.
You need to merge the changes into your working copy.  You can use
\\[cvs-update]  to update an entire work area, but you cannot (yet)
merge a single file from within pcl-cvs yet.  Sorry.")
    (MERGED
     cvs-mode-commit cvs-mode-commit
     () ()
     (cvs-mode-commit
      cvs-mode-diff-cvs cvs-mode-diff-backup
      cvs-mode-diff-head cvs-mode-diff-vendor
      cvs-mode-find-file cvs-mode-find-file-other-window)
     "Changes from the repository have been merged into your working copy of
the file.  No conflicts were found.  You need to commit your changes.")
    (CONFLICT
     cvs-mode-emerge cvs-mode-emerge
     () ()
     (cvs-mode-emerge
      cvs-mode-commit
      cvs-mode-diff-cvs cvs-mode-diff-backup
      cvs-mode-diff-head cvs-mode-diff-vendor
      cvs-mode-find-file cvs-mode-find-file-other-window)
     "Conflicts were found while merging changes made in the repository with
your copy of the file.  You have to resolve those conflicts manually,
and then commit the file.")
    (UNRES-CONFLICT
     cvs-mode-emerge cvs-mode-emerge
     () ()
     (cvs-mode-emerge
      cvs-mode-commit
      cvs-mode-diff-cvs cvs-mode-diff-backup 
      cvs-mode-diff-head cvs-mode-diff-vendor
      cvs-mode-find-file cvs-mode-find-file-other-window)
     "Unresolved conflicts still exists in the file.  You have to fix
them before attempting to commit the file.")
    (MOD-CONFLICT
     cvs-mode-add cvs-mode-add
     () ()
     (cvs-mode-add)
     "You have removed the file, but somebody have committed a newer
revision than the one you are trying to remove.  Use
\\[cvs-mode-add]  to cancel your removal of the file and get the
latest revision.  You can then try to remove the file again.")
    (DIRCHANGE
     t t
     () ()
     (cvs-mode-commit
      cvs-mode-diff-cvs cvs-mode-diff-backup 
      cvs-mode-diff-head cvs-mode-diff-vendor
      cvs-mode-find-file cvs-mode-find-file-other-window)
     "This line represents a directory.  Several operations can be performed on
the directory as a whole; they will be applied to all of the files in the
directory where it makes sense.  Other files will be ignored.

\\[cvs-mode-find-file] and \\[cvs-mode-find-file-other-window] will run dired."
     )
    (UNKNOWN
     cvs-mode-ignore t
     () ()
     (cvs-mode-ignore
      cvs-mode-add-file cvs-mode-remove-file
      cvs-mode-find-file cvs-mode-find-file-other-window)
     "CVS doesn't know what to make of this file.  You can add it to the
repository, tell CVS to ignore it, or remove the file.")
    (UP-TO-DATE
     t cvs-mode-find-file
     () ()
     (cvs-mode-find-file cvs-mode-find-file-other-window)
     "The file is up-to-date (that is, the latest revision in the
repository is identical to your working copy).")
    (MESSAGE
     nil nil
     () ()
     ()
     "Either this is a status message that you can ignore, or something
went wrong.  Anyhow, pcl-cvs is not smart enough to handle
this case.  You might have to fix this situation manually."))
  "Fileinfo state descriptions for pcl-cvs.

This is an assoc list.  Each element consists of a state
(described in cvs-create-fileinfo) which is the key, two default
action functions (one for UPDATE and one for STATUS display
types), two lists of applicable functions (one for UPDATE and one
for STATUS display types), and another list of always applicable
functions, and finally a help text string.")


;;;;
;;;; Utility functions
;;;;

;;----------
(defun cvs-applicable-p (fileinfo func &optional display-type)
  "Check if FUNC is applicable on FILEINFO.
Internal pcl-cvs use only."
  (if (null display-type)
      (setq display-type cvs-display-type))
  (let ((state (assq (cvs-fileinfo->type fileinfo) cvs-states))
	(offset (cond ((eq display-type 'UPDATE) 0)
		      ((eq display-type 'STATUS) 1)
		      (t (error "unknown display type %s"
				(symbol-name display-type))))))
    (or state (error "Internal error -- no state in cvs-states for %s"
		     (symbol-name (cvs-fileinfo->type fileinfo))))
    (or (eq func (nth offset state))	; 0th or 1st item
	(memq func (nth (+ 2 offset) state)) ; 2nd or 3rd item
	(memq func (nth 4 state)))))	; 4th item

;;----------
(defun cvs-assert-applicable (fileinfo func &optional display-type)
  "Signal an error if FUNC cannot be applied to FILEINFO
Internal pcl-cvs use only."
  (or (cvs-applicable-p func fileinfo display-type)
      (error "Operation (%s) not allowed."
	     (symbol-name func))))

;;----------
(defun cvs-filter-applicable (fileinfos func &optional display-type)
  "Return a list of of all fileinfos that FUNC can be performed on.
Other fileinfos are silently ignored."
  (cvs-filter (function cvs-applicable-p) fileinfos func display-type))

;;----------
(defun cvs-use-temp-buffer (&optional name)
  "Display a temporary buffer in another window and select it.
If NAME is a string use it as the name of the buffer, otherwise
default to the name given by cvs-temp-buffer-name.

The selected window will not be changed.  The temporary buffer will be erased
and writable.  The buffer's default-directory will be that of the buffer
displayed in the current window.  The buffer will not maintain undo
information."

  (let ((dir default-directory)
	(bufname (if (and name
			  (stringp name))
		     name
		   cvs-temp-buffer-name)))
    (display-buffer (get-buffer-create bufname))
    (set-buffer bufname)
    (buffer-disable-undo)
    (setq buffer-read-only nil)
    (setq default-directory dir)
    (erase-buffer)))

;;----------
(defun cvs-run-process (directory pre-args cvs-command post-args
				  pretty-printer)
  "In DIRECTORY run cvs with PRE-ARGS and CVS-COMMAND and POST-ARGS.

Args: DIRECTORY PRE-ARGS CVS-COMMAND POST-ARGS PRETTY-PRINTER

DIRECTORY must be fully expanded.

PRE-ARGS and POST-ARGS are lists of string arguments to pass to CVS
which come before and after CVS-COMMAND.

PRETTY-PRINTER is the function used to print the fileinfos in the
*cvs* buffer."
  (save-some-buffers)
  ;; CVS 1.4 does not require CVSROOT to be set if CVS/Root exists.
  ;; (if (not (or (getenv "CVSROOT") cvs-cvsroot))
  ;;    (error "Both cvs-cvsroot and environment variable CVSROOT unset."))
  (if cvs-last-output-buffer
      (condition-case nil
          (kill-buffer cvs-last-output-buffer)
        (t nil)))
  (let* ((output-buffer (get-buffer-create
                         (generate-new-buffer-name
                          (format "*cvs-%s:%s*"
                                  cvs-command
                                  (file-name-nondirectory
                                   (substring directory 0 -1))))))
	 (args nil)
         (args-string nil))
    ;; Check that directory exists
    (if (not (file-directory-p directory))
	(error "%s is not a directory." directory))
    ;; Check that at most one cvs process is run at any time.
    (if (and cvs-process-running
	     (or (eq (process-status cvs-process-running) 'run)
		 (eq (process-status cvs-process-running) 'stop)))
	(error "Can not (yet) run two cvs processes simultaneously."))
    ;; Generate the command line
    (setq args (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
		       pre-args
		       (list cvs-command)
		       post-args))
    (setq args-string (mapconcat 'cvs-quote-multiword-string args " "))
    ;; Set up the buffer that receives the output from the cvs process.
    (set-buffer output-buffer)
    (make-local-hook 'kill-buffer-hook)
    (add-hook 'kill-buffer-hook
	      (function
	       (lambda ()
		 (if cvs-process-running
		     (progn
		       (set-process-filter cvs-process-running nil)
		       (set-process-sentinel cvs-process-running nil)
		       (delete-process cvs-process-running)))))
	      nil t)
    (cvs-set-display-cvsroot directory)
    (setq cvs-working-directory directory)
    (setq default-directory directory)
    (setq cvs-process-running
          ;; #### why do we care about process-connection-type?
	  (let ((process-connection-type nil)) ; Use a pipe, not a pty.
	    (apply #'start-process "cvs" output-buffer cvs-program args)))
    (setq mode-line-process
	  (concat ": "
		  (symbol-name (process-status cvs-process-running))))
    (force-mode-line-update)
    (set-marker (process-mark cvs-process-running) (point-min))
    (save-excursion
      (set-buffer (get-buffer-create cvs-buffer-name))
      (setq buffer-read-only nil)
      (erase-buffer)
      (cvs-mode)
      (make-local-hook 'kill-buffer-hook)
      (add-hook 'kill-buffer-hook
		(lambda ()
                  (condition-case nil
                      (kill-buffer cvs-last-output-buffer)
                    (t nil)))
		nil t))
    (setq cvs-cookie-handle
	  (collection-create
	   cvs-buffer-name pretty-printer
           (format "%s\n\nCVSROOT directory: %s\nWorking directory: %s\n"
                   cvs-startup-message       ;See comment above cvs-startup-message.
                   (if (stringp cvs-display-cvsroot)
                       (directory-file-name cvs-display-cvsroot)
                     "?????")
                   (if (stringp cvs-working-directory)
                       (directory-file-name cvs-working-directory)
                     "?????"))
	   "\n--------------------- End ---------------------"))
    (cookie-enter-first
     cvs-cookie-handle
     (cvs-create-fileinfo 'MESSAGE nil nil
			  (concat "Running `cvs"
				  (if args-string (concat " " args-string))
				  "' ...\n")))
    (set-buffer cvs-buffer-name)
    (setq default-directory directory)
    (setq mode-line-process
	  (concat ": "
		  (symbol-name (process-status cvs-process-running))))
    (force-mode-line-update)
    (setq buffer-read-only t)
    (setq cvs-last-output-buffer output-buffer))
  ;; 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-sentinel (proc msg)
  "Sentinel for the cvs update process.
This is responsible for parsing the output from the cvs update when
it is finished."
  (let ((procbuffer (process-buffer proc)))
    (if (memq (process-status proc) '(signal exit))
	(progn
	  (if (null (buffer-name procbuffer))
	      ;; buffer was killed  (FIXME should we clear cvs-process-running?)
	      (set-process-buffer proc nil)
	    (let* ((obuf (current-buffer)))
	      ;; save-excursion isn't the right thing if
	      ;;  process-buffer is current-buffer
	      (unwind-protect
		  (progn
		    (set-buffer procbuffer)
		    (progn
		      (setq mode-line-process
			    (concat ": "
				    (symbol-name (process-status proc))))
		      (force-mode-line-update)
		      (cond
		       ((eq cvs-display-type 'UPDATE)
			(cvs-parse-process procbuffer
					   cvs-update-parse-table))
		       ((eq cvs-display-type 'STATUS)
			(cvs-parse-process procbuffer
					   cvs-status-parse-table))
		       (t (error "unknown display type %s" (symbol-name
							    cvs-display-type))))
		      ;; Since the buffer and mode line will show that the
		      ;; process is dead, we can delete it now.  Otherwise it
		      ;; will stay around until M-x list-processes.
		      (delete-process proc)))
		(set-buffer obuf))))
          (message "CVS process has completed")
	  (setq cvs-process-running nil)))))

;;----------
(defun cvs-parse-process (proc-buffer parse-table)
  "Parse the output from `cvs update' or `cvs status'.

Args: PROC-BUFFER PARSE-TABLE

This functions parses the output from the cvs process and prints a
pretty representation of it in the *cvs* buffer using the cookie
package.

Signals an error if unexpected output was detected in the buffer."
  (let* ((*root-dir* default-directory)
	 (*current-dir* *root-dir*)
	 (*current-file* " ")
	 (fileinfos (cvs-parse-buffer proc-buffer parse-table)))
    (collection-clear cvs-cookie-handle)
    (collection-append-cookies
     cvs-cookie-handle
     ;; The 'nreverse' below is there so that parse error lines
     ;; appear in a reasonably sane order.  This construct relies
     ;; on the fact that 'sort' implements a stable sort.
     (sort (nreverse fileinfos)
	   (function cvs-compare-fileinfos)))
    (if cvs-auto-remove-handled-directories
	(cvs-remove-empty-directories))
    (set-buffer cvs-buffer-name)
    (cvs-mode)
    (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).

CVS will print information about some files, for instance files that
are Merged or in Conflict, to both stdout and stderr. It turns out
that the output that is sent to stdout is always redundant in such
cases. This is the easiest way to get rid of it."
  (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 and
some other criteria is fulfilled.
See cvs-remove-stdout-shadows for further explanation."
  (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))
     ;; This (the or clause) might be redundant, but will remain
     ;; because I believe in defensive programming.
     (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))))))

;; FIXME+++ There should be an Elib equivalent to this function.
;;----------
(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-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-set-display-cvsroot (dir)
  "Sets cvs-display-cvsroot for DIRECTORY."
  (cond
   (cvs-cvsroot
    (setq cvs-display-cvsroot cvs-cvsroot))
   ((getenv "CVSROOT")
    (setq cvs-display-cvsroot (getenv "CVSROOT")))
   ((file-readable-p (concat dir "CVS/Root"))
    (save-excursion
      (find-file (concat dir "CVS/Root"))
      (goto-char (point-min))
      (setq cvs-display-cvsroot
	    (buffer-substring (point) (progn (end-of-line) (point))))
      (if (not cvs-display-cvsroot)
	  (error "Invalid contents of %sCVS/Root" dir))
      (kill-buffer (current-buffer))))
   (t
    (setq cvs-display-cvsroot nil))))

;;----------
(defun cvs-quote-multiword-string (str)
  "Quote STR surrounded in quotes if it contains whitespace or quotes.
This is *only* used for informational messages so the fact that it
does not do proper shell quoting in all cases is not really a huge issue."
  (cond ((string-match "[']" str)
	 (concat "\"" str "\""))
        ((string-match "[ \t\n\"]" str)
	 (concat "'" str "'"))
	(t
	 str)))

;;----------
(defun cvs-parse-arguments (str)
  "Parse shell-like argument string into a list of arguments.
Apply shell-like quoting rules.  Used when reading flags for CVS commands."
  (let (result)
    (while (not (string= str ""))
      (if (string-match "^[ \t\n]+" str)
          (setq str (substring str (match-end 0))))
      (let ((one ""))
        (while (and (not (string= str ""))
                    (not (string-match "^[ \t\n]+" str)))
          (cond ((or (string-match "^[']\\([^']*\\)[']" str)
                     (string-match "^[\"]\\([^\"]*\\)[\"]" str))
                 (setq one (concat one (substring str (match-beginning 1)
                                                      (match-end 1))))
                 (setq str (substring str (match-end 0))))
                ((string-match "^[^ \t\n'\"]+" str)
                 (setq one (concat one (substring str (match-beginning 0)
                                                      (match-end 0))))
                 (setq str (substring str (match-end 0))))
                ((string-match "^['\"][^ \t\n]*" str)
                 (setq one (concat one (substring str (match-beginning 0)
                                                      (match-end 0))))
                 (setq str (substring str (match-end 0))))))
        (setq result (cons one result))))
    (nreverse result)))

;;----------
(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'.
The ordering defined by this function is such that directories are
sorted alphabetically, and inside every directory the DIRCHANGE
fileinfo will appear first, followed by all files (alphabetically)."
  (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-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)))))


;;;; The parser

;;----------
(defun cvs-parse-buffer (buffer parse-spec)
  "Parse data from BUFFER according to PARSE-SPEC.
Args: BUFFER PARSE-SPEC

Return a list of collected entries, or t if an error occured.
See cvs-parse-once for further documentation."
  (save-window-excursion
    (set-buffer buffer)
    (goto-char (point-min))
    (let (the-result)
      (while (and (not (eobp))
		  (not (eq the-result t)))
	(let ((*start* (point))
	      *match-list*
	      *result*)
	  (if (cvs-parse-once parse-spec)
	      (if *result*
		  (setq the-result (append *result* the-result)))
	    (setq the-result t))))
      the-result)))

;;----------
(defun cvs-parse-once (parse-spec)
  "Parse the current buffer using PARSE-SPEC.

PARSE-SPEC is a list of expressions constructed from the parser language.

Documentation for the parser language:

    (REGEXP regexp &optional field-list)
 
 	-- Succeed if (looking-at regexp), and append match-data for
 	   the fields in field-list to a global list.
 
    (PROG action1 .. actionN)
 
 	-- Run action1 through actionN. Always succeed. While evaluating
           action, the following variables are bound:
 
 		*start*      -- Buffer position of start of match.
 		*match-list* -- List of all lists of matching fields.
 
 	   Also, point is set, and actions may modify point (and thus
 	   cause the parser to move to another place in the buffer).
 
    (COLLECT action1 .. actionN)
 
 	-- Like (PROG action1 .. actionN), but the result from actionN is
           appended to a list that is returned by the parser.
 
    (ALT list1 list2 ... listn)
 
 	-- Try to match against the specification in list1. If it
 	   fails, try list2, and so on. Succeed if any of the
 	   alternatives succeed.

Returns t on success, nil on error."
  (let ((ok t))
    (while (and parse-spec ok)
      (cond
       ((eq (car (car parse-spec)) 'COLLECT)
        (let ((actions (cdr (car parse-spec)))
              (collect-result nil))
          (while actions
            (setq collect-result (eval (car actions)))
            (setq actions (cdr actions)))
          (setq *result* (cons collect-result *result*))))
       ((eq (car (car parse-spec)) 'PROG)
        (let ((actions (cdr (car parse-spec))))
          (while actions
            (eval (car actions))
            (setq actions (cdr actions)))))
       ((eq (car (car parse-spec)) 'REGEXP)
	(cond
	 ;; Is it a match? (The regexp must be anchored at the end of a line).
	 ((and (looking-at (car (cdr (car parse-spec))))
	       (progn (goto-char (match-end 0))
		      (eolp)))
	  ;; Skip the newline (unless we already are at the end of the buffer).
	  (if (< (point) (point-max))
	      (forward-char))
	  ;; Maybe extend *match-list*.
	  (if (cdr (cdr (car parse-spec)))
	      (setq *match-list*
		    (cons (cvs-extract-matches (cdr (cdr (car parse-spec))))
			  *match-list*))))
	 (t
	  ;; Failure. Return nil.
	  (setq ok nil))))
       ((eq (car (car parse-spec)) 'ALT)
	(setq ok (cvs-parse-alternatives (cdr (car parse-spec)))))
       (t
	(error "Undefined parse action %s" (car (car parse-spec)))))
      (setq parse-spec (cdr parse-spec)))
    ok))

;;----------
(defun cvs-extract-matches (match-list)
  "Extract matches."
  (mapcar (function
	   (lambda (x)
	     (buffer-substring (match-beginning x) (match-end x))))
	  match-list))

;;----------
(defun cvs-parse-alternatives (parse-spec)
  "Parse among alternatives.
Returns t on success, nil on failure."
  (let ((current-result *result*)
	(current-match-list *match-list*)
	(current-point (point))
	(ok nil))
    (while (and parse-spec (not ok))
      (if (cvs-parse-once (car parse-spec))
	  (setq ok t)
	(setq *result* current-result)
	(setq *match-list* current-match-list)
	(goto-char current-point)
	(setq parse-spec (cdr parse-spec))))
    ok))


;;;;
;;;; Code for handling permanent/temporary flag setting
;;;;

;;----------
(defun cvs-with-flags-1 (arg flag-sym desc)
  "Helper function for macro to use to handle flag setting."
  (if arg
      (let ((temp-sym  (intern (concat (symbol-name flag-sym) "-temp")))
            (hist-sym  (intern (concat (symbol-name flag-sym) "-history")))
            (permanent (and (> (prefix-numeric-value arg) 4)
                            (< (prefix-numeric-value arg) 64))))
        (if (not (boundp temp-sym))
            (set temp-sym nil))
        (let ((flags
               (cvs-parse-arguments
                (read-string (format "Set %s flags %s: " desc
                                     (if permanent
                                         "permanently"
                                       "for this invocation"))
                             (mapconcat 'cvs-quote-multiword-string
                                        (symbol-value
                                         (if permanent flag-sym temp-sym))
                                        " ")
                             hist-sym))))
          (set temp-sym flags)
          (if permanent
              (set flag-sym flags))
          flags))
    (symbol-value flag-sym)))

;;----------
(defmacro cvs-with-flags (arg flags desc &rest body)
  "Macro to use to handle flag setting."
  `(let ((,flags (cvs-with-flags-1 ,arg (quote ,flags) ,desc)))
     ,@body))
(put 'cvs-with-flags 'lisp-indent-function 3)



;;;;
;;;; The code for running a "cvs update" in various ways.
;;;;

;;----------
;;;###autoload
(defun cvs-examine (directory &optional arg)
  "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.

With a prefix argument, prompt for cvs flags to use."
  (interactive (list (read-file-name "CVS Examine (directory): "
				     nil default-directory nil)
		     current-prefix-arg))
  ;; If the previous prompt was in a dialog box, the save-some-buffers
  ;; in cvs-do-update will lose.
  (cvs-with-flags arg cvs-update-optional-flags "`cvs -n update'"
  (let ((use-dialog-box nil))
    (cvs-do-update directory 'noupdate))
  (switch-to-buffer cvs-buffer-name)))

;;----------
;;;###autoload
(defun cvs-examine-other-window (directory &optional arg)
  "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, display it in the other window,
and run cvs-mode on it.

With a prefix argument, prompt for cvs flags to use."
  (interactive (list (read-file-name "CVS Examine other window (directory): "
				     nil default-directory nil)
		     current-prefix-arg))
  (cvs-with-flags arg cvs-update-optional-flags "`cvs -n update'"
  (let ((use-dialog-box nil))
    (cvs-do-update directory 'noupdate))
  (switch-to-buffer-other-window cvs-buffer-name)))

;;----------
;;;###autoload
(defun cvs-update (directory &optional arg)
  "Run a 'cvs update' in the current working directory.
Feed the output to a *cvs* buffer and run cvs-mode on it.

With a prefix argument, prompt for cvs flags to use."
  (interactive (list (read-file-name "CVS Update (directory): "
				     nil default-directory nil)
		     current-prefix-arg))
  (cvs-with-flags arg cvs-update-optional-flags "`cvs update'"
  (let ((use-dialog-box nil))
    (cvs-do-update directory nil))
  (switch-to-buffer cvs-buffer-name)))

;;----------
;;;###autoload
(defun cvs-update-other-window (directory &optional arg)
  "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.

With a prefix argument, prompt for cvs flags to use."
  (interactive (list (read-file-name "CVS Update other window (directory): "
				     nil default-directory nil)
		     current-prefix-arg))
  (cvs-with-flags arg cvs-update-optional-flags "`cvs update'"
  (let ((use-dialog-box nil))
    (cvs-do-update directory nil))
  (switch-to-buffer-other-window cvs-buffer-name)))

;;----------
(defun cvs-do-update (directory dont-change-disc)
  "Do a 'cvs update' in DIRECTORY.
Args: DIRECTORY DONT-CHANGE-DISC.
If DONT-CHANGE-DISC is non-nil 'cvs -n update' is executed."

  (let* ((this-dir (file-name-as-directory (expand-file-name directory))))
    ;; Check that this-dir is under CVS control.
    (if (not (file-directory-p (concat this-dir "CVS")))
	(error "%s does not contain CVS controlled files." this-dir))
    (if (and cvs-update-optional-flags
	     (not (listp cvs-update-optional-flags)))
	(error "cvs-update-optional-flags must be a list of strings."))
    (setq cvs-dont-change-disc dont-change-disc)
    (setq cvs-display-type 'UPDATE)
    (setq cvs-last-update-flags cvs-update-optional-flags)
    (cvs-run-process this-dir (if dont-change-disc (list "-n"))
		     "update" cvs-update-optional-flags
		     (function cvs-update-pp)))
  (set-process-sentinel cvs-process-running 'cvs-sentinel)
  (set-process-filter cvs-process-running 'cvs-update-filter))

;;----------
(defun cvs-update-filter (proc string)
  "Filter function for pcl-cvs.
This function gets the output of the CVS process.  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\\|status\\|server\\): \\[..:..:..\\] waiting for \\(.*\\)lock in \\(.*\\)$")
	      (let ((lock-file (buffer-substring (match-beginning 3)
						 (match-end 3))))
		(save-excursion
		  (set-buffer (collection-buffer cvs-cookie-handle))
		  (make-local-variable 'cvs-lock-file)
		  (setq cvs-lock-file lock-file))

		(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 " lock-file
			  ".\n\t (type M-x cvs-mode-delete-lock to delete it)"))))))))
      (store-match-data data)
      (set-buffer old-buffer))))


;;;;
;;;; The code for running a "cvs checkout".
;;;;

;;----------
;;;###autoload
(defun cvs-checkout (module directory &optional arg)
  "Run a 'cvs checkout MODULE' in DIRECTORY.
Feed the output to a *cvs* buffer, display it in the current window,
and run cvs-mode on it.

With a prefix argument, prompt for cvs flags to use."
  (interactive (list (read-string "Module Name: ")
                     (read-file-name "CVS Checkout Directory: "
				     nil default-directory nil)
		     current-prefix-arg))
  (cvs-with-flags arg cvs-checkout-cmd-flags "`cvs checkout'"
  (cvs-do-checkout module directory)
  (switch-to-buffer cvs-buffer-name)))

;;----------
;;;###autoload
(defun cvs-checkout-other-window (module directory &optional arg)
  "Run a 'cvs checkout MODULE' in DIRECTORY.
Feed the output to a *cvs* buffer, display it in the other window,
and run cvs-mode on it.

With a prefix argument, prompt for cvs flags to use."
  (interactive (list (read-string "Module Name: ")
                     (read-file-name "CVS Checkout Directory: "
				     nil default-directory nil)
		     current-prefix-arg))
  (cvs-with-flags arg cvs-checkout-cmd-flags "`cvs checkout'"
  (cvs-do-checkout module directory)
  (switch-to-buffer-other-window cvs-buffer-name)))

;;----------
(defun cvs-do-checkout (module &optional directory)
  "Do a 'cvs checkout' of MODULE in DIRECTORY.
If DIRECTORY is nil, use default-directory."
  (setq cvs-dont-change-disc nil)
  (setq cvs-display-type 'UPDATE)
  (setq cvs-last-update-flags cvs-update-optional-flags)
  (cvs-run-process (if directory directory default-directory)
		   nil "checkout" (append cvs-checkout-cmd-flags
                                          (list module))
		   (function cvs-update-pp))
  (set-process-sentinel cvs-process-running 'cvs-sentinel)
  (set-process-filter cvs-process-running 'cvs-update-filter))


;;;;
;;;; The code for running a "cvs status".
;;;;

; NOTE:  is cvs-status really that much of a win?  Why not just cvs-examine?
;
; Cvs-status does give us rev numbers in addition to not modifying anything.
;
; But what are rev numbers really good for?  CVS uses tags for release
; management, and other than for wee details about specific files, rev numbers
; are probably more confusing and misleading than anything else.
;
; Currently "cvs status" is somewhat boring too, in that it is for now
; impossible to determine what directory a given file exists in.  That is why
; you need to run "cvs status -l" (by setting cvs-status-cmd-flags to '("-l")).
; Eventually we'll know the directory because "cvs status" will print the
; relative path in the "File:" field [[ I hope!  ;-) ]].
;
; Maybe "cvs status" could be supplanted by a new state display command instead
; with an easier to parse format much more like "cvs log" (one line per field)
; and of course it would display the relative path of the working file
; (relative to the invocation directory, that is).

;;----------
;;;###autoload
(defun cvs-status (directory &optional arg)
  "Run a 'cvs status' in the current working directory.
Feed the output to a *cvs* buffer and run cvs-mode on it.

With a prefix argument, prompt for cvs flags to use."
  (interactive (list (read-file-name "CVS Status (directory): "
				     nil default-directory nil)
		     current-prefix-arg))
  (cvs-with-flags arg cvs-status-cmd-flags "`cvs status'"
  (cvs-do-status directory)
  (switch-to-buffer cvs-buffer-name)))

;;----------
;;;###autoload
(defun cvs-status-other-window (directory &optional arg)
  "Run a 'cvs status' in the current working directory.
Feed the output to a *cvs* buffer, display it in the other window,
and run cvs-mode on it.

With a prefix argument, prompt for cvs flags to use."
  (interactive (list (read-file-name "CVS Status other window (directory): "
				     nil default-directory nil)
		     current-prefix-arg))
  (cvs-with-flags arg cvs-status-cmd-flags "`cvs status'"
  (cvs-do-status directory)
  (switch-to-buffer-other-window cvs-buffer-name)))

;;----------
(defun cvs-do-status (directory)
  "Do a 'cvs status' in DIRECTORY."
  (let* ((this-dir (file-name-as-directory (expand-file-name directory))))
    ;; Check that this-dir is under CVS control.
    (if (not (file-directory-p (concat this-dir "CVS")))
	(error "%s does not contain CVS controlled files." this-dir))
    (setq cvs-dont-change-disc t)
    (setq cvs-display-type 'STATUS)
    (setq cvs-last-status-flags cvs-status-cmd-flags)
    (cvs-run-process this-dir nil
		     "status" cvs-status-cmd-flags
		     (function cvs-status-pp)))
  (set-process-sentinel cvs-process-running 'cvs-sentinel)
  (set-process-filter cvs-process-running 'cvs-update-filter))


;;;;
;;;; The cvs-mode and its associated commands.
;;;;

;; Get the macro make-help-screen when this is compiled,
;; or run interpreted, but not when the compiled code is loaded.
;(eval-when-compile (require 'help-macro))

(put 'cvs-mode 'mode-class 'special)

;;----------
(defun cvs-mode ()
  "\\<cvs-mode-map>Mode used for pcl-cvs, a frontend to CVS.

To get the *cvs* buffer you should use ``\\[cvs-update]''.

Full documentation is in the Texinfo file.  These are the most useful commands:

\\[cvs-mode-previous-line] Move up.                    \\[cvs-mode-next-line] Move down.
\\[cvs-mode-commit]   Commit file.                \\[cvs-mode-changelog-commit]   Commit file with comment from ChangeLog.
\\[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-mark-matching-files]   Mark matching files.        \\[cvs-mode-toggle-marks]   Toggle whether command uses marks.
\\[cvs-mode-find-file]   Edit file/run Dired.        \\[cvs-mode-find-file-other-window]   Find file or run Dired in other window.
\\[cvs-mode-remove-handled]   Remove processed entries.   \\[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 between base revision. \\[cvs-mode-diff-backup] Diff between backup file.
\\[cvs-mode-diff-vendor]   Diff with vendor branch.    \\[cvs-mode-diff-head] Diff between head revision.
\\[cvs-mode-emerge]   Emerge w/base rev & backup. \\[cvs-mode-ediff]   Ediff w/base rev & backup.
\\[cvs-mode-acknowledge] Delete line from buffer.    \\[cvs-mode-ignore]   Add file to the .cvsignore file.
\\[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-redo]   Re-update directory.        \\[cvs-update]   Update new directory.
\\[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 R-2_0-Beta_1 of pcl-cvs.

All bindings:
\\{cvs-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'cvs-mode)
  (setq mode-name "CVS")
  (setq mode-line-process nil)
  (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))

;;; You can define your own keymap in .emacs. pcl-cvs.el won't overwrite it.
;;; You can also modify the keymap in a cvs-mode-hook function.

(if cvs-mode-map
    nil					; leave the one that's there....
  (setq cvs-mode-map (make-keymap))
  (define-prefix-command 'cvs-mode-map-diff-prefix)
  (define-prefix-command 'cvs-mode-map-control-c-prefix)
  (suppress-keymap cvs-mode-map)
  ;; misc keys
  (define-key cvs-mode-map "?"	'cvs-help)
  (define-key cvs-mode-map "h"	'cvs-help)
  (define-key cvs-mode-map "q"	'cvs-mode-quit)
  (define-key cvs-mode-map "%"	'cvs-mode-mark-matching-files)
  (define-key cvs-mode-map "T"	'cvs-mode-toggle-marks)
  ;; navigation keys
  (define-key cvs-mode-map " "		'cvs-mode-next-line)
  (define-key cvs-mode-map "\C-n"	'cvs-mode-next-line)
  (define-key cvs-mode-map "\C-p"	'cvs-mode-previous-line)
  (define-key cvs-mode-map "n"		'cvs-mode-next-line)
  (define-key cvs-mode-map "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-c\C-d"	'cvs-mode-set-diff-flags)
  (define-key cvs-mode-map "\C-c\C-l"	'cvs-mode-set-log-flags)
  (define-key cvs-mode-map "\C-c\C-s"	'cvs-mode-set-status-flags)
  (define-key cvs-mode-map "\C-c\C-u"	'cvs-mode-set-update-optional-flags)
  (define-key cvs-mode-map "\C-c?"	'cvs-mode-set-help)
  ;; M- keys are usually those that operate on modules
  (define-key cvs-mode-map "M"		'cvs-mode-mark-all-files)
  (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-checkout)
  (define-key cvs-mode-map "\M-o"	'cvs-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)
  (define-key cvs-mode-map "G"		'cvs-update)
  (define-key cvs-mode-map "Q"		'cvs-examine)
  (define-key cvs-mode-map "S"		'cvs-status)
  ;; keys that operate on individual files
  (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 "="	'cvs-mode-diff-cvs)
  (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 "O"	'cvs-mode-update)
  (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 "c"	'cvs-mode-commit)
  (define-key cvs-mode-map "d"	'cvs-mode-map-diff-prefix)
  (define-key cvs-mode-map "d="	'cvs-mode-diff-cvs)
  (define-key cvs-mode-map "db"	'cvs-mode-diff-backup)
  (define-key cvs-mode-map "dd"	'cvs-mode-diff-cvs)
  (define-key cvs-mode-map "dh"	'cvs-mode-diff-head)
  (define-key cvs-mode-map "dv"	'cvs-mode-diff-vendor)
  (define-key cvs-mode-map "d?"	'cvs-mode-diff-help)
  (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-redo)
  (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 "o"	'cvs-mode-find-file-other-window)
  (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-mode-quit ()
  "Quit PCL-CVS, killing the `*cvs*' buffer."
  (interactive)
  (and (y-or-n-p "Quit pcl-cvs? ")
       (kill-buffer cvs-buffer-name)))

;; Give help....

;;----------
;;;###autoload
(defun cvs-help ()
  "Display help for various PCL-CVS commands."
  (interactive)
  (cond
   ((eq last-command 'cvs-help)
    (describe-function major-mode))
   (t (message
       (substitute-command-keys
	"\\[cvs-help]:help \\[cvs-mode-add]:add \\[cvs-mode-commit]:commit \\[cvs-mode-changelog-commit]:commit-from-ChangeLog \\[cvs-mode-map-diff-prefix]:diff* \\[cvs-mode-log]:log \\[cvs-mode-remove-file]:remove \\[cvs-mode-status]:status \\[cvs-mode-undo-local-changes]:undo")))))

;;----------
(defun cvs-mode-diff-help ()
  "Display help for cvs-mode-diff-* functions."
  (interactive)
  (message "db:backup d=:base dh:head dv:vendor"))

;;----------
(defun cvs-mode-set-help ()
  "Display help for cvs-mode-set-* functions."
  (interactive)
  (message
   (substitute-command-keys
    "\\[cvs-mode-set-diff-flags]:diff-flags \\[cvs-mode-set-log-flags]:log-flags \\[cvs-mode-set-status-flags]:status-flags \\[cvs-mode-set-update-optional-flags]:update-optional-flags")))

;;----------
(defun cvs-mode-debug-fileinfo ()
  "View the selected fileinfos in a temporary buffer."
  (interactive)
  (let ((marked (cvs-get-marked (cvs-ignore-marks-p
                                 cvs-default-ignore-marks))))
    (with-output-to-temp-buffer "*cvs-debug*"
      (while marked
        (let ((fh (tin-cookie cvs-cookie-handle (car marked))))
          (princ (format "handled:   %s\n" (cvs-fileinfo->handled fh)))
          (princ (format "marked:    %s\n" (cvs-fileinfo->marked fh)))
          (princ (format "type:      %s\n" (cvs-fileinfo->type fh)))
          (princ (format "directory: %s\n" (cvs-fileinfo->dir fh)))
          (princ (format "filename:  %s\n" (cvs-fileinfo->file-name fh)))
          (princ (format "base-rev:  %s\n" (cvs-fileinfo->base-revision fh)))
          (princ (format "head-rev:  %s\n" (cvs-fileinfo->head-revision fh)))
          (princ (format "removed:   %s\n" (cvs-fileinfo->removed fh)))
          (princ (format "full-log:  %s\n" (cvs-fileinfo->full-log fh)))
          (if (cdr marked) (princ "\n"))
          (setq marked (cdr marked)))))))

;; Move around in the buffer

;;----------
(defun cvs-mode-previous-line (arg)
  "Go to the previous line.
If a prefix argument is given, move by that many lines.
Can only be used in the *cvs* buffer."
  (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.
Can only be used in the *cvs* buffer."
  (interactive "p")
  (tin-goto-next cvs-cookie-handle (point) arg))

;; Mark handling

;;----------
(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.
Can only be used in the *cvs* buffer."

  (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-mode-mark-all-files ()
  "Mark all files.
Directories are not marked.
Can only be used in the *cvs* buffer."
  (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-mark-matching-files (regex)
  "Mark all files matching REGEX."
  (interactive "sMark files matching: ")
  (cookie-map (function (lambda (cookie)
                          (when (and (not (eq (cvs-fileinfo->type cookie)
                                              'DIRCHANGE))
                                     (string-match regex
                                                   (cvs-fileinfo->file-name cookie)))
                            (cvs-set-fileinfo->marked cookie t)
                            t)))
              cvs-cookie-handle))

;;----------
(defun cvs-mode-unmark (pos)
  "Unmark a fileinfo. Args: POS.
Can only be used in the *cvs* buffer."
  (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.
Can only be used in the *cvs* buffer."
  (interactive)
  (cookie-map (function (lambda (cookie)
			  (cvs-set-fileinfo->marked cookie nil)
			  t))
	      cvs-cookie-handle))

;;----------
(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-toggle-marks ()
  "Toggle whether the next CVS command uses marks."
  (interactive)
  (cond ((eq last-command 'cvs-mode-toggle-marks)
         (setq this-command 'cvs-mode-untoggle-marks))
        (t
         (setq this-command 'cvs-mode-toggle-marks)))
  (let ((last-command this-command))
    (let ((dflt (cvs-ignore-marks-p cvs-default-ignore-marks))
          (diff (cvs-ignore-marks-p cvs-diff-ignore-marks)))
      (cond ((and dflt diff)
             (message "Ignore marks for next command..."))
            ((and (not dflt) (not diff))
             (message "Using marks for next command..."))
            ((and (not dflt) diff)
             (message "Ignore marks for diff, use for other commands..."))
            ((and dflt (not diff))
             (message "Use marks for diff, ignore for other commands..."))))))

;;----------
(defun cvs-ignore-marks-p (default)
  (let ((toggled (eq last-command 'cvs-mode-toggle-marks)))
    (or (and default (not toggled))
        (and toggled (not default)))))

;; Commit files

;;----------
(defun cvs-mode-commit (&optional arg)
  "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].
With a prefix argument, prompt for cvs flags.
Can only be used in the *cvs* buffer."

  (interactive "P")
  (cvs-with-flags arg cvs-commit-flags "`cvs commit'"
  (let ((marked (cvs-filter (function cvs-committable)
                            (cvs-get-marked (cvs-ignore-marks-p
                                             cvs-default-ignore-marks)))))
    (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)
      (make-local-variable 'cvs-commit-flags-to-use)
      (setq cvs-commit-flags-to-use cvs-commit-flags)
      (message "Press C-c C-c when you are done editing.")))))

;;----------
(defun cvs-add-file-update-buffer (tin)
  "Subfunction to cvs-mode-add. Internal use only.
Update the display for TIN.  Returns 'ADD or 'RESURRECT."
  (let ((fileinfo (tin-cookie cvs-cookie-handle tin)))
    (cond
     ((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN)
      (cvs-set-fileinfo->type fileinfo 'ADDED)
      (tin-invalidate cvs-cookie-handle tin)
      'ADD)
     ((eq (cvs-fileinfo->type fileinfo) 'REMOVED)
      (cvs-set-fileinfo->type fileinfo 'UPDATED)
      (cvs-set-fileinfo->handled fileinfo t)
      (tin-invalidate cvs-cookie-handle tin)
      'RESURRECT))))

;;----------
(defun cvs-add-do-update (candidates)
  "Internal use only.
Args: CANDIDATES.
CANDIDATES is a list of tins.  Updates the CVS buffer display for CANDIDATES."
  (while candidates
    (cvs-add-file-update-buffer (car candidates))
    (setq candidates (cdr candidates))))

;;----------
(defun cvs-add-file-how (tin)
  "Sub-function to cvs-mode-add.  Internal use only.
Return non-nil if `cvs add' should be called on this file.
Args:  TIN.

Returns 'ADD, or 'RESURRECT."

  (let ((fileinfo (tin-cookie cvs-cookie-handle tin)))
    (cond
     ((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN)
      'ADD)
     ((eq (cvs-fileinfo->type fileinfo) 'REMOVED)
      'RESURRECT))))

;;----------
(defun cvs-add-how (candidates)
  "Internal use only.
Args:  CANDIDATES.

CANDIDATES is a list of tins.  Returns a pair of lists.
The first list is unknown tins that shall be `cvs add -m msg'ed.
The second list is removed files that shall be `cvs add'ed (resurrected)."

  (let (add resurrect)
    (while candidates
      (let ((type (cvs-add-file-how (car candidates))))
	(cond ((eq type 'ADD)
	       (setq add (cons (car candidates) add)))
	      ((eq type 'RESURRECT)
	       (setq resurrect (cons (car candidates) resurrect)))))
      (setq candidates (cdr candidates)))
    (cons add resurrect)))

;;----------
(defun cvs-mode-add (&optional arg)
  "Add marked files to the cvs repository.
With prefix argument, prompt for cvs flags.
Can only be used in the *cvs* buffer."
  (interactive "P")

  (cvs-with-flags arg cvs-add-flags "`cvs add'"
  (let* ((result (cvs-add-how (cvs-get-marked (cvs-ignore-marks-p
                                               cvs-default-ignore-marks))))
	 (added (car result))
	 (resurrect (cdr result))
	 (msg (if added (read-from-minibuffer "Enter description: "))))

    (if (or resurrect added)
	(cvs-use-temp-buffer))

    (cond (resurrect
	   (message "Resurrecting files from repository...")
	   (if (cvs-execute-list resurrect cvs-program
				 (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
                                         (list "add")
                                         cvs-add-flags))
	       (error "CVS exited with non-zero exit status.")
             (cvs-add-do-update resurrect)
	     (message "Done."))))

    (cond (added
	   (message "Adding new files to repository...")
	   (if (cvs-execute-list added cvs-program
				 (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
                                         (list "add" "-m" msg)
                                         cvs-add-flags))
	       (error "CVS exited with non-zero exit status.")
             (cvs-add-do-update added)
	     (message "Done.")))))))

;;----------
(defun cvs-mode-diff-cvs (&optional arg)
  "Diff the selected files against the repository.
This command compares the files in your working area against the
revision which they are based upon.

The flags in the variable cvs-diff-flags (which should be a list
of strings) will be passed to ``cvs diff''.  Use a prefix argument
to set these flags.  If the variable cvs-diff-ignore-marks is non-nil
any marked files will not be considered to be selected.  Use the
command cvs-mode-toggle-marks to invert the influence from
cvs-diff-ignore-marks.

See also cvs-mode-diff-backup, cvs-mode-diff-head, and
cvs-mode-diff-vendor.

Can only be used in the *cvs* buffer."

  (interactive "P")

  (cvs-with-flags arg cvs-diff-flags "`cvs diff'"
  (if (and cvs-diff-flags
	   (not (listp cvs-diff-flags)))
      (error "cvs-diff-flags should be a list of strings."))
  (save-some-buffers)
  (let ((marked (cvs-filter (function cvs-diffable-p) ; FIXME use
						      ; cvs-applicable-p
			    (cvs-get-marked (cvs-ignore-marks-p
                                             cvs-diff-ignore-marks)
                                            'IGNORE-CONTENTS))))
    (if (null marked)
	(error "No `cvs diff'able files selected!"))
    (cvs-use-temp-buffer (if (not cvs-diff-unique-buffers)
			     nil
			   (concat "*cvs-diff-"
				   (cvs-fileinfo->file-name
				    (tin-cookie cvs-cookie-handle 
						(car marked)))
				   "-in-"
				   (file-name-as-directory
				    (cvs-fileinfo->dir
				     (tin-cookie cvs-cookie-handle
						 (car marked))))
				   "*")))
    (message "Running cvs diff...")
    (if (cvs-execute-list marked cvs-program
			  (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
                                  (list "diff")
                                  cvs-diff-flags))
	(message "Running cvs diff... Done.")
      (message "cvs diff... No differences found.")))))

;;----------
(defun cvs-diffable-p (tin)
  "Return a non-nil if it makes sense to run ``cvs diff'' on TIN."
  (let ((type (cvs-fileinfo->type
	       (tin-cookie cvs-cookie-handle tin))))
    (or (eq type 'DIRCHANGE)
	(eq type 'MODIFIED)
	(eq type 'NEED-MERGE)
	(eq type 'MERGED)
	(eq type 'CONFLICT)
	(eq type 'UNRES-CONFLICT))))

;;----------
(defun cvs-mode-diff-backup (&optional arg)
  "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.

The flags in the variable cvs-diff-flags (which should be a list
of strings) will be passed to ``diff''.  Use a prefix argument
to set these flags.

If the variable cvs-diff-ignore-marks is non-nil any marked files
will not be considered to be selected.  Use the command
cvs-mode-toggle-marks to invert the influence from
cvs-diff-ignore-marks."

  (interactive "P")

  (cvs-with-flags arg cvs-diff-flags "`diff'"
  (if (and cvs-diff-flags
	   (not (listp cvs-diff-flags)))
      (error "cvs-diff-flags should be a list of strings."))
  (save-some-buffers)
  (let ((marked (cvs-filter (function cvs-backup-diffable-p)
			    (cvs-get-marked (cvs-ignore-marks-p
                                             cvs-diff-ignore-marks)))))
    (if (null marked)
	(error "No files with a backup file selected!"))
    (cvs-use-temp-buffer (if (not cvs-diff-unique-buffers)
			     nil
			   (concat "*cvs-diff-backup-"
				   (cvs-fileinfo->file-name
				    (tin-cookie cvs-cookie-handle 
						(car marked)))
				   "-in-"
				   (file-name-as-directory
				    (cvs-fileinfo->dir
				     (tin-cookie cvs-cookie-handle
						 (car marked))))
				   "*")))
    (message "cvs diff backup...")
    (cvs-execute-single-file-list marked 'cvs-diff-backup-extractor
				  cvs-diff-program cvs-diff-flags)))
  (message "cvs diff backup... Done."))

;;----------
;; FIXME: should call cvs-applicable-p too, no?
(defun cvs-backup-diffable-p (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-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-mode-diff-head (&optional arg)
  "Diff the selected files against the repository.
This command compares the files in your working area against the
head revision in the repository.

The flags in the variable cvs-diff-flags (which should be a list
of strings) will be passed to ``cvs diff''.  Use a prefix argument
to set these flags.

If the variable cvs-diff-ignore-marks is non-nil any marked files
will not be considered to be selected.  Use the command
cvs-mode-toggle-marks to invert the influence from
cvs-diff-ignore-marks.

See also cvs-mode-diff-backup, cvs-mode-diff-vendor, and
cvs-mode-diff-cvs.

Can only be used in the *cvs* buffer."

  (interactive "P")

  (cvs-with-flags arg cvs-diff-flags "`cvs diff'"
  (if (and cvs-diff-flags
	   (not (listp cvs-diff-flags)))
      (error "cvs-diff-flags should be a list of strings."))
  (save-some-buffers)
  (let ((marked (cvs-filter (function cvs-head-diffable-p) ; FIXME use
							   ; cvs-applicable-p
			    (cvs-get-marked (cvs-ignore-marks-p
                                             cvs-diff-ignore-marks)
                                            'IGNORE-CONTENTS)))
	(display-type cvs-display-type))
    (if (null marked)
	(error "No `cvs diff'able files selected!"))
    (cvs-use-temp-buffer (if (not cvs-diff-unique-buffers)
			     nil
			   (concat "*cvs-diff-head-"
				   (cvs-fileinfo->file-name
				    (tin-cookie cvs-cookie-handle 
						(car marked)))
				   "-in-"
				   (file-name-as-directory
				    (cvs-fileinfo->dir
				     (tin-cookie cvs-cookie-handle
						 (car marked))))
				   "*")))
    (message "cvs diff head...")
    (cond				; FIXME: does this make
					; sense?  Use -rHEAD
					; always, no?
     ((eq display-type 'STATUS)
      (while marked
	(let* ((rev (cvs-fileinfo->head-revision
                     (tin-cookie cvs-cookie-handle (car marked))))
               (args (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
                             (list "diff")
                             (if rev (list "-r" rev))
                             cvs-diff-flags)))
	  (cvs-execute-list (list (car marked)) cvs-program args))
	(setq marked (cdr marked)))
      (message "cvs diff head... Done."))
     ((eq display-type 'UPDATE)
      (let ((args (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
                          (list "diff" "-rHEAD")
                          cvs-diff-flags)))
	(if (cvs-execute-list marked cvs-program args)
	    (message "cvs diff head... Done.")
	  (message "cvs diff head... No differences found."))))
     (t (error "unknown display type %s" (symbol-name display-type)))))))

;;----------
(defun cvs-head-diffable-p (tin)
  "Return non-nil if it makes sense to run ``cvs diff -rHEAD'' on TIN."
  (let ((type (cvs-fileinfo->type
	       (tin-cookie cvs-cookie-handle tin))))
    (or (eq type 'DIRCHANGE)
	(eq type 'UPDATED)
	(eq type 'UP-TO-DATE)
	(eq type 'PATCHED)
	(eq type 'MODIFIED)
	(eq type 'NEED-UPDATE)
	(eq type 'NEED-MERGE)
	(eq type 'MERGED)
	(eq type 'CONFLICT)
	(eq type 'MOD-CONFLICT)
	(eq type 'UNRES-CONFLICT))))

;;----------
(defun cvs-mode-diff-vendor (&optional arg)
  "Diff the selected files against the repository.
This command compares the files in your working area against the
head revision of the vendor branch in the repository.

The flags in the variable cvs-diff-flags (which should be a list
of strings) will be passed to ``cvs diff''.  Use a prefix argument
to set these flags.

If the variable cvs-diff-ignore-marks is non-nil any marked files
will not be considered to be selected.  Use the command
cvs-mode-toggle-marks to invert the influence from
cvs-diff-ignore-marks.

See also cvs-mode-diff-cvs, cvs-mode-diff-head, and
cvs-mode-diff-backup.

Can only be used in the *cvs* buffer."

  (interactive "P")

  (cvs-with-flags arg cvs-diff-flags "`cvs diff'"
  (if (and cvs-diff-flags
	   (not (listp cvs-diff-flags)))
      (error "cvs-diff-flags should be a list of strings."))
  (save-some-buffers)
  (let ((marked (cvs-filter (function cvs-vendor-diffable-p) ; FIXME use
							     ; cvs-applicable-p
			    (cvs-get-marked (cvs-ignore-marks-p
                                             cvs-diff-ignore-marks)
                                            'IGNORE-CONTENTS))))
    (if (null marked)
	(error "No `cvs diff'able files selected!"))
    (cvs-use-temp-buffer (if (not cvs-diff-unique-buffers)
			     nil
			   (concat "*cvs-diff-vendor-"
				   (cvs-fileinfo->file-name
				    (tin-cookie cvs-cookie-handle 
						(car marked)))
				   "-in-"
				   (file-name-as-directory
				    (cvs-fileinfo->dir
				     (tin-cookie cvs-cookie-handle
						 (car marked))))
				   "*")))
    (message "cvs diff vendor...")
    (let ((args (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
                        (list "diff" "-r" cvs-vendor-branch)
                        cvs-diff-flags)))
      (if (cvs-execute-list marked cvs-program args)
	  (message "cvs diff vendor... Done.")
	(message "cvs diff vendor... No differences found."))))))

;;----------
(defun cvs-vendor-diffable-p (tin)
  "Return non-nil if it makes sense to run ``cvs diff -rHEAD'' on TIN."
  (let ((type (cvs-fileinfo->type
	       (tin-cookie cvs-cookie-handle tin))))
    (or (eq type 'DIRCHANGE)
	(eq type 'UPDATED)
	(eq type 'UP-TO-DATE)
	(eq type 'PATCHED)
	(eq type 'MODIFIED)
	(eq type 'NEED-UPDATE)
	(eq type 'NEED-MERGE)
	(eq type 'MERGED)
	(eq type 'CONFLICT)
	(eq type 'MOD-CONFLICT)
	(eq type 'UNRES-CONFLICT))))

;; ediff support.

(eval-when-compile (defvar ediff-version))
(eval-when-compile (defvar cvs-ediff-tmp-head-file))

;;----------
(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)))

;; NOTE: in 19.28 you'll get this when compiling:
;; While compiling the end of the data:
;;   ** The following functions are not known to be defined: 
;;     run-ediff-from-cvs-buffer, ediff-files3
;;----------
(defun cvs-old-ediff-interface (pos)
  "Emerge like interface for older ediffs.
Args:  POS"

  (let ((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 ((default-directory (file-name-as-directory
                            (cvs-fileinfo->dir fileinfo)))
        (temp-name (make-temp-name
                    (concat (file-name-as-directory
                             (or (and (fboundp 'temp-directory)
                                      (temp-directory))
                                 (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 shell-command-switch
			     (concat cvs-program " update -p "
				     (if (and revision
					      (stringp revision)
					      (not (string= revision "")))
					 (concat "-r " revision " ")
				       "")
				     (cvs-fileinfo->file-name 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)))

;; Emerge support.

;;----------
(defun cvs-mode-emerge (pos)
  "Emerge appropriate revisions of the selected file.
Args: POS.
Can only be used in the *cvs* buffer."
  (interactive "d")
  (let ((tin (tin-locate cvs-cookie-handle pos)))
    (if tin
	(let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
               (default-directory
                 (file-name-as-directory (cvs-fileinfo->dir fileinfo)))
	       (type (cvs-fileinfo->type fileinfo))
	       (shell-file-name cvs-shell))
	  (cond
	   ((eq type 'MODIFIED)
	    (require 'emerge)
	    (let ((tmp-file
		   (cvs-retrieve-revision-to-tmpfile fileinfo "BASE")))
	      (unwind-protect
		  (if (not (emerge-files
			    t
			    (cvs-fileinfo->full-path fileinfo)
			    tmp-file
			    (cvs-fileinfo->full-path fileinfo)))
		      (error "Emerge session failed"))
		(delete-file tmp-file))))

	   ((or (eq type 'MERGED)
		(eq type 'CONFLICT))
	    (require 'emerge)
	    (let ((tmp-file
		   (cvs-retrieve-revision-to-tmpfile
		    fileinfo
		    (cvs-fileinfo->head-revision fileinfo)))
		  (ancestor-file
		   (cvs-retrieve-revision-to-tmpfile
		    fileinfo
		    (cvs-fileinfo->base-revision fileinfo))))
	      (unwind-protect
		  (if (not (emerge-files-with-ancestor
			    t
			    (cvs-fileinfo->backup-file fileinfo)
			    tmp-file
			    ancestor-file
			    (cvs-fileinfo->full-path fileinfo)))
		      (error "Emerge session failed"))
		(delete-file tmp-file)
		(delete-file ancestor-file))))
	   (t
	    (error "Can only emerge \"Modified\", \"Merged\" or \"Conflict\"%s"
		   " files"))))
      (error "There is no file to emerge."))))

;; cvs status

;;----------
(defun cvs-mode-status (&optional arg)
  "Show cvs status for all marked files.
With prefix argument, prompt for cvs flags.
Can only be used in the *cvs* buffer."
  (interactive "P")

  (save-some-buffers)
  (cvs-with-flags arg cvs-status-flags "`cvs status'"
  (if (and cvs-status-flags
	   (not (listp cvs-status-flags)))
      (error "cvs-status-flags should be a list of strings"))

  (let ((marked (cvs-get-marked (cvs-ignore-marks-p
                                 cvs-default-ignore-marks))))
    (cvs-use-temp-buffer)
    (message "Running cvs status ...")
    (if (cvs-execute-list marked cvs-program
			  (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
                                  (list "status")
                                  cvs-status-flags))
	(error "CVS exited with non-zero exit status.")
      (message "Running cvs status ... Done.")))))

;; cvs log

;;----------
(defun cvs-mode-log (&optional arg)
  "Display the cvs log of all selected files.
With prefix argument, prompt for cvs flags.
Can only be used in the *cvs* buffer."
  (interactive "P")

  (cvs-with-flags arg cvs-log-flags "`cvs log'"
  (if (and cvs-log-flags
	   (not (listp cvs-log-flags)))
      (error "cvs-log-flags should be a list of strings"))

  (let ((marked (cvs-get-marked (cvs-ignore-marks-p
                                 cvs-default-ignore-marks))))
    (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))
	(error "CVS exited with non-zero exit status.")
      (message "Running cvs log ... Done.")))))

;;----------
(defun cvs-mode-update (&optional arg)
  "Update all marked files that have \"Need update\" status..
With a prefix argument, prompt for cvs flags.
Can only be used in the *cvs* buffer,
and can only be used meaningfully after cvs-status has been run."
  (interactive "P")

  (cvs-with-flags arg cvs-update-file-flags "`cvs update'"
  (let ((marked (cvs-updateable (cvs-get-marked ; FIXME: use cvs-applicable-p
                                 (cvs-ignore-marks-p
                                  cvs-default-ignore-marks)))))
    ;; FIXME: check that marked is not null?
    (cvs-use-temp-buffer)
    (message "Running cvs update ...")
    (if (cvs-execute-list marked cvs-program
			  (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
                                  (list "update")
                                  cvs-update-file-flags))
	(error "CVS exited with non-zero exit status.")
      (mapcar (function 
	       (lambda (tin)
		 (let ((fileinfo (tin-cookie cvs-cookie-handle tin)))
		   (cvs-set-fileinfo->type fileinfo 'UPDATED)
		   ;; FIXME: This may be wrong.  I should really run
		   ;; "cvs update" here and check the output, and
		   ;; check which revision really is updated.
		   (cvs-set-fileinfo->base-revision 
		    fileinfo
		    (cvs-fileinfo->head-revision fileinfo))
		   (cvs-set-fileinfo->handled fileinfo t))
		 (tin-invalidate cvs-cookie-handle tin)))
	      marked))
    (message "Running cvs update ... Done."))))

;;----------
(defun cvs-updateable (tins)
  "Return a list of all tins on TINS that it makes sense to run
``cvs diff -rHEAD'' on."
  ;; FIXME+++ 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 (eq type 'NEED-UPDATE)
	    (setq result (cons (car tins) result)))
	(setq tins (cdr tins))))
    (nreverse result)))

;;----------
(defun cvs-mode-ignore ()
  "Arrange so that CVS ignores the selected files.
This command ignores files that are not flagged as `Unknown'.
Can only be used in the *cvs* buffer."
  (interactive)

  (mapcar (function (lambda (tin)
		      (cond
		       ((eq (cvs-fileinfo->type
			     (tin-cookie cvs-cookie-handle tin))
			    'UNKNOWN)
			(cvs-append-to-ignore
			 (tin-cookie cvs-cookie-handle tin))
			(tin-delete cvs-cookie-handle tin)))))
	  (cvs-get-marked (cvs-ignore-marks-p
                           cvs-default-ignore-marks))))

;;----------
(defun cvs-append-to-ignore (fileinfo)
  "Append the file in FILEINFO to the .cvsignore file.
Can only be used in the *cvs* buffer."
  (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-find-file-other-window (pos)
  "Select a buffer containing the file in another window.
Args: POS.
Can only be used in the *cvs* buffer."
  (interactive "d")
  (let ((tin (tin-locate cvs-cookie-handle pos)))
    (if tin
	(let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
	       (type (cvs-fileinfo->type fileinfo)))
	  (cond
	   ((cvs-fileinfo->removed fileinfo)
	    (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 fileinfo)))
	      (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-mode-find-file (pos)
  "Select a buffer containing the file in another window.
Args: POS.
Can only be used in the *cvs* buffer."
  (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
	   ((cvs-fileinfo->removed fileinfo)
	    (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-revert-updated-buffers ()
  "Revert any buffers that are UPDATED, PATCHED, MERGED or CONFLICT.
Can only be used in the *cvs* buffer."
  (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-undo-local-changes (&optional arg)
  "Undo local changes to all marked files.
The file is removed and `cvs update FILE' is run.
With prefix argument, prompt for cvs flags.
Can only be used in the *cvs* buffer."
  (interactive "P")
  (cvs-with-flags arg cvs-undo-flags "undo local changes"
  (let ((tins-to-undo (cvs-get-marked (cvs-ignore-marks-p
                                       cvs-default-ignore-marks))))
    (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
	     ((memq type '(UPDATED PATCHED MODIFIED MERGED CONFLICT
                           REMOVED NEED-MERGE UNRES-CONFLICT))
	      (setq files-to-update (cons tin files-to-update)))

	     ((eq type 'MOD-CONFLICT)
	      (error "Use cvs-mode-add instead on %s."
		     (cvs-fileinfo->file-name fileinfo)))

	     ((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))))
        (setq tins-to-undo 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
	     ((memq type '(UPDATED PATCHED MODIFIED MERGED CONFLICT
                           REMOVED NEED-MERGE UNRES-CONFLICT))
	      (if (not (eq type 'REMOVED))
		  (delete-file (cvs-full-path tin)))
	      (cvs-set-fileinfo->type fileinfo 'UPDATED)
	      (cvs-set-fileinfo->handled fileinfo t)
	      (tin-invalidate cvs-cookie-handle tin))

             (t (error "inconsistency in cvs-mode-undo-local-changes")))

            (setq tins-to-undo (cdr tins-to-undo))))
	(cvs-use-temp-buffer)
	(message "Regetting files from repository...")
	(if (cvs-execute-list files-to-update cvs-program
			      (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
                                      (list "update")
                                      cvs-undo-flags))
	    (error "CVS exited with non-zero exit status.")
	  (message "Regetting files from repository... done."))))))))

;;----------
(defun cvs-mode-redo (&optional arg)
  "Run cvs update or cvs status again.
With a prefix argument, prompt for cvs flags.
Can only be used from the *cvs* buffer."
  (interactive "P")
  (cond
   ((eq cvs-display-type 'UPDATE)
    (cvs-with-flags arg cvs-update-optional-flags "`cvs update'"
      (if (null arg)
          (setq cvs-update-optional-flags cvs-last-update-flags))
      (cvs-do-update default-directory cvs-dont-change-disc)))
   ((eq cvs-display-type 'STATUS)
    (cvs-with-flags arg cvs-status-cmd-flags "`cvs status'"
      (if (null arg)
          (setq cvs-status-cmd-flags cvs-last-status-flags))
      (cvs-do-status default-directory)))))

;;----------
(defun cvs-mode-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.
Can only be used from the *cvs* buffer."
  (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)))
      (delete-directory
       (concat (file-name-as-directory cvs-lock-file) "#cvs.lock"))))))

;;----------
(defun cvs-mode-remove-handled ()
  "Remove all lines that are handled.
Empty directories are removed.
Can only be used in the *cvs* buffer."
  (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.
  (cvs-remove-empty-directories))

;;----------
(defun cvs-mode-acknowledge ()
  "Remove all marked files from the buffer.
Can only be used in the *cvs* buffer."
  (interactive)

  (mapcar (function (lambda (tin)
		      (tin-delete cvs-cookie-handle tin)))
	  (cvs-get-marked (cvs-ignore-marks-p
                           cvs-default-ignore-marks))))

;;----------
(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 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))
	       (type (cvs-fileinfo->type fileinfo)))
	  (if (not (eq type 'REMOVED))
	      (progn
		(condition-case err
		    (delete-file (cvs-full-path tin))
		  (file-error (if (not (string= (third err)
						"No such file or directory"))
				  (apply #'signal (car err) (list (cdr err))))))
		(cond
		 ((eq type 'UNKNOWN)
		  (tin-delete cvs-cookie-handle tin))
		 (t
		  (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 (&optional arg)
  "Remove all marked files.
With prefix argument, prompt for cvs flags.
Can only be used in the *cvs* buffer."
  (interactive "P")
  (cvs-with-flags arg cvs-remove-flags "`cvs remove'"
  (let ((files-to-remove (cvs-do-removal
                          (cvs-get-marked (cvs-ignore-marks-p
                                           cvs-default-ignore-marks)))))
    (if (null files-to-remove)
	nil
      (cvs-use-temp-buffer)
      (message "removing from repository...")
      (if (cvs-execute-list files-to-remove cvs-program
			    (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
                                    (list "remove")
                                    cvs-remove-flags))
	  (error "CVS exited with non-zero exit status.")
	(message "removing from repository... done."))))))

;;----------
(defun cvs-mode-tag (&optional arg)
  "Run 'cvs tag' on all selected files.
With prefix argument, prompt for cvs flags."

  (interactive "P")
  (cvs-with-flags arg cvs-tag-flags "`cvs tag'"
  (if (and cvs-tag-flags
	   (not (listp cvs-tag-flags)))
      (error "cvs-tag-flags should be a list of strings."))
  (let ((marked (cvs-get-marked  (cvs-ignore-marks-p
                                  cvs-default-ignore-marks)
                                 t))
	(tag-args (cvs-parse-arguments (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 (&optional arg)
  "Run 'cvs rtag' on all selected files.
With prefix argument, prompt for cvs flags."

  (interactive "P")
  (cvs-with-flags arg cvs-rtag-flags "`cvs rtag'"
  (if (and cvs-rtag-flags
	   (not (listp cvs-rtag-flags)))
      (error "cvs-rtag-flags should be a list of strings."))
  (let ((marked (cvs-get-marked  (cvs-ignore-marks-p
                                  cvs-default-ignore-marks)
                                 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-parse-arguments (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.")))))

;; Byte compile files.

;;----------
(defun cvs-mode-byte-compile-files ()
  "Run byte-compile-file on all selected files that end in '.el'.
Can only be used in the *cvs* buffer."
  (interactive)
  (let ((marked (cvs-get-marked (cvs-ignore-marks-p
                                 cvs-default-ignore-marks))))
    (while marked
      (let ((filename (cvs-full-path (car marked))))
	(if (string-match "\\.el$" filename)
	    (byte-compile-file filename)))
      (setq marked (cdr marked)))))

;; ChangeLog support.

;;----------
(defun cvs-mode-add-change-log-entry-other-window (pos)
  "Add a ChangeLog entry in the ChangeLog of the current directory.
Args: POS.
Can only be used in the *cvs* buffer."
  (interactive "d")
  (let ((fileinfo (tin-cookie
                   cvs-cookie-handle
                   (tin-locate cvs-cookie-handle pos))))
    (let ((default-directory (or (cvs-fileinfo->dir fileinfo)
                                 default-directory))
          (buffer-file-name (cvs-fileinfo->file-name fileinfo)))
      (add-change-log-entry-other-window))))

;; interactive commands to set optional flags

;;----------
(defun cvs-mode-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-parse-arguments (read-string "Diff flags: " old-value)))))

;;----------
(defun cvs-mode-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-parse-arguments (read-string "Update optional flags: " old-value)))))

;;----------
(defun cvs-mode-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-parse-arguments (read-string "Status flags: " old-value)))))

;;----------
(defun cvs-mode-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-parse-arguments (read-string "Log flags: " old-value)))))

;;----------
(defun cvs-mode-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-parse-arguments (read-string "Tag flags: " old-value)))))

;;----------
(defun cvs-mode-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-parse-arguments (read-string "Rtag flags: " old-value)))))



;;;
;;; Utilities for the *cvs* buffer
;;;

;;----------
(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-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: 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-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-get-marked (&optional ignore-marks ignore-contents)
  "Return a list of all selected tins.
If there are any marked tins, and IGNORE-MARKS is nil, return them.
Otherwise, if the cursor selects a directory, and IGNORE-CONTENTS is
nil, return all files in it, else return just 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.

Args: &optional IGNORE-MARKS IGNORE-CONTENTS."
    
  (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 members are returned, if any.
	    ((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))))		; no contents, return dir as list
	    (t
	     (list sel))))))
   (t
    (list (tin-locate cvs-cookie-handle (point))))))

;;----------
(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, CONFLICT or UNRES-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)
	     (eq type 'UNRES-CONFLICT)))))

;;----------
;; FIXME: make this run in the background ala cvs-run-process...
(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."

  (let ((exitstatus nil))
    (while tin-list
      (let ((current-dir (cvs-fileinfo->dir
			  (tin-cookie cvs-cookie-handle
					 (car tin-list))))
	    arg-list)

	;; 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))
	(insert (format "=== Exit status: %s\n" (if (integerp exitstatus)
						    (number-to-string
						     exitstatus) 
						  "OK")))
	(if message-fmt
	    (message message-fmt
		     (mapconcat 'cvs-quote-multiword-string
				(nconc (copy-sequence arg-list) '("Done."))
				" ")))))
      exitstatus))

;;----------
;; FIXME: make this run in the background ala cvs-run-process...
(defun cvs-execute-single-file-list (tin-list extractor program constant-args)
  "Run PROGRAM on all elements on TIN-LIST.

Args: TIN-LIST EXTRACTOR PROGRAM CONSTANT-ARGS

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."

    (while tin-list
      (let ((default-directory (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
	  (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)
				     " ")))
	  ;; FIXME: return the exit status?
	  (apply 'call-process program nil t t
		 (nconc (copy-sequence constant-args) arg-list))
	  (goto-char (point-max))))
      (setq tin-list (cdr tin-list))))

;;----------
(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))))


;;;
;;; The commit message editing mode.
;;;

;;----------
(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)
  (kill-all-local-variables)
  (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)
  (define-key cvs-edit-mode-map "\C-c?" 'cvs-edit-mode-help))

;;----------
(defun cvs-edit-mode-help ()
  "Provide help for the cvs-edit-mode-map."
  (interactive)
  (cond
   ((eq last-command 'cvs-edit-mode-help)
    (describe-function major-mode))
   (t
    (message
     (substitute-command-keys
      "Type `\\[cvs-edit-done]' to finish commit.  Try `\\[describe-function] cvs-edit-done' for more help.")))))

;;----------
(defun cvs-edit-done ()
  "Finish editing the log message and commit the files.
This can only be used in the *cvs-commit-message* buffer.

If you want to abort the commit, simply delete the buffer."
  (interactive)
  (if (null cvs-commit-list)
      (error "You have already commited the files"))
  (if (or (not (boundp 'cvs-commit-flags-to-use))
          (not (local-variable-p 'cvs-commit-flags-to-use (current-buffer))))
      (error "You must use `cvs-mode-commit' to enter cvs-edit-mode."))
  (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))
        (cvs-commit-flags cvs-commit-flags-to-use)
	(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
			  (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
                                  (list "commit" "-m" msg)
                                  cvs-commit-flags))
	(error "Something went wrong.  Check the %s buffer carefully."
	       cvs-temp-buffer-name))
    (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)
    (kill-local-variable 'cvs-commit-flags-to-use)
    (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 commited.
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)))))))

;;; functions for getting commit message from ChangeLog a file...

;;----------
(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 (or (and change-log-default-name
                              (file-exists-p
                               (setq file (expand-file-name
                                           change-log-default-name dir))))
			 (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: avoid user-full-name warning when compiling with 19.28
(eval-when-compile (defvar user-full-name))
;;----------
(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.
  (let ((name (cond ((and (boundp 'add-log-full-name)
                          add-log-full-name)
                     add-log-full-name)
                    ((and (boundp 'user-full-name)
                          user-full-name)
                     user-full-name)
                    ((fboundp 'user-full-name)
                     (user-full-name))))
        (mail (cond ((and (boundp 'add-log-mailing-address)
                          add-log-mailing-address)
                     add-log-mailing-address)
                    ((and (boundp 'user-mail-address)
                          user-mail-address)
                     user-mail-address)
                    ((fboundp 'user-mail-address)
                     (user-mail-address)))))
    (or (looking-at
         (regexp-quote (format "%s  %s  <%s>"
                               (format-time-string "%Y-%m-%d")
                               name mail)))
        (looking-at
         (concat (regexp-quote (substring (current-time-string)
                                          0 10))
                 ".* "
                 (regexp-quote (substring (current-time-string) -4))
                 "[ \t]+"
                 (regexp-quote name)
                 "  <"
                 (regexp-quote mail))))))

;;----------
(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 (&optional arg)
  "Check in all marked files, or the current file.
Ask the user for a log message in a buffer.
With a prefix argument, prompt for cvs flags.

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 "P")
  (cvs-with-flags arg cvs-commit-flags "`cvs commit'"
  (let ((marked (cvs-filter (function cvs-committable)
                            (cvs-get-marked (cvs-ignore-marks-p
                                             cvs-default-ignore-marks)))))
    (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)
      (make-local-variable 'cvs-commit-flags-to-use)
      (setq cvs-commit-flags-to-use cvs-commit-flags)
      (message "Press C-c C-c when you are done editing.")))))


;;;
;;; Global commands
;;;

;;----------
;;;###autoload
(defun cvs-change-cvsroot (newroot)
  "Change the cvsroot."
  (interactive "DNew repository: ")
  (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)))


;;;
;;; XEmacs support
;;;

(if (string-match "XEmacs" emacs-version)
    (add-hook 'cvs-mode-hook 'pcl-cvs-fontify))

;; provide this package

(provide 'pcl-cvs)

;;; pcl-cvs.el ends here
