summaryrefslogtreecommitdiffstats
path: root/gnu/usr.bin/cvs/contrib/pcl-cvs/pcl-cvs.el
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/usr.bin/cvs/contrib/pcl-cvs/pcl-cvs.el')
-rw-r--r--gnu/usr.bin/cvs/contrib/pcl-cvs/pcl-cvs.el1476
1 files changed, 1476 insertions, 0 deletions
diff --git a/gnu/usr.bin/cvs/contrib/pcl-cvs/pcl-cvs.el b/gnu/usr.bin/cvs/contrib/pcl-cvs/pcl-cvs.el
new file mode 100644
index 0000000..99da369
--- /dev/null
+++ b/gnu/usr.bin/cvs/contrib/pcl-cvs/pcl-cvs.el
@@ -0,0 +1,1476 @@
+;;; pcl-cvs.el,v 1.2 1992/04/07 20:49:19 berliner Exp
+;;; pcl-cvs.el -- A Front-end to CVS 1.3 or later. Release 1.02.
+;;; Copyright (C) 1991, 1992 Per Cederqvist
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;;; See below for installation instructions.
+;;;;
+;;;; There is an TeXinfo file that describes this package. The GNU
+;;;; General Public License is included in that file. You should read
+;;;; it to get the most from this package.
+
+;;; Don't try to use this with CVS 1.2 or earlier. It won't work. Get
+;;; CVS 1.3.
+
+;;; Mail questions and bug reports to ceder@lysator.liu.se.
+
+(require 'cookie)
+(provide 'pcl-cvs)
+
+;;; -------------------------------------------------------
+;;; START OF THINGS TO CHECK WHEN INSTALLING
+
+(defvar cvs-program "/usr/gnu/bin/cvs"
+ "*Full path to the cvs executable.")
+
+(defvar cvs-diff-program "/usr/gnu/bin/diff"
+ "*Full path to the diff program.")
+
+(defvar cvs-rm-program "/usr/gnu/bin/rm"
+ "*Full path to the rm program. Typically /bin/rm.")
+
+;; Uncomment the following line if you are running on 18.57 or earlier.
+;(setq delete-exited-processes nil)
+;; Emacs version 18.57 and earlier is likely to crash if
+;; delete-exited-processes is t, since the sentinel uses lots of
+;; memory, and 18.57 forgets to GCPROT a variable if
+;; delete-exited-processes is t.
+
+;;; END OF THINGS TO CHECK WHEN INSTALLING
+;;; --------------------------------------------------------
+
+(defvar cvs-bakprefix ".#"
+ "The prefix that CVS prepends to files when rcsmerge'ing.")
+
+(defvar cvs-erase-input-buffer nil
+ "*Non-nil if input buffers should be cleared before asking for new info.")
+
+(defvar cvs-auto-remove-handled nil
+ "*Non-nil if cvs-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-commit
+command.")
+
+(defconst cvs-cursor-column 14
+ "Column to position cursor in in cvs-mode.
+Column 0 is left-most column.")
+
+(defvar cvs-mode-map nil
+ "Keymap for the cvs mode.")
+
+(defvar cvs-edit-mode-map nil
+ "Keymap for the cvs edit mode (used when editing cvs log messages).")
+
+(defvar cvs-buffer-name "*cvs*"
+ "Name of the cvs buffer.")
+
+(defvar cvs-commit-prompt-buffer "*cvs-commit-message*"
+ "Name of buffer in which the user is prompted for a log message when
+committing files.")
+
+(defvar cvs-temp-buffer-name "*cvs-tmp*"
+ "*Name of the cvs temporary buffer.
+Output from cvs is placed here by synchronous commands.")
+
+(defvar cvs-cvs-diff-flags nil
+ "*List of strings to use as flags to pass to ``cvs diff''.
+Used by cvs-diff-cvs.
+Set this to '("-u") to get a Unidiff format, or '("-c") to get context diffs.")
+
+(defvar cvs-status-flags nil
+ "*List of strings to pass to ``cvs status''.")
+
+(defvar cvs-log-flags nil
+ "*List of strings to pass to ``cvs log''.")
+
+(defvar cvs-diff-flags nil
+ "*List of strings to use as flags to pass to ``diff''.
+Do not confuse with cvs-cvs-diff-flags. Used by cvs-diff-backup.")
+
+(defvar cvs-buffers-to-delete nil
+ "List of temporary buffers that should be discarded as soon as possible.
+Due to a bug in emacs 18.57 the sentinel can't discard them reliably.")
+
+;; 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
+ "*Don't display a Copyright message in the ``*cvs*'' buffer.")
+
+(defvar cvs-startup-message
+ (if cvs-inhibit-copyright-message
+ "PCL-CVS release 1.02"
+ "PCL-CVS release 1.02. Copyright (C) 1992 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-cvs-buffer nil
+ "Internal to pcl-cvs.el.
+This variable exists in the *cvs-commit-message* buffer and names
+the *cvs* buffer.")
+
+;;; The cvs data structure:
+;;;
+;;; When the `cvs update' is ready we parse the output. Every file
+;;; that is affected in some way is added as a cookie of fileinfo
+;;; (as defined below).
+;;;
+
+;;; cvs-fileinfo
+;;;
+;;; marked t/nil
+;;; type One of
+;;; UPDATED - file copied from repository
+;;; MODIFIED - modified by you, unchanged in
+;;; repository
+;;; ADDED - added by you, not yet committed
+;;; REMOVED - removed by you, not yet committed
+;;; CVS-REMOVED- removed, since file no longer exists
+;;; in the repository.
+;;; MERGED - successful merge
+;;; CONFLICT - conflict when merging
+;;; REM-CONFLICT-removed in repository, changed locally.
+;;; MOD-CONFLICT-removed locally, changed in repository.
+;;; DIRCHANGE - A change of directory.
+;;; UNKNOWN - An unknown file.
+;;; MOVE-AWAY - A file that is in the way.
+;;; REPOS-MISSING- The directory is removed from the
+;;; repository. Go fetch a backup.
+;;; dir Directory the file resides in. Should not end with
+;;; slash.
+;;; file-name The file name.
+;;; backup-file Name of the backup file if MERGED or CONFLICT.
+;;; cvs-diff-buffer A buffer that contains a 'cvs diff file'.
+;;; backup-diff-buffer A buffer that contains a 'diff file backup-file'.
+;;; full-log The output from cvs, unparsed.
+;;; mod-time Modification time of file used for *-diff-buffer.
+;;; handled True if this file doesn't require further action.
+;;;
+;;; Constructor:
+
+;;; cvs-fileinfo
+
+;;; Constructor:
+
+(defun cvs-create-fileinfo (type
+ dir
+ file-name
+ full-log)
+ "Create a fileinfo from all parameters.
+Arguments: TYPE DIR FILE-NAME FULL-LOG.
+A fileinfo has the following fields:
+
+ marked t/nil
+ type One of
+ UPDATED - file copied from repository
+ MODIFIED - modified by you, unchanged in
+ repository
+ ADDED - added by you, not yet committed
+ REMOVED - removed by you, not yet committed
+ CVS-REMOVED- removed, since file no longer exists
+ in the repository.
+ MERGED - successful merge
+ CONFLICT - conflict when merging
+ REM-CONFLICT-removed in repository, but altered
+ locally.
+ MOD-CONFLICT-removed locally, changed in repository.
+ DIRCHANGE - A change of directory.
+ UNKNOWN - An unknown file.
+ MOVE-AWAY - A file that is in the way.
+ REPOS-MISSING- The directory has vanished from the
+ repository.
+ dir Directory the file resides in. Should not end with slash.
+ file-name The file name.
+ backup-file Name of the backup file if MERGED or CONFLICT.
+ cvs-diff-buffer A buffer that contains a 'cvs diff file'.
+ backup-diff-buffer A buffer that contains a 'diff file backup-file'.
+ full-log The output from cvs, unparsed.
+ mod-time Modification time of file used for *-diff-buffer.
+ handled True if this file doesn't require further action."
+ (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, MODIFIED, ADDED, REMOVED, CVS-REMOVED, MERGED,
+CONFLICT, REM-CONFLICT, MOD-CONFLICT, DIRCHANGE, UNKNOWN, MOVE-AWAY
+or REPOS-MISSING."
+ (elt (cdr cvs-fileinfo) 2))
+
+(defun cvs-fileinfo->dir (cvs-fileinfo)
+ "Get dir from CVS-FILEINFO.
+The directory name does not end with a slash. "
+ (elt (cdr cvs-fileinfo) 3))
+
+(defun cvs-fileinfo->file-name (cvs-fileinfo)
+ "Get file-name from CVS-FILEINFO."
+ (elt (cdr cvs-fileinfo) 4))
+
+(defun cvs-fileinfo->backup-file (cvs-fileinfo)
+ "Get backup-file from CVS-FILEINFO."
+ (elt (cdr cvs-fileinfo) 5))
+
+(defun cvs-fileinfo->cvs-diff-buffer (cvs-fileinfo)
+ "Get cvs-diff-buffer from CVS-FILEINFO."
+ (elt (cdr cvs-fileinfo) 6))
+
+(defun cvs-fileinfo->backup-diff-buffer (cvs-fileinfo)
+ "Get backup-diff-buffer 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))
+
+;;; Modifiers:
+
+(defun cvs-set-fileinfo->handled (cvs-fileinfo newval)
+ "Set handled in CVS-FILEINFO to NEWVAL."
+ (aset (cdr cvs-fileinfo) 0 newval))
+
+(defun cvs-set-fileinfo->marked (cvs-fileinfo newval)
+ "Set marked in CVS-FILEINFO to NEWVAL."
+ (aset (cdr cvs-fileinfo) 1 newval))
+
+(defun cvs-set-fileinfo->type (cvs-fileinfo newval)
+ "Set type in CVS-FILEINFO to NEWVAL."
+ (aset (cdr cvs-fileinfo) 2 newval))
+
+(defun cvs-set-fileinfo->dir (cvs-fileinfo newval)
+ "Set dir in CVS-FILEINFO to NEWVAL.
+The directory should now end with a slash."
+ (aset (cdr cvs-fileinfo) 3 newval))
+
+(defun cvs-set-fileinfo->file-name (cvs-fileinfo newval)
+ "Set file-name in CVS-FILEINFO to NEWVAL."
+ (aset (cdr cvs-fileinfo) 4 newval))
+
+(defun cvs-set-fileinfo->backup-file (cvs-fileinfo newval)
+ "Set backup-file in CVS-FILEINFO to NEWVAL."
+ (aset (cdr cvs-fileinfo) 5 newval))
+
+(defun cvs-set-fileinfo->cvs-diff-buffer (cvs-fileinfo newval)
+ "Set cvs-diff-buffer in CVS-FILEINFO to NEWVAL."
+ (aset (cdr cvs-fileinfo) 6 newval))
+
+(defun cvs-set-fileinfo->backup-diff-buffer (cvs-fileinfo newval)
+ "Set backup-diff-buffer 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))
+
+;;;; End of types.
+
+(defun cvs-use-temp-buffer ()
+ "Display a temporary buffer in another window and select it.
+The selected window will not be changed. The temporary buffer will
+be erased and writable."
+
+ (display-buffer (get-buffer-create cvs-temp-buffer-name))
+ (set-buffer cvs-temp-buffer-name)
+ (setq buffer-read-only nil)
+ (erase-buffer))
+
+; Too complicated to handle all the cases that are generated.
+; Maybe later.
+;(defun cvs-examine (directory &optional local)
+; "Run a 'cvs -n update' in the current working directory.
+;That is, check what needs to be done, but don't change the disc.
+;Feed the output to a *cvs* buffer and run cvs-mode on it.
+;If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run."
+; (interactive (list (read-file-name "CVS Update (directory): "
+; nil default-directory nil)
+; current-prefix-arg))
+; (cvs-do-update directory local 'noupdate))
+
+(defun cvs-update (directory &optional local)
+ "Run a 'cvs update' in the current working directory. Feed the
+output to a *cvs* buffer and run cvs-mode on it.
+If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run."
+ (interactive (list (read-file-name "CVS Update (directory): "
+ nil default-directory nil)
+ current-prefix-arg))
+ (cvs-do-update directory local nil))
+
+(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-update-no-prompt ()
+ "Run cvs update in current directory."
+ (interactive)
+ (cvs-do-update default-directory nil nil))
+
+(defun cvs-do-update (directory local dont-change-disc)
+ "Do a 'cvs update' in DIRECTORY.
+If LOCAL is non-nil 'cvs update -l' is executed.
+If DONT-CHANGE-DISC is non-nil 'cvs -n update' is executed.
+Both LOCAL and DONT-CHANGE-DISC may be non-nil simultaneously.
+
+*Note*: DONT-CHANGE-DISC does not yet work. The parser gets confused."
+ (save-some-buffers)
+ (let* ((this-dir (file-name-as-directory (expand-file-name directory)))
+ (use-this-window (equal (buffer-name (current-buffer))
+ cvs-buffer-name))
+ (update-buffer (generate-new-buffer
+ (concat (file-name-nondirectory
+ (substring this-dir 0 -1))
+ "-update")))
+ cvs-process args)
+
+ ;; The *cvs* buffer is killed to avoid confusion - is the update ready
+ ;; or not?
+ (if (get-buffer cvs-buffer-name)
+ (kill-buffer cvs-buffer-name))
+
+ ;; Generate "-n update -l".
+ (if local (setq args (list "-l")))
+ (setq args (cons "update" args))
+ (if dont-change-disc (setq args (cons "-n" args)))
+
+ ;; Set up the buffer that receives the output from "cvs update".
+ (if use-this-window
+ (switch-to-buffer update-buffer)
+ (set-buffer update-buffer)
+ (display-buffer update-buffer))
+
+ (setq default-directory this-dir)
+ (setq cvs-process
+ (let ((process-connection-type nil)) ; Use a pipe, not a pty.
+ (apply 'start-process "cvs" update-buffer cvs-program args)))
+
+ (setq mode-line-process
+ (concat ": "
+ (symbol-name (process-status cvs-process))))
+ (set-buffer-modified-p (buffer-modified-p)) ; Update the mode line.
+ (set-process-sentinel cvs-process 'cvs-sentinel)
+
+ ;; Work around a bug in emacs 18.57 and earlier.
+ (setq cvs-buffers-to-delete
+ (cvs-delete-unused-temporary-buffers cvs-buffers-to-delete))))
+
+(defun cvs-delete-unused-temporary-buffers (list)
+ "Delete all buffers on LIST that is not visible.
+Return a list of all buffers that still is alive."
+
+ (cond
+ ((null list) nil)
+ ((get-buffer-window (car list))
+ (cons (car list)
+ (cvs-delete-unused-temporary-buffers (cdr list))))
+ (t
+ (kill-buffer (car list))
+ (cvs-delete-unused-temporary-buffers (cdr list)))))
+
+
+(put 'cvs-mode 'mode-class 'special)
+
+(defun cvs-mode ()
+ "\\<cvs-mode-map>Mode used for pcl-cvs, a 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:
+
+\\[cookie-previous-cookie] Move up. \\[cookie-next-cookie] Move down.
+\\[cvs-commit] Commit file. \\[cvs-update-no-prompt] Reupdate directory.
+\\[cvs-mark] Mark file/dir. \\[cvs-unmark] Unmark file/dir.
+\\[cvs-mark-all-files] Mark all files. \\[cvs-unmark-all-files] Unmark all files.
+\\[cvs-find-file] Edit file/run Dired. \\[cvs-find-file-other-window] Find file or run Dired in other window.
+\\[cvs-remove-handled] Remove processed entries. \\[cvs-add-change-log-entry-other-window] Write ChangeLog in other window.
+\\[cvs-add] Add to repository. \\[cvs-remove-file] Remove file.
+\\[cvs-diff-cvs] Diff between base revision. \\[cvs-diff-backup] Diff backup file.
+\\[cvs-acknowledge] Delete line from buffer. \\[cvs-ignore] Add file to the .cvsignore file.
+\\[cvs-log] Run ``cvs log''. \\[cvs-status] Run ``cvs status''.
+
+Entry to this mode runs cvs-mode-hook.
+This description is updated for release 1.02 of pcl-cvs.
+All bindings:
+\\{cvs-mode-map}"
+ (interactive)
+ (setq major-mode 'cvs-mode)
+ (setq mode-name "CVS")
+ (setq buffer-read-only nil)
+ (buffer-flush-undo (current-buffer))
+ (make-local-variable 'goal-column)
+ (setq goal-column cvs-cursor-column)
+ (use-local-map cvs-mode-map)
+ (run-hooks 'cvs-mode-hook))
+
+(defun cvs-sentinel (proc msg)
+ "Sentinel for the cvs update process.
+This is responsible for parsing the output from the cvs update when
+it is finished."
+ (cond
+ ((null (buffer-name (process-buffer proc)))
+ ;; buffer killed
+ (set-process-buffer proc nil))
+ ((memq (process-status proc) '(signal exit))
+ (let* ((obuf (current-buffer))
+ (omax (point-max))
+ (opoint (point)))
+ ;; save-excursion isn't the right thing if
+ ;; process-buffer is current-buffer
+ (unwind-protect
+ (progn
+ (set-buffer (process-buffer proc))
+ (setq mode-line-process
+ (concat ": "
+ (symbol-name (process-status proc))))
+ (cvs-parse-buffer)
+ (setq cvs-buffers-to-delete
+ (cons (process-buffer proc) cvs-buffers-to-delete)))
+ (set-buffer-modified-p (buffer-modified-p)))
+ (if (equal obuf (process-buffer proc))
+ nil
+ (set-buffer (process-buffer proc))
+ (if (< opoint omax)
+ (goto-char opoint))
+ (set-buffer obuf))))))
+
+(defun cvs-skip-line (regexp errormsg &optional arg)
+ "Like forward-line, but check that the skipped line matches REGEXP.
+If it doesn't match REGEXP (error ERRORMSG) is called.
+If optional ARG, a number, is given the ARGth parenthesized expression
+in the REGEXP is returned as a string.
+Point should be in column 1 when this function is called."
+ (cond
+ ((looking-at regexp)
+ (forward-line 1)
+ (if arg
+ (buffer-substring (match-beginning arg)
+ (match-end arg))))
+ (t
+ (error errormsg))))
+
+(defun cvs-get-current-dir (dirname)
+ "Return current working directory, suitable for cvs-parse-buffer.
+Args: DIRNAME.
+Concatenates default-directory and DIRNAME to form an absolute path."
+ (if (string= "." dirname)
+ (substring default-directory 0 -1)
+ (concat default-directory dirname)))
+
+
+(defun cvs-parse-buffer ()
+ "Parse the current buffer and select a *cvs* buffer.
+Signals an error if unexpected output was detected in the buffer."
+ (goto-char (point-min))
+ (let ((buf (get-buffer-create cvs-buffer-name))
+ (current-dir default-directory)
+ (root-dir default-directory)
+ (parse-buf (current-buffer)))
+
+ (cookie-create
+ buf 'cvs-pp cvs-startup-message ;Se comment above cvs-startup-message.
+ "---------- End -----")
+
+ (cookie-enter-first
+ buf
+ (cvs-create-fileinfo
+ 'DIRCHANGE current-dir
+ nil ""))
+
+ (while (< (point) (point-max))
+ (cond
+
+ ;; CVS is descending a subdirectory.
+
+ ((looking-at "cvs update: Updating \\(.*\\)$")
+ (setq current-dir
+ (cvs-get-current-dir
+ (buffer-substring (match-beginning 1) (match-end 1))))
+
+ ;; Omit empty directories.
+ (if (eq (cvs-fileinfo->type (cookie-last buf))
+ 'DIRCHANGE)
+ (cookie-delete-last buf))
+
+ (cookie-enter-last
+ buf
+ (cvs-create-fileinfo
+ 'DIRCHANGE current-dir
+ nil (buffer-substring (match-beginning 0)
+ (match-end 0))))
+ (forward-line 1))
+
+ ;; File removed, since it is removed (by third party) in repository.
+
+ ((or (looking-at "cvs update: warning: \\(.*\\) is not (any longer) \
+pertinent")
+ (looking-at "cvs update: \\(.*\\) is no longer in the repository"))
+ (cookie-enter-last
+ buf
+ (cvs-create-fileinfo
+ 'CVS-REMOVED current-dir
+ (file-name-nondirectory
+ (buffer-substring (match-beginning 1) (match-end 1)))
+ (buffer-substring (match-beginning 0)
+ (match-end 0))))
+ (forward-line 1))
+
+ ;; File removed by you, but recreated by cvs. Ignored.
+
+ ((looking-at "cvs update: warning: .* was lost$")
+ (forward-line 1))
+
+ ;; A file that has been created by you, but added to the cvs
+ ;; repository by another.
+
+ ((looking-at "^cvs update: move away \\(.*\\); it is in the way$")
+ (cookie-enter-last
+ buf
+ (cvs-create-fileinfo
+ 'MOVE-AWAY current-dir
+ (file-name-nondirectory
+ (buffer-substring (match-beginning 1) (match-end 1)))
+ (buffer-substring (match-beginning 0)
+ (match-end 0))))
+ (forward-line 1))
+
+ ;; Empty line. Probably inserted by mistake by user (or developer :-)
+ ;; Ignore.
+
+ ((looking-at "^$")
+ (forward-line 1))
+
+ ;; Cvs waits for a lock. Ignore.
+
+ ((looking-at
+ "^cvs update: \\[..:..:..\\] waiting for .*lock in ")
+ (forward-line 1))
+
+ ;; File removed in repository, but edited by you.
+
+ ((looking-at
+ "cvs update: conflict: \\(.*\\) is modified but no longer \
+in the repository$")
+ (cookie-enter-last
+ buf
+ (cvs-create-fileinfo
+ 'REM-CONFLICT current-dir
+ (file-name-nondirectory
+ (buffer-substring (match-beginning 1) (match-end 1)))
+ (buffer-substring (match-beginning 0)
+ (match-end 0))))
+ (forward-line 1))
+
+ ((looking-at
+ "cvs update: conflict: removed \\(.*\\) was modified by second party")
+ (cvs-create-fileinfo
+ 'MOD-CONFLICT current-dir
+ (buffer-substring (match-beginning 1) (match-end 1))
+ (buffer-substring (match-beginning 0) (match-end 0)))
+ (forward-line 1))
+
+ ((looking-at "cvs update: in directory ")
+ (let ((start (point)))
+ (forward-line 1)
+ (cvs-skip-line
+ (regexp-quote "cvs [update aborted]: there is no repository ")
+ "Unexpected cvs output.")
+ (cookie-enter-last
+ buf
+ (cvs-create-fileinfo
+ 'REPOS-MISSING current-dir
+ nil
+ (buffer-substring start (point))))))
+
+ ;; The file is copied from the repository.
+
+ ((looking-at "U \\(.*\\)$")
+ (cookie-enter-last
+ buf
+ (let ((fileinfo
+ (cvs-create-fileinfo
+ 'UPDATED current-dir
+ (file-name-nondirectory
+ (buffer-substring (match-beginning 1) (match-end 1)))
+ (buffer-substring (match-beginning 0) (match-end 0)))))
+ (cvs-set-fileinfo->handled fileinfo t)
+ fileinfo))
+ (forward-line 1))
+
+ ;; The file is modified by the user, and untouched in the repository.
+
+ ((looking-at "M \\(.*\\)$")
+ (cookie-enter-last
+ buf
+ (cvs-create-fileinfo
+ 'MODIFIED current-dir
+ (file-name-nondirectory
+ (buffer-substring (match-beginning 1) (match-end 1)))
+ (buffer-substring (match-beginning 0) (match-end 0))))
+ (forward-line 1))
+
+ ;; The file is "cvs add"ed, but not "cvs ci"ed.
+
+ ((looking-at "A \\(.*\\)$")
+ (cookie-enter-last
+ buf
+ (cvs-create-fileinfo
+ 'ADDED current-dir
+ (file-name-nondirectory
+ (buffer-substring (match-beginning 1) (match-end 1)))
+ (buffer-substring (match-beginning 0) (match-end 0))))
+ (forward-line 1))
+
+ ;; The file is "cvs remove"ed, but not "cvs ci"ed.
+
+ ((looking-at "R \\(.*\\)$")
+ (cookie-enter-last
+ buf
+ (cvs-create-fileinfo
+ 'REMOVED current-dir
+ (file-name-nondirectory
+ (buffer-substring (match-beginning 1) (match-end 1)))
+ (buffer-substring (match-beginning 0) (match-end 0))))
+ (forward-line 1))
+
+ ;; Unknown file.
+
+ ((looking-at "? \\(.*\\)$")
+ (cookie-enter-last
+ buf
+ (cvs-create-fileinfo
+ 'UNKNOWN current-dir
+ (file-name-nondirectory
+ (buffer-substring (match-beginning 1) (match-end 1)))
+ (buffer-substring (match-beginning 0) (match-end 0))))
+ (forward-line 1))
+ (t
+
+ ;; CVS has decided to merge someone elses changes into this
+ ;; document. This leads to a lot of garbage being printed.
+ ;; First there is two lines that contains no information
+ ;; that we skip (but we check that we recognize them).
+
+ (let ((complex-start (point))
+ initial-revision filename)
+
+ (cvs-skip-line "^RCS file: .*$" "Parse error.")
+ (setq initial-revision
+ (cvs-skip-line "^retrieving revision \\(.*\\)$"
+ "Unexpected output from cvs." 1))
+ (cvs-skip-line "^retrieving revision .*$"
+ "Unexpected output from cvs.")
+
+ ;; Get the file name from the next line.
+
+ (setq
+ filename
+ (cvs-skip-line
+ "^Merging differences between [0-9.]+ and [0-9.]+ into \\(.*\\)$"
+ "Unexpected output from cvs."
+ 1))
+
+ (cond
+
+ ;; The file was successfully merged.
+
+ ((looking-at "^M ")
+ (forward-line 1)
+ (let ((fileinfo
+ (cvs-create-fileinfo
+ 'MERGED current-dir
+ filename
+ (buffer-substring complex-start (point)))))
+ (cvs-set-fileinfo->backup-file
+ fileinfo
+ (concat cvs-bakprefix filename "." initial-revision))
+ (cookie-enter-last
+ buf fileinfo)))
+
+ ;; A conflicting merge.
+
+ (t
+ (cvs-skip-line "^merge: overlaps during merge$"
+ "Unexpected output from cvs.")
+ (cvs-skip-line "^cvs update: conflicts found in "
+ "Unexpected output from cvs.")
+ (cvs-skip-line "^C " "Unexpected cvs output.")
+ (let ((fileinfo
+ (cvs-create-fileinfo
+ 'CONFLICT current-dir
+ filename
+ (buffer-substring complex-start (point)))))
+
+ (cvs-set-fileinfo->backup-file
+ fileinfo
+ (concat cvs-bakprefix filename "." initial-revision))
+
+ (cookie-enter-last buf fileinfo))))))))
+
+ ;; All parsing is done.
+
+ ;; If the last entry is a directory, remove it.
+ (if (eq (cvs-fileinfo->type (cookie-last buf))
+ 'DIRCHANGE)
+ (cookie-delete-last buf))
+
+ (set-buffer buf)
+ (cvs-mode)
+ (setq cookie-last-tin (cookie-nth buf 0))
+ (goto-char (point-min))
+ (cookie-previous-cookie buf (point-min) 1)
+ (setq default-directory root-dir)
+ (if (get-buffer-window parse-buf)
+ (set-window-buffer (get-buffer-window parse-buf) buf)
+ (display-buffer buf))))
+
+
+(defun cvs-pp (fileinfo)
+ "Pretty print FILEINFO into a string."
+
+ (let ((a (cvs-fileinfo->type fileinfo))
+ (s (if (cvs-fileinfo->marked fileinfo)
+ "*" " "))
+ (f (cvs-fileinfo->file-name fileinfo))
+ (ci (if (cvs-fileinfo->handled fileinfo)
+ " " "ci")))
+ (cond
+ ((eq a 'UPDATED)
+ (format "%s Updated %s" s f))
+ ((eq a 'MODIFIED)
+ (format "%s Modified %s %s" s ci f))
+ ((eq a 'MERGED)
+ (format "%s Merged %s %s" s ci f))
+ ((eq a 'CONFLICT)
+ (format "%s Conflict %s" s f))
+ ((eq a 'ADDED)
+ (format "%s Added %s %s" s ci f))
+ ((eq a 'REMOVED)
+ (format "%s Removed %s %s" s ci f))
+ ((eq a 'UNKNOWN)
+ (format "%s Unknown %s" s f))
+ ((eq a 'CVS-REMOVED)
+ (format "%s Removed from repository: %s" s f))
+ ((eq a 'REM-CONFLICT)
+ (format "%s Conflict: Removed from repository, changed by you: %s" s f))
+ ((eq a 'MOD-CONFLICT)
+ (format "%s Conflict: Removed by you, changed in repository: %s" s f))
+ ((eq a 'DIRCHANGE)
+ (format "\nIn directory %s:"
+ (cvs-fileinfo->dir fileinfo)))
+ ((eq a 'MOVE-AWAY)
+ (format "%s Move away %s - it is in the way" s f))
+ ((eq a 'REPOS-MISSING)
+ (format " This repository is missing! Remove this dir manually."))
+ (t
+ (format "%s Internal error! %s" s f)))))
+
+
+;;; You can define your own keymap in .emacs. pcl-cvs.el won't overwrite it.
+
+(if cvs-mode-map
+ nil
+ (setq cvs-mode-map (make-keymap))
+ (suppress-keymap cvs-mode-map)
+ (define-key cvs-mode-map " " 'cookie-next-cookie)
+ (define-key cvs-mode-map "?" 'describe-mode)
+ (define-key cvs-mode-map "A" 'cvs-add-change-log-entry-other-window)
+ (define-key cvs-mode-map "M" 'cvs-mark-all-files)
+ (define-key cvs-mode-map "U" 'cvs-unmark-all-files)
+ (define-key cvs-mode-map "\C-?" 'cvs-unmark-up)
+ (define-key cvs-mode-map "\C-n" 'cookie-next-cookie)
+ (define-key cvs-mode-map "\C-p" 'cookie-previous-cookie)
+ (define-key cvs-mode-map "a" 'cvs-add)
+ (define-key cvs-mode-map "b" 'cvs-diff-backup)
+ (define-key cvs-mode-map "c" 'cvs-commit)
+ (define-key cvs-mode-map "d" 'cvs-diff-cvs)
+ (define-key cvs-mode-map "f" 'cvs-find-file)
+ (define-key cvs-mode-map "g" 'cvs-update-no-prompt)
+ (define-key cvs-mode-map "i" 'cvs-ignore)
+ (define-key cvs-mode-map "l" 'cvs-log)
+ (define-key cvs-mode-map "m" 'cvs-mark)
+ (define-key cvs-mode-map "n" 'cookie-next-cookie)
+ (define-key cvs-mode-map "o" 'cvs-find-file-other-window)
+ (define-key cvs-mode-map "p" 'cookie-previous-cookie)
+ (define-key cvs-mode-map "r" 'cvs-remove-file)
+ (define-key cvs-mode-map "s" 'cvs-status)
+ (define-key cvs-mode-map "\C-k" 'cvs-acknowledge)
+ (define-key cvs-mode-map "x" 'cvs-remove-handled)
+ (define-key cvs-mode-map "u" 'cvs-unmark))
+
+
+(defun cvs-get-marked ()
+ "Return a list of all selected tins.
+If there are any marked tins, return them.
+Otherwise, if the cursor selects a directory, return all files in it.
+Otherwise return (a list containing) the file the cursor points to, or
+an empty list if it doesn't point to a file at all."
+
+ (cond
+ ;; Any marked cookies?
+ ((cookie-collect-tins (current-buffer)
+ 'cvs-fileinfo->marked))
+ ;; Nope.
+ (t
+ (let ((sel (cookie-get-selection
+ (current-buffer) (point) cookie-last-tin)))
+ (cond
+ ;; If a directory is selected, all it members are returned.
+ ((and sel (eq (cvs-fileinfo->type
+ (cookie-cookie (current-buffer) sel))
+ 'DIRCHANGE))
+ (cookie-collect-tins
+ (current-buffer) 'cvs-dir-member-p
+ (cvs-fileinfo->dir (cookie-cookie (current-buffer) sel))))
+ (t
+ (list sel)))))))
+
+
+(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 (cvs-buf tin)
+ "Return non-nil if TIN is a directory that is empty.
+Args: CVS-BUF TIN."
+ (and (eq (cvs-fileinfo->type (cookie-cookie cvs-buf tin)) 'DIRCHANGE)
+ (or (not (cookie-next cvs-buf tin))
+ (eq (cvs-fileinfo->type (cookie-cookie cvs-buf
+ (cookie-next cvs-buf tin)))
+ 'DIRCHANGE))))
+
+(defun cvs-remove-handled ()
+ "Remove all lines that are handled.
+Empty directories are removed."
+ (interactive)
+ ;; Pass one: remove files that are handled.
+ (cookie-filter (current-buffer)
+ (function
+ (lambda (fileinfo) (not (cvs-fileinfo->handled fileinfo)))))
+ ;; Pass two: remove empty directories.
+ (cookie-filter-tins (current-buffer)
+ (function
+ (lambda (tin)
+ (not (cvs-dir-empty-p (current-buffer) tin))))))
+
+(defun cvs-mark (pos)
+ "Mark a fileinfo. Args: POS.
+If the fileinfo is a directory, all the contents of that directory are
+marked instead. A directory can never be marked.
+POS is a buffer position."
+
+ (interactive "d")
+
+ (let* ((tin (cookie-get-selection
+ (current-buffer) pos cookie-last-tin))
+ (sel (cookie-cookie (current-buffer) 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.
+ (current-buffer)
+ (cvs-fileinfo->dir sel)))
+ (t
+ (cvs-set-fileinfo->marked sel t)
+ (cookie-invalidate-tins (current-buffer) tin)
+ (cookie-next-cookie (current-buffer) pos 1)))))
+
+
+(defun cvs-committable (tin cvs-buf)
+ "Check if the TIN is committable.
+It is committable if it
+ a) is not handled and
+ b) is either MODIFIED, ADDED, REMOVED, MERGED or CONFLICT."
+ (let* ((fileinfo (cookie-cookie cvs-buf tin))
+ (type (cvs-fileinfo->type fileinfo)))
+ (and (not (cvs-fileinfo->handled fileinfo))
+ (or (eq type 'MODIFIED)
+ (eq type 'ADDED)
+ (eq type 'REMOVED)
+ (eq type 'MERGED)
+ (eq type 'CONFLICT)))))
+
+(defun cvs-commit ()
+
+ "Check in all marked files, or the current file.
+The user will be asked for a log message in a buffer.
+If cvs-erase-input-buffer is non-nil that buffer will be erased.
+Otherwise mark and point will be set around the entire contents of the
+buffer so that it is easy to kill the contents of the buffer with \\[kill-region]."
+
+ (interactive)
+
+ (let* ((cvs-buf (current-buffer))
+ (marked (cvs-filter (function cvs-committable)
+ (cvs-get-marked)
+ cvs-buf)))
+ (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-cvs-buffer)
+ (setq cvs-cvs-buffer cvs-buf)
+ (message "Press C-c C-c when you are done editing."))))
+
+
+(defun cvs-edit-done ()
+ "Commit the files to the repository."
+ (interactive)
+ (save-some-buffers)
+ (let ((cc-list cvs-commit-list)
+ (cc-buffer cvs-cvs-buffer)
+ (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...")
+ (cvs-execute-list cc-list cvs-program (list "commit" "-m" msg))
+ (mapcar (function
+ (lambda (tin)
+ (cvs-set-fileinfo->handled (cookie-cookie cc-buffer tin) t)))
+ cc-list)
+ (apply 'cookie-invalidate-tins cc-buffer cc-list)
+ (set-buffer cc-buffer)
+ (if cvs-auto-remove-handled
+ (cvs-remove-handled)))
+
+ (message "Committing... Done."))
+
+
+(defun cvs-execute-list (tin-list program constant-args)
+ "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."
+
+ (while tin-list
+ (let ((current-dir (cvs-fileinfo->dir
+ (cookie-cookie cvs-buffer-name
+ (car tin-list))))
+ arg-list arg-str)
+
+ ;; Collect all marked files in this directory.
+
+ (while (and tin-list
+ (string=
+ current-dir
+ (cvs-fileinfo->dir
+ (cookie-cookie cvs-buffer-name (car tin-list)))))
+ (setq arg-list
+ (cons (cvs-fileinfo->file-name
+ (cookie-cookie cvs-buffer-name (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.
+
+ (setq default-directory (file-name-as-directory current-dir))
+ (insert (format "=== cd %s\n" default-directory))
+ (insert (format "=== %s %s\n\n"
+ program
+ (mapconcat '(lambda (foo) foo)
+ (nconc (copy-sequence constant-args)
+ arg-list)
+ " ")))
+ (apply 'call-process program nil t t
+ (nconc (copy-sequence constant-args) arg-list))
+ (goto-char (point-max)))))
+
+
+(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
+ (cookie-cookie cvs-buffer-name
+ (car tin-list)))))
+ (arg-list
+ (funcall extractor
+ (cookie-cookie cvs-buffer-name (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 '(lambda (foo) foo)
+ (nconc (copy-sequence constant-args)
+ arg-list)
+ " ")))
+ (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-edit-mode ()
+ "\\<cvs-edit-mode-map>Mode for editing cvs log messages.
+Commands:
+\\[cvs-edit-done] checks in the file when you are ready.
+This mode is based on fundamental mode."
+ (interactive)
+ (use-local-map cvs-edit-mode-map)
+ (setq major-mode 'cvs-edit-mode)
+ (setq mode-name "CVS Log")
+ (auto-fill-mode 1))
+
+
+(if cvs-edit-mode-map
+ nil
+ (setq cvs-edit-mode-map (make-sparse-keymap))
+ (define-prefix-command 'cvs-control-c-prefix)
+ (define-key cvs-edit-mode-map "\C-c" 'cvs-control-c-prefix)
+ (define-key cvs-edit-mode-map "\C-c\C-c" 'cvs-edit-done))
+
+
+(defun cvs-diff-cvs ()
+ "Diff the selected files against the repository.
+The flags the variable cvs-cvs-diff-flags will be passed to ``cvs diff''."
+ (interactive)
+
+ (save-some-buffers)
+ (let ((marked (cvs-get-marked)))
+ (cvs-use-temp-buffer)
+ (message "cvsdiffing...")
+ (cvs-execute-list marked cvs-program (cons "diff" cvs-cvs-diff-flags)))
+ (message "cvsdiffing... Done."))
+
+
+(defun cvs-backup-diffable (tin cvs-buf)
+ "Check if the TIN is backup-diffable.
+It must have a backup file to be diffable."
+ (cvs-fileinfo->backup-file (cookie-cookie cvs-buf tin)))
+
+(defun cvs-diff-backup ()
+ "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 cvs-diff-flags will be passed to ``diff''."
+
+ (interactive)
+ (save-some-buffers)
+ (let ((marked (cvs-filter (function cvs-backup-diffable)
+ (cvs-get-marked)
+ (current-buffer))))
+ (if (null marked)
+ (error "No ``Conflict'' or ``Merged'' file selected!"))
+ (cvs-use-temp-buffer)
+ (message "diffing...")
+ (cvs-execute-single-file-list
+ marked 'cvs-diff-backup-extractor cvs-diff-program cvs-diff-flags))
+ (message "diffing... 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."
+ (if (null (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->file-name fileinfo)
+ (cvs-fileinfo->backup-file fileinfo)))
+
+(defun cvs-find-file-other-window (pos)
+ "Select a buffer containing the file in another window.
+Args: POS"
+ (interactive "d")
+ (save-some-buffers)
+ (let* ((cookie-last-tin
+ (cookie-get-selection (current-buffer) pos cookie-last-tin))
+ (type (cvs-fileinfo->type (cookie-cookie (current-buffer)
+ cookie-last-tin))))
+ (cond
+ ((or (eq type 'REMOVED)
+ (eq type 'CVS-REMOVED))
+ (error "Can't visit a removed file."))
+ ((eq type 'DIRCHANGE)
+ (let ((obuf (current-buffer))
+ (odir default-directory))
+ (setq default-directory
+ (file-name-as-directory
+ (cvs-fileinfo->dir
+ (cookie-cookie (current-buffer) cookie-last-tin))))
+ (dired-other-window default-directory)
+ (set-buffer obuf)
+ (setq default-directory odir)))
+ (t
+ (find-file-other-window (cvs-full-path (current-buffer)
+ cookie-last-tin))))))
+
+(defun cvs-full-path (buffer tin)
+ "Return the full path for the file that is described in TIN.
+Args: BUFFER TIN."
+ (concat
+ (file-name-as-directory
+ (cvs-fileinfo->dir (cookie-cookie buffer tin)))
+ (cvs-fileinfo->file-name (cookie-cookie buffer tin))))
+
+(defun cvs-find-file (pos)
+ "Select a buffer containing the file in another window.
+Args: POS"
+ (interactive "d")
+ (let* ((cvs-buf (current-buffer))
+ (cookie-last-tin (cookie-get-selection cvs-buf pos cookie-last-tin))
+ (fileinfo (cookie-cookie cvs-buf cookie-last-tin))
+ (type (cvs-fileinfo->type fileinfo)))
+ (cond
+ ((or (eq type 'REMOVED)
+ (eq type 'CVS-REMOVED))
+ (error "Can't visit a removed file."))
+ ((eq type 'DIRCHANGE)
+ (let ((odir default-directory))
+ (setq default-directory
+ (file-name-as-directory (cvs-fileinfo->dir fileinfo)))
+ (dired default-directory)
+ (set-buffer cvs-buf)
+ (setq default-directory odir)))
+ (t
+ (find-file (cvs-full-path cvs-buf cookie-last-tin))))))
+
+(defun cvs-mark-all-files ()
+ "Mark all files.
+Directories are not marked."
+ (interactive)
+ (cookie-map (function (lambda (cookie)
+ (cond
+ ((not (eq (cvs-fileinfo->type cookie) 'DIRCHANGE))
+ (cvs-set-fileinfo->marked cookie t)
+ t))))
+ (current-buffer)))
+
+
+(defun cvs-unmark (pos)
+ "Unmark a fileinfo. Args: POS."
+ (interactive "d")
+
+ (let* ((tin (cookie-get-selection
+ (current-buffer) pos cookie-last-tin))
+ (sel (cookie-cookie (current-buffer) 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))))
+ (current-buffer)
+ (cvs-fileinfo->dir sel)))
+ (t
+ (cvs-set-fileinfo->marked sel nil)
+ (cookie-invalidate-tins (current-buffer) tin)
+ (cookie-next-cookie (current-buffer) pos 1)))))
+
+(defun cvs-unmark-all-files ()
+ "Unmark all files.
+Directories are also unmarked, but that doesn't matter, since
+they should always be unmarked."
+ (interactive)
+ (cookie-map (function (lambda (cookie)
+ (cvs-set-fileinfo->marked cookie nil)
+ t))
+ (current-buffer)))
+
+
+(defun cvs-do-removal (cvs-buf tins)
+ "Remove files.
+Args: CVS-BUF TINS.
+CVS-BUF is the cvs buffer. 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 (cookie-cookie cvs-buf tin))
+ (type (cvs-fileinfo->type fileinfo)))
+ (if (not (or (eq type 'REMOVED) (eq type 'CVS-REMOVED)))
+ (progn
+ (delete-file (cvs-full-path cvs-buf tin))
+ (cond
+ ((or (eq type 'UNKNOWN) (eq type 'MOVE-AWAY))
+ (cookie-delete cvs-buf tin))
+ (t
+ (setq files-to-remove (cons tin files-to-remove))
+ (cvs-set-fileinfo->type fileinfo 'REMOVED)
+ (cvs-set-fileinfo->handled fileinfo nil)
+ (cookie-invalidate-tins cvs-buf tin))))))
+ (setq tins (cdr tins)))
+ files-to-remove))
+ (t nil)))
+
+
+
+(defun cvs-remove-file ()
+ "Remove all marked files."
+ (interactive)
+ (let ((files-to-remove (cvs-do-removal (current-buffer) (cvs-get-marked))))
+ (if (null files-to-remove)
+ nil
+ (cvs-use-temp-buffer)
+ (message "removing from repository...")
+ (cvs-execute-list files-to-remove cvs-program '("remove"))
+ (message "removing from repository... done."))))
+
+(defun cvs-acknowledge ()
+ "Remove all marked files from the buffer."
+ (interactive)
+
+ (mapcar (function (lambda (tin)
+ (cookie-delete (current-buffer) tin)))
+ (cvs-get-marked))
+ (setq cookie-last-tin nil))
+
+
+(defun cvs-unmark-up (pos)
+ "Unmark the file on the previous line.
+Takes one argument POS, a buffer position."
+ (interactive "d")
+ (cookie-previous-cookie (current-buffer) pos 1)
+ (cvs-set-fileinfo->marked (cookie-cookie (current-buffer) cookie-last-tin)
+ nil)
+ (cookie-invalidate-tins (current-buffer) cookie-last-tin))
+
+(defun cvs-add-file-update-buffer (cvs-buf tin)
+ "Subfunction to cvs-add. Internal use only.
+Update the display. Return non-nil if `cvs add' should be called on this
+file. Args: CVS-BUF TIN.
+Returns 'ADD or 'RESURRECT."
+ (let ((fileinfo (cookie-cookie cvs-buf tin)))
+ (cond
+ ((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN)
+ (cvs-set-fileinfo->type fileinfo 'ADDED)
+ (cookie-invalidate-tins cvs-buf tin)
+ 'ADD)
+ ((eq (cvs-fileinfo->type fileinfo) 'REMOVED)
+ (cvs-set-fileinfo->type fileinfo 'UPDATED)
+ (cvs-set-fileinfo->handled fileinfo t)
+ (cookie-invalidate-tins cvs-buf tin)
+ 'RESURRECT))))
+
+(defun cvs-add-sub (cvs-buf candidates)
+ "Internal use only.
+Args: CVS-BUF CANDIDATES.
+CANDIDATES is a list of tins. Updates the CVS-BUF and returns a 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-update-buffer cvs-buf (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-add ()
+ "Add marked files to the cvs repository."
+ (interactive)
+
+ (let* ((buf (current-buffer))
+ (result (cvs-add-sub buf (cvs-get-marked)))
+ (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...")
+ (cvs-execute-list resurrect cvs-program '("add"))
+ (message "Done.")))
+
+ (cond (added
+ (message "Adding new files to repository...")
+ (cvs-execute-list added cvs-program (list "add" "-m" msg))
+ (message "Done.")))))
+
+(defun cvs-ignore ()
+ "Arrange so that CVS ignores the selected files.
+This command ignores files that are not flagged as `Unknown'."
+ (interactive)
+
+ (mapcar (function (lambda (tin)
+ (cond
+ ((eq (cvs-fileinfo->type
+ (cookie-cookie (current-buffer) tin)) 'UNKNOWN)
+ (cvs-append-to-ignore
+ (cookie-cookie (current-buffer) tin))
+ (cookie-delete (current-buffer) tin)))))
+ (cvs-get-marked))
+ (setq cookie-last-tin nil))
+
+(defun cvs-append-to-ignore (fileinfo)
+ "Append the file in fileinfo to the .cvsignore file"
+ (save-window-excursion
+ (set-buffer (find-file-noselect (concat (file-name-as-directory
+ (cvs-fileinfo->dir fileinfo))
+ ".cvsignore")))
+ (goto-char (point-max))
+ (if (not (zerop (current-column)))
+ (insert "\n"))
+ (insert (cvs-fileinfo->file-name fileinfo) "\n")
+ (save-buffer)))
+
+(defun cvs-status ()
+ "Show cvs status for all marked files."
+ (interactive)
+
+ (save-some-buffers)
+ (let ((marked (cvs-get-marked)))
+ (cvs-use-temp-buffer)
+ (message "Running cvs status ...")
+ (cvs-execute-list marked cvs-program (cons "status" cvs-status-flags)))
+ (message "Running cvs status ... Done."))
+
+(defun cvs-log ()
+ "Display the cvs log of all selected files."
+ (interactive)
+
+ (let ((marked (cvs-get-marked)))
+ (cvs-use-temp-buffer)
+ (message "Running cvs log ...")
+ (cvs-execute-list marked cvs-program (cons "log" cvs-log-flags)))
+ (message "Running cvs log ... Done."))
+
+
+(defun cvs-insert-full-path (tin)
+ "Insert full path to the file described in TIN."
+ (insert (format "%s\n" (cvs-full-path cvs-buffer-name tin))))
+
+
+(defun cvs-add-change-log-entry-other-window (pos)
+ "Add a ChangeLog entry in the ChangeLog of the current directory.
+Args: POS."
+ (interactive "d")
+ (let* ((cvs-buf (current-buffer))
+ (odir default-directory))
+ (setq default-directory
+ (file-name-as-directory
+ (cvs-fileinfo->dir
+ (cookie-cookie
+ cvs-buf
+ (cookie-get-selection cvs-buf pos cookie-last-tin)))))
+ (if (not default-directory) ;In case there was no entries.
+ (setq default-directory odir))
+ (add-change-log-entry-other-window)
+ (set-buffer cvs-buf)
+ (setq default-directory odir)))
+
+
+(defun print-cvs-tin (foo)
+ "Debug utility."
+ (let ((cookie (cookie-cookie (current-buffer) foo))
+ (stream (get-buffer-create "debug")))
+ (princ "==============\n" stream)
+ (princ (cvs-fileinfo->file-name cookie) stream)
+ (princ "\n" stream)
+ (princ (cvs-fileinfo->dir cookie) stream)
+ (princ "\n" stream)
+ (princ (cvs-fileinfo->full-log cookie) stream)
+ (princ "\n" stream)
+ (princ (cvs-fileinfo->marked cookie) stream)
+ (princ "\n" stream)))
OpenPOWER on IntegriCloud