comparison lisp/pcvs.el @ 29577:ce3a0229bee7

(cvs-parse-process): Don't blindly refresh all cookies. (cvs-cleanup-removed): New function. (cvs-cleanup-functions): New var. (cvs-cleanup-collection): Use cvs-cleanup-functions to allow the user some flexibility in specifying additional entries to auto-cleanup. (cvs-quickdir): New function. (cvs-mode-insert): Use cvs-fileinfo-from-entries. (cvs-mode-imerge): Use smerge-ediff rather than vc-resolve-conflicts. (cvs-mode-find-file): Check that we are on a filename or dirname when invoked through a mouse-click. (cvs-full-path): Remove. (cvs-dired-action): Re-introduced. (cvs-dired-noselect): Use it. (vc-post-command-functions): use this new hook if available.

29576:961f303cda37

;;      (Greg Klanderman) [e-mail]
;;      (Jari Aalto+mail.emacs) [e-mail]
;; Maintainer: (Stefan Monnier) monnier+lists/cvs/[e-mail]
;; Keywords: CVS, version control, release management
;; Version: $Name:  $
;; Revision: $Id: pcvs.el,v 1.2 2000/03/22 02:56:55 monnier Exp $

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

;;; Todo:

;; ******** FIX THE DOCUMENTATION *********
;; 
;; - proper `g' that passes safe args and uses either cvs-status or cvs-examine
;; - write cvs-fast-examine that parses CVS/Entries instead of running cvs
;;   we could even steal code from vc-cvs-hooks for that.
;; - add toolbar entries
;; - marking
;;    marking directories should jump to just after the dir.
;;    allow (un)marking directories at a time with the mouse.
;;    marking with the mouse should not move point.
;; - liveness indicator
;; - indicate in docstring if the cmd understands the `b' prefix(es).
;; - call smerge-mode when opening CONFLICT files.
;; - after-parse-hook (to eliminate *.elc from Emacs' CVS repository :-)
;; - have vc-checkin delegate to cvs-mode-commit when applicable
;; - higher-level CVS operations
;;    cvs-mode-rename
;;    cvs-mode-branch
;; - module-level commands

;; 	- does "cvs -n tag LAST_VENDOR" to find old files into *cvs*
;;    cvs-export
;; 	(with completion on tag names and hooks to
;; 	help generate full releases)
;; - allow cvs-cmd-do to either clear the marks or not.
;; - allow more concurrency: if the output buffer is busy, pick a new one.
;; - display stickiness information.  And current CVS/Tag as well.
;; - write 'cvs-mode-admin' to do arbitrary 'cvs admin' commands
;; - cvs-mode-incorporate
;; 	It would merge in the status from one ``*cvs*'' buffer into another.
;; 	This would be used to populate such a buffer that had been created with
;; 	a `cvs {update,status,checkout} -l'.
;; - cvs-mode-(i)diff-other-{file,buffer,cvs-buffer}
;; - offer the choice to kill the process when the user kills the cvs buffer.
;; 	right now, it's killed without further ado.

(cvs-flags-define cvs-cvs-flags '(("-f")))

(cvs-flags-define cvs-checkout-flags (cvs-defaults '("-P")))
(cvs-flags-define cvs-status-flags (cvs-defaults '("-v") nil))
(cvs-flags-define cvs-log-flags (cvs-defaults nil))
(cvs-flags-define cvs-diff-flags (cvs-defaults '("-u" "-N") '("-c" "-N")))
(cvs-flags-define cvs-tag-flags (cvs-defaults nil))
(cvs-flags-define cvs-add-flags (cvs-defaults nil))
(cvs-flags-define cvs-commit-flags (cvs-defaults nil))
(cvs-flags-define cvs-remove-flags (cvs-defaults nil))
;;(cvs-flags-define cvs-undo-flags (cvs-defaults nil))

  (let* ((dir (file-name-as-directory
	       (abbreviate-file-name (expand-file-name dir))))
	 (cvsbuf (cvs-make-cvs-buffer dir new)))
    ;; Check that dir is under CVS control.
    (unless (file-directory-p dir)
      (error "%s is not a directory." dir))
    (unless (or noexist (file-directory-p (expand-file-name "CVS" dir)))
      (error "%s does not contain CVS controlled files." dir))

    (set-buffer cvsbuf)
    (cvs-mode-run cmd flags fis
		  :cvsargs cvsargs :dont-change-disc dont-change-disc)

      (let ((pop-up-windows nil)) (pop-to-buffer cvsbuf)))))
;;      (funcall (if (and (boundp 'pop-up-frames) pop-up-frames)
;;		   'pop-to-buffer 'switch-to-buffer)
;;	       cvsbuf))))

;;----------
(defun cvs-run-process (args fis postprocess &optional single-dir)
  (assert (cvs-buffer-p cvs-buffer))
  (save-current-buffer
    (let ((procbuf (current-buffer))
	  (cvsbuf cvs-buffer)

				   (if tin "End" "Empty")
				   " ---------------------\n"
				   prev-msg))))))


;;----------
(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."
  (when (memq (process-status proc) '(signal exit))

	      (cvs-update-header nil nil) ;FIXME: might need to be inline
	      (message "CVS process has completed"))))
	;; This might not even be necessary
	(set-buffer obuf)))))

;;----------
(defun cvs-parse-process (dcd &optional subdir)
  "FIXME: bad name, no doc"
  (let* ((from-buf (current-buffer))
	 (fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir))
	 (_ (set-buffer cvs-buffer))

    (cvs-cleanup-collection cvs-cookies
			    (eq cvs-auto-remove-handled t)
			    cvs-auto-remove-directories
			    nil)
    ;; update the display (might be unnecessary)
    (ewoc-refresh cvs-cookies)
    ;; revert buffers if necessary
    (when (and cvs-auto-revert (not dcd) (not cvs-from-vc))
      (cvs-revert-if-needed fileinfos))
    ;; get back to where we were.  `save-excursion' doesn't seem to
    ;; work in this case, probably because the buffer is reconstructed

	  (ewoc-enter-after c tin fi)
	;; fi == tin
	(cvs-fileinfo-update (ewoc-data tin) fi)
	(ewoc-invalidate c tin))
      tin)))

;; called at the following times:
;; - postparse  ((eq cvs-auto-remove-handled t) cvs-auto-remove-directories nil)
;; - pre-run    ((eq cvs-auto-remove-handled 'delayed) nil t)
;; - remove-handled (t (or cvs-auto-remove-directories 'handled) t)

		     ;; remove entries
		     (DEAD nil)
		     ;; handled also?
		     (UP-TO-DATE (not rm-handled))
		     ;; keep the rest
		     (t t))))
	     
	     ;; mark dirs for removal
	     (when (and keep rm-dirs
			(eq (cvs-fileinfo->type last-fi) 'DIRCHANGE)
			(not (when first-dir (setq first-dir nil) t))

	   (not current-prefix-arg)
	   (not (eq last-command-char ?\r)))
      default-directory
    (read-file-name msg nil default-directory nil)))


;;;###autoload
(defun cvs-examine (directory flags &optional noshow)
  "Run a `cvs -n update' in the specified DIRECTORY.
That is, check what needs to be done, but don't change the disc.

    (setf flags (cvs-flags-query 'cvs-status-flags nil 'noquery)))
  (cvs-cmd-do "status" directory flags nil
	      (> (prefix-numeric-value current-prefix-arg) 8)
	      :noshow noshow :dont-change-disc t))

;;----------
(defun cvs-update-filter (proc string)
  "Filter function for pcl-cvs.
This function gets the output that CVS sends to stdout.  It inserts
the STRING 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."

It actually behaves as a toggle.  If prefixed by \\[universal-argument] \\[universal-argument],
the override will persist until the next toggle."
  (interactive "P")
  (cvs-prefix-set 'cvs-force-command arg))

;;----------
(put 'cvs-mode 'mode-class 'special)
(define-derived-mode cvs-mode fundamental-mode "CVS"
  "Mode used for PCL-CVS, a frontend to CVS.
Full documentation is in the Texinfo file."
  (setq mode-line-process

  (interactive
   (list (read-file-name "File to insert: " nil nil nil
			 (ignore-errors
			   (cvs-fileinfo->dir
			    (car (cvs-mode-marked nil nil :read-only t)))))))
  (let ((file (file-relative-name (directory-file-name file))))
    (if (file-directory-p file)
	(let ((fi (cvs-create-fileinfo 'DIRCHANGE
				       (file-name-as-directory file)
				       "."
				       "cvs-mode-insert")))
	  (cvs-addto-collection cvs-cookies fi))
      (let ((fi (cvs-create-fileinfo 'UNKNOWN
				     (or (file-name-directory file) "")
				     (file-name-nondirectory file)
				     "cvs-mode-insert")))
	(cvs-mode-run "status" (cvs-flags-query 'cvs-status-flags nil 'noquery)
		      (list fi) :dont-change-disc t)))))

(defun-cvs-mode (cvs-mode-add . SIMPLE) (flags)
  "Add marked files to the cvs repository.
With prefix argument, prompt for cvs flags."
  (interactive (list (cvs-flags-query 'cvs-add-flags "cvs add flags")))

				 ',dirs
				 '(cvs-parse-process t))
		(dolist (fi ',dirs) (setf (cvs-fileinfo->type fi) 'DEAD))))))
      (cvs-mode-run "add" flags fis :postproc postproc))))

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

	  (cvs-add-secondary-branch-prefix
	   (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))))
  (cvs-mode-do "diff" flags 'diff
	       :show t)) ;; :ignore-exit t

;;----------
(defun-cvs-mode (cvs-mode-diff-head . SIMPLE) (flags)
  "Diff the selected files against the head of the current branch.
See ``cvs-mode-diff'' for more info."
  (interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
  (cvs-mode-diff-1 (cons "-rHEAD" flags)))

;;----------
(defun-cvs-mode (cvs-mode-diff-vendor . SIMPLE) (flags)
  "Diff the selected files against the head of the vendor branch.
See ``cvs-mode-diff'' for more info."
  (interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
  (cvs-mode-diff-1 (cons (concat "-r" cvs-vendor-branch) flags)))

;;----------
;; sadly, this is not provided by cvs, so we have to roll our own
(defun-cvs-mode (cvs-mode-diff-backup . SIMPLE) (flags)
  "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."

    (message "cvs diff backup...")
    (cvs-execute-single-file-list fis 'cvs-diff-backup-extractor
				  cvs-diff-program flags))
  (message "cvs diff backup... Done."))

;;----------
;; (defun cvs-backup-diffable-p (fi)
;;   "Check if the TIN is backup-diffable.
;; It must have a backup file to be diffable."
;;   (cvs-fileinfo->backup-file fi))

;;----------
(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."
  (let ((backup-file (cvs-fileinfo->backup-file fileinfo)))
    (unless backup-file

	  (after-find-file))
	(toggle-read-only 1)
	(message "Retrieving revision %s... Done" rev)
	buf))))

(eval-and-compile (autoload 'vc-resolve-conflicts "vc"))

(defun-cvs-mode cvs-mode-imerge ()
  "Merge interactively appropriate revisions of the selected file."
  (interactive)
  (let ((fi (cvs-mode-marked 'merge nil :one t :file t)))
    (let ((merge (cvs-fileinfo->merge fi))
	  (file (cvs-fileinfo->full-path fi))
	  (backup-file (cvs-fileinfo->backup-file fi)))
      (if (not (and merge backup-file))
	  (let ((buf (find-file-noselect file)))
	    (message "Missing merge info or backup file, using VC.")
	    (save-excursion
	      (set-buffer buf)
	      (vc-resolve-conflicts)))
	(let* ((ancestor-buf (cvs-retrieve-revision fi (car merge)))
	       (head-buf (cvs-retrieve-revision fi (cdr merge)))
	       (backup-buf (let ((auto-mode-alist nil))
			     (find-file-noselect backup-file)))
	       ;; this binding is used by cvs-ediff-startup-hook

(defun cvs-mode-find-file (e &optional other)
  "Select a buffer containing the file.
With a prefix, opens the buffer in an OTHER window."
  (interactive (list last-input-event current-prefix-arg))
  (ignore-errors (mouse-set-point e))	;for invocation via the mouse
  (cvs-mode!
   (lambda (&optional rev)
     (interactive (list (cvs-prefix-get 'cvs-branch-prefix)))
     (let* ((cvs-buf (current-buffer))
	    (fi (cvs-mode-marked nil nil :one t)))

  "Remove all marked files from the buffer."
  (interactive)
  (dolist (fi (cvs-get-marked (cvs-ignore-marks-p "acknowledge") t))
    (setf (cvs-fileinfo->type fi) 'DEAD))
  (cvs-cleanup-collection cvs-cookies nil nil nil))

;;----------
(defun cvs-insert-full-path (tin)
  "Insert full path to the file described in TIN in the current buffer."
  (insert (format "%s\n" (cvs-full-path tin))))

(defun cvs-do-removal (filter &optional cmd all)
  "Remove files.
Returns a list of FIS that should be `cvs remove'd."
  (let* ((files (cvs-mode-marked filter cmd :file t :read-only t))

	(when (string-match "\\.el\\'" filename)
	  (byte-compile-file filename))))))

;; ChangeLog support.

;;----------
(defun-cvs-mode cvs-mode-add-change-log-entry-other-window ()
  "Add a ChangeLog entry in the ChangeLog of the current directory."
  (interactive)
  (let* ((fi (cvs-mode-marked nil nil :one t))
	 (default-directory (cvs-expand-dir-name (cvs-fileinfo->dir fi)))


;;;;
;;;; 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 (ewoc-data 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))
       (cvs-string-prefix-p dir (cvs-fileinfo->dir fileinfo))))

;;
;; Hook to allow calling PCL-CVS by visiting the /CVS subdirectory
;;

;;;###autoload
(defcustom cvs-dired-use-hook '(4)
  "Whether or not opening a CVS directory should run PCL-CVS.
NIL means never do it.
ALWAYS means to always do it unless a prefix argument is given to the
  command that prompted the opening of the directory.

	       cvs-dired-use-hook
	       (if (eq cvs-dired-use-hook 'always)
		   (not current-prefix-arg)
		 (equal current-prefix-arg cvs-dired-use-hook)))
      (save-excursion
	(cvs-examine (file-name-directory dir) t t))))))

;;
;; hook into VC
;;

(defadvice vc-simple-command (after pcl-cvs-vc activate)
  (cvs-vc-command-advice "*vc-info*" (ad-get-arg 1) (ad-get-arg 3)))

(defadvice vc-do-command (after pcl-cvs-vc activate)
  (cvs-vc-command-advice (if (eq t (ad-get-arg 0)) (current-buffer)
			   (or (ad-get-arg 0) "*vc*"))
			 (ad-get-arg 2)
			 (if (stringp (ad-get-arg 4))
			     (ad-get-arg 4)
			   (ad-get-arg 5))))

(defun cvs-vc-command-advice (buffer command cvscmd)
  (when (and (setq buffer (get-buffer buffer))
	     (equal command "cvs")
	     ;; don't parse output we don't understand.

29577:ce3a0229bee7

;;      (Greg Klanderman) [e-mail]
;;      (Jari Aalto+mail.emacs) [e-mail]
;; Maintainer: (Stefan Monnier) monnier+lists/cvs/[e-mail]
;; Keywords: CVS, version control, release management
;; Version: $Name:  $
;; Revision: $Id: pcvs.el,v 1.3 2000/05/10 22:28:36 monnier Exp $

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

;;; Todo:

;; ******** FIX THE DOCUMENTATION *********
;; 
;; - proper `g' that passes safe args and uses either cvs-status or cvs-examine
;; - add toolbar entries
;; - marking
;;    marking directories should jump to just after the dir.
;;    allow (un)marking directories at a time with the mouse.
;;    marking with the mouse should not move point.
;; - liveness indicator
;; - indicate in docstring if the cmd understands the `b' prefix(es).
;; - call smerge-mode when opening CONFLICT files.
;; - have vc-checkin delegate to cvs-mode-commit when applicable
;; - higher-level CVS operations
;;    cvs-mode-rename
;;    cvs-mode-branch
;; - module-level commands

;; 	- does "cvs -n tag LAST_VENDOR" to find old files into *cvs*
;;    cvs-export
;; 	(with completion on tag names and hooks to
;; 	help generate full releases)
;; - allow cvs-cmd-do to either clear the marks or not.
;; - display stickiness information.  And current CVS/Tag as well.
;; - write 'cvs-mode-admin' to do arbitrary 'cvs admin' commands
;;   Most interesting would be version removal and log message replacement.
;;   The last one would be neat when called from log-view-mode.
;; - cvs-mode-incorporate
;; 	It would merge in the status from one *cvs* buffer into another.
;; 	This would be used to populate such a buffer that had been created with
;; 	a `cvs {update,status,checkout} -l'.
;; - cvs-mode-(i)diff-other-{file,buffer,cvs-buffer}
;; - offer the choice to kill the process when the user kills the cvs buffer.
;; 	right now, it's killed without further ado.

(cvs-flags-define cvs-cvs-flags '(("-f")))

(cvs-flags-define cvs-checkout-flags (cvs-defaults '("-P")))
(cvs-flags-define cvs-status-flags (cvs-defaults '("-v") nil))
(cvs-flags-define cvs-log-flags (cvs-defaults nil))
(cvs-flags-define cvs-diff-flags (cvs-defaults '("-u" "-N") '("-c" "-N") '("-u" "-b")))
(cvs-flags-define cvs-tag-flags (cvs-defaults nil))
(cvs-flags-define cvs-add-flags (cvs-defaults nil))
(cvs-flags-define cvs-commit-flags (cvs-defaults nil))
(cvs-flags-define cvs-remove-flags (cvs-defaults nil))
;;(cvs-flags-define cvs-undo-flags (cvs-defaults nil))

  (let* ((dir (file-name-as-directory
	       (abbreviate-file-name (expand-file-name dir))))
	 (cvsbuf (cvs-make-cvs-buffer dir new)))
    ;; Check that dir is under CVS control.
    (unless (file-directory-p dir)
      (error "%s is not a directory" dir))
    (unless (or noexist (file-directory-p (expand-file-name "CVS" dir)))
      (error "%s does not contain CVS controlled files" dir))

    (set-buffer cvsbuf)
    (cvs-mode-run cmd flags fis
		  :cvsargs cvsargs :dont-change-disc dont-change-disc)

      (let ((pop-up-windows nil)) (pop-to-buffer cvsbuf)))))
;;      (funcall (if (and (boundp 'pop-up-frames) pop-up-frames)
;;		   'pop-to-buffer 'switch-to-buffer)
;;	       cvsbuf))))

(defun cvs-run-process (args fis postprocess &optional single-dir)
  (assert (cvs-buffer-p cvs-buffer))
  (save-current-buffer
    (let ((procbuf (current-buffer))
	  (cvsbuf cvs-buffer)

				   (if tin "End" "Empty")
				   " ---------------------\n"
				   prev-msg))))))


(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."
  (when (memq (process-status proc) '(signal exit))

	      (cvs-update-header nil nil) ;FIXME: might need to be inline
	      (message "CVS process has completed"))))
	;; This might not even be necessary
	(set-buffer obuf)))))

(defun cvs-parse-process (dcd &optional subdir)
  "FIXME: bad name, no doc"
  (let* ((from-buf (current-buffer))
	 (fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir))
	 (_ (set-buffer cvs-buffer))

    (cvs-cleanup-collection cvs-cookies
			    (eq cvs-auto-remove-handled t)
			    cvs-auto-remove-directories
			    nil)
    ;; update the display (might be unnecessary)
    ;;(ewoc-refresh cvs-cookies)
    ;; revert buffers if necessary
    (when (and cvs-auto-revert (not dcd) (not cvs-from-vc))
      (cvs-revert-if-needed fileinfos))
    ;; get back to where we were.  `save-excursion' doesn't seem to
    ;; work in this case, probably because the buffer is reconstructed

	  (ewoc-enter-after c tin fi)
	;; fi == tin
	(cvs-fileinfo-update (ewoc-data tin) fi)
	(ewoc-invalidate c tin))
      tin)))

(defcustom cvs-cleanup-functions nil
  "Functions to tweak the cleanup process.
The functions are called with a single argument (a FILEINFO) and should
return a non-nil value if that fileinfo should be removed."
  :group 'pcl-cvs
  :type '(hook :options (cvs-cleanup-removed)))

(defun cvs-cleanup-removed (fi)
  "Non-nil if FI has been cvs-removed but still exists.
This is intended for use on `cvs-cleanup-functions' when you have cvs-removed
automatically generated files (which should hence not be under CVS control)
but can't commit the removal because the repository's owner doesn't understand
the problem."
  (and (or (eq (cvs-fileinfo->type fi) 'REMOVED)
	   (and (eq (cvs-fileinfo->type fi) 'CONFLICT)
		(eq (cvs-fileinfo->subtype fi) 'REMOVED)))
       (file-exists-p (cvs-fileinfo->full-path fi))))

;; called at the following times:
;; - postparse  ((eq cvs-auto-remove-handled t) cvs-auto-remove-directories nil)
;; - pre-run    ((eq cvs-auto-remove-handled 'delayed) nil t)
;; - remove-handled (t (or cvs-auto-remove-directories 'handled) t)

		     ;; remove entries
		     (DEAD nil)
		     ;; handled also?
		     (UP-TO-DATE (not rm-handled))
		     ;; keep the rest
		     (t (not (run-hook-with-args-until-success
			      'cvs-cleanup-functions fi))))))
	     
	     ;; mark dirs for removal
	     (when (and keep rm-dirs
			(eq (cvs-fileinfo->type last-fi) 'DIRCHANGE)
			(not (when first-dir (setq first-dir nil) t))

	   (not current-prefix-arg)
	   (not (eq last-command-char ?\r)))
      default-directory
    (read-file-name msg nil default-directory nil)))

;;;###autoload
(defun cvs-quickdir (dir &optional flags noshow)
  "Open a *cvs* buffer on DIR without running cvs.
With a prefix argument, prompt for a directory to use.
A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
  prevents reuse of an existing *cvs* buffer.
Optional argument NOSHOW if non-nil means not to display the buffer.
FLAGS is ignored."
  (interactive (list (cvs-query-directory "CVS quickdir (directory): ")))
  ;; FIXME: code duplication with cvs-cmd-do and cvs-parse-process
  (let* ((dir (file-name-as-directory
	       (abbreviate-file-name (expand-file-name dir))))
	 (new (> (prefix-numeric-value current-prefix-arg) 8))
	 (cvsbuf (cvs-make-cvs-buffer dir new))
	 last)
    ;; Check that dir is under CVS control.
    (unless (file-directory-p dir)
      (error "%s is not a directory" dir))
    (unless (file-directory-p (expand-file-name "CVS" dir))
      (error "%s does not contain CVS controlled files" dir))
    (set-buffer cvsbuf)
    (dolist (fi (cvs-fileinfo-from-entries ""))
      (setq last (cvs-addto-collection cvs-cookies fi last)))
    (cvs-cleanup-collection cvs-cookies
			    (eq cvs-auto-remove-handled t)
			    cvs-auto-remove-directories
			    nil)
    (if noshow cvsbuf
      (let ((pop-up-windows nil)) (pop-to-buffer cvsbuf)))))

;;;###autoload
(defun cvs-examine (directory flags &optional noshow)
  "Run a `cvs -n update' in the specified DIRECTORY.
That is, check what needs to be done, but don't change the disc.

    (setf flags (cvs-flags-query 'cvs-status-flags nil 'noquery)))
  (cvs-cmd-do "status" directory flags nil
	      (> (prefix-numeric-value current-prefix-arg) 8)
	      :noshow noshow :dont-change-disc t))

(defun cvs-update-filter (proc string)
  "Filter function for pcl-cvs.
This function gets the output that CVS sends to stdout.  It inserts
the STRING 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."

It actually behaves as a toggle.  If prefixed by \\[universal-argument] \\[universal-argument],
the override will persist until the next toggle."
  (interactive "P")
  (cvs-prefix-set 'cvs-force-command arg))

(put 'cvs-mode 'mode-class 'special)
(define-derived-mode cvs-mode fundamental-mode "CVS"
  "Mode used for PCL-CVS, a frontend to CVS.
Full documentation is in the Texinfo file."
  (setq mode-line-process

  (interactive
   (list (read-file-name "File to insert: " nil nil nil
			 (ignore-errors
			   (cvs-fileinfo->dir
			    (car (cvs-mode-marked nil nil :read-only t)))))))
  (let ((file (file-relative-name (directory-file-name file))) last)
    (dolist (fi (cvs-fileinfo-from-entries file))
      (setq last (cvs-addto-collection cvs-cookies fi last)))))

(defun-cvs-mode (cvs-mode-add . SIMPLE) (flags)
  "Add marked files to the cvs repository.
With prefix argument, prompt for cvs flags."
  (interactive (list (cvs-flags-query 'cvs-add-flags "cvs add flags")))

				 ',dirs
				 '(cvs-parse-process t))
		(dolist (fi ',dirs) (setf (cvs-fileinfo->type fi) 'DEAD))))))
      (cvs-mode-run "add" flags fis :postproc postproc))))

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

	  (cvs-add-secondary-branch-prefix
	   (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))))
  (cvs-mode-do "diff" flags 'diff
	       :show t)) ;; :ignore-exit t

(defun-cvs-mode (cvs-mode-diff-head . SIMPLE) (flags)
  "Diff the selected files against the head of the current branch.
See ``cvs-mode-diff'' for more info."
  (interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
  (cvs-mode-diff-1 (cons "-rHEAD" flags)))

(defun-cvs-mode (cvs-mode-diff-vendor . SIMPLE) (flags)
  "Diff the selected files against the head of the vendor branch.
See ``cvs-mode-diff'' for more info."
  (interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
  (cvs-mode-diff-1 (cons (concat "-r" cvs-vendor-branch) flags)))

;; sadly, this is not provided by cvs, so we have to roll our own
(defun-cvs-mode (cvs-mode-diff-backup . SIMPLE) (flags)
  "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."

    (message "cvs diff backup...")
    (cvs-execute-single-file-list fis 'cvs-diff-backup-extractor
				  cvs-diff-program flags))
  (message "cvs diff backup... Done."))

(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."
  (let ((backup-file (cvs-fileinfo->backup-file fileinfo)))
    (unless backup-file

	  (after-find-file))
	(toggle-read-only 1)
	(message "Retrieving revision %s... Done" rev)
	buf))))

(eval-and-compile (autoload 'smerge-ediff "smerge-mode"))

;; FIXME: The user should be able to specify ancestor/head/backup and we should
;; provide sensible defaults when merge info is unavailable (rather than rely
;; on smerge-ediff).  Also provide sane defaults for need-merge files.
(defun-cvs-mode cvs-mode-imerge ()
  "Merge interactively appropriate revisions of the selected file."
  (interactive)
  (let ((fi (cvs-mode-marked 'merge nil :one t :file t)))
    (let ((merge (cvs-fileinfo->merge fi))
	  (file (cvs-fileinfo->full-path fi))
	  (backup-file (cvs-fileinfo->backup-file fi)))
      (if (not (and merge backup-file))
	  (let ((buf (find-file-noselect file)))
	    (message "Missing merge info or backup file, using VC.")
	    (with-current-buffer buf
	      (smerge-ediff)))
	(let* ((ancestor-buf (cvs-retrieve-revision fi (car merge)))
	       (head-buf (cvs-retrieve-revision fi (cdr merge)))
	       (backup-buf (let ((auto-mode-alist nil))
			     (find-file-noselect backup-file)))
	       ;; this binding is used by cvs-ediff-startup-hook

(defun cvs-mode-find-file (e &optional other)
  "Select a buffer containing the file.
With a prefix, opens the buffer in an OTHER window."
  (interactive (list last-input-event current-prefix-arg))
  (when (ignore-errors (mouse-set-point e) t)	;for invocation via the mouse
    (unless (memq (get-text-property (point) 'face)
		  '(cvs-dirname-face cvs-filename-face))
      (error "Not a file name")))
  (cvs-mode!
   (lambda (&optional rev)
     (interactive (list (cvs-prefix-get 'cvs-branch-prefix)))
     (let* ((cvs-buf (current-buffer))
	    (fi (cvs-mode-marked nil nil :one t)))

  "Remove all marked files from the buffer."
  (interactive)
  (dolist (fi (cvs-get-marked (cvs-ignore-marks-p "acknowledge") t))
    (setf (cvs-fileinfo->type fi) 'DEAD))
  (cvs-cleanup-collection cvs-cookies nil nil nil))

(defun cvs-do-removal (filter &optional cmd all)
  "Remove files.
Returns a list of FIS that should be `cvs remove'd."
  (let* ((files (cvs-mode-marked filter cmd :file t :read-only t))

	(when (string-match "\\.el\\'" filename)
	  (byte-compile-file filename))))))

;; ChangeLog support.

(defun-cvs-mode cvs-mode-add-change-log-entry-other-window ()
  "Add a ChangeLog entry in the ChangeLog of the current directory."
  (interactive)
  (let* ((fi (cvs-mode-marked nil nil :one t))
	 (default-directory (cvs-expand-dir-name (cvs-fileinfo->dir fi)))

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

(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))
       (cvs-string-prefix-p dir (cvs-fileinfo->dir fileinfo))))

;;
;; Hook to allow calling PCL-CVS by visiting the /CVS subdirectory
;;

;;;###autoload
(defcustom cvs-dired-action 'cvs-examine
  "The action to be performed when opening a CVS directory.
Sensible values are `cvs-examine', `cvs-status' and `cvs-quickdir'."
  :group 'pcl-cvs
  :type '(choice (const cvs-examine) (const cvs-status) (const cvs-quickdir)))

;;;###autoload
(defcustom cvs-dired-use-hook '(4)
  "Whether or not opening a CVS directory should run PCL-CVS.
NIL means never do it.
ALWAYS means to always do it unless a prefix argument is given to the
  command that prompted the opening of the directory.

	       cvs-dired-use-hook
	       (if (eq cvs-dired-use-hook 'always)
		   (not current-prefix-arg)
		 (equal current-prefix-arg cvs-dired-use-hook)))
      (save-excursion
	(funcall cvs-dired-action (file-name-directory dir) t t))))))

;;
;; hook into VC
;;

(if (boundp 'vc-post-command-functions)
    ;; Hook into the new VC.
    (add-hook 'vc-post-command-functions
	      (lambda (cmd file flags)
		(cvs-vc-command-advice (current-buffer) cmd (car flags))))
  ;; Hook into the old VC.
  (defadvice vc-simple-command (after pcl-cvs-vc activate)
    (cvs-vc-command-advice "*vc-info*" (ad-get-arg 1) (ad-get-arg 3)))
  (defadvice vc-do-command (after pcl-cvs-vc activate)
    (cvs-vc-command-advice (if (eq t (ad-get-arg 0)) (current-buffer)
			     (or (ad-get-arg 0) "*vc*"))
			   (ad-get-arg 2)
			   (if (stringp (ad-get-arg 4))
			       (ad-get-arg 4)
			     (ad-get-arg 5)))))

(defun cvs-vc-command-advice (buffer command cvscmd)
  (when (and (setq buffer (get-buffer buffer))
	     (equal command "cvs")
	     ;; don't parse output we don't understand.