home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / pcl-cvs / pcl-cvs.el < prev    next >
Encoding:
Text File  |  1993-03-14  |  63.5 KB  |  1,871 lines
  1. ;;; Id: pcl-cvs.el,v 1.52.2.3 1992/09/23 20:04:29 ceder Exp 
  2. ;;; pcl-cvs.el -- A Front-end to CVS 1.3 or later.  Release 1.03.1.
  3. ;;; Copyright (C) 1991, 1992  Per Cederqvist
  4. ;;;
  5. ;;; This program is free software; you can redistribute it and/or modify
  6. ;;; it under the terms of the GNU General Public License as published by
  7. ;;; the Free Software Foundation; either version 2 of the License, or
  8. ;;; (at your option) any later version.
  9. ;;;
  10. ;;; This program is distributed in the hope that it will be useful,
  11. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. ;;; GNU General Public License for more details.
  14. ;;;
  15. ;;; You should have received a copy of the GNU General Public License
  16. ;;; along with this program; if not, write to the Free Software
  17. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19. ;;;; See below for installation instructions.
  20. ;;;;
  21. ;;;; There is an TeXinfo file that describes this package.  The GNU
  22. ;;;; General Public License is included in that file.  You should read
  23. ;;;; it to get the most from this package.
  24.  
  25. ;;; Don't try to use this with CVS 1.2 or earlier. It won't work. Get
  26. ;;; CVS 1.3. This package works together with RCS 5.6 and probably 5.5
  27. ;;; as well.
  28.  
  29. ;;; Mail questions and bug reports to ceder@lysator.liu.se.
  30.  
  31. (require 'cookie)
  32. (provide 'pcl-cvs)
  33.  
  34. ;;; -------------------------------------------------------
  35. ;;;        START OF THINGS TO CHECK WHEN INSTALLING
  36.  
  37. (defvar cvs-program "/usr/gnu/bin/cvs"
  38.   "*Full path to the cvs executable.")
  39.  
  40. (defvar cvs-diff-program "/usr/gnu/bin/diff"
  41.   "*Full path to the diff program.")
  42.  
  43. (defvar cvs-rmdir-program "/usr/gnu/bin/rmdir"
  44.   "*Full path to the rmdir program. Typically /bin/rmdir.")
  45.  
  46. ;; Uncomment the following line if you are running on 18.57 or earlier.
  47. ;(setq delete-exited-processes nil)
  48. ;; Emacs version 18.57 and earlier is likely to crash if
  49. ;; delete-exited-processes is t, since the sentinel uses lots of
  50. ;; memory, and 18.57 forgets to GCPROT a variable if
  51. ;; delete-exited-processes is t.
  52.  
  53. (defvar cvs-shell "/bin/sh"
  54.   "*Full path to a shell that can do redirection on stdout.")
  55.  
  56. ;;;         END OF THINGS TO CHECK WHEN INSTALLING
  57. ;;; --------------------------------------------------------
  58.  
  59. (defvar cvs-stdout-file nil
  60.   "Name of the file that holds the output that CVS sends to stdout.
  61. This variable is buffer local.")
  62.  
  63. (defvar cvs-lock-file nil
  64.   "Full path to a lock file that CVS is waiting for (or was waiting for).")
  65.  
  66. (defvar cvs-bakprefix ".#"
  67.   "The prefix that CVS prepends to files when rcsmerge'ing.")
  68.  
  69. (defvar cvs-erase-input-buffer nil
  70.   "*Non-nil if input buffers should be cleared before asking for new info.")
  71.  
  72. (defvar cvs-auto-remove-handled nil
  73.   "*Non-nil if cvs-remove-handled should be called automatically.
  74. If this is set to any non-nil value entries that does not need to be
  75. checked in will be removed from the *cvs* buffer after every cvs-commit
  76. command.")
  77.  
  78. (defconst cvs-cursor-column 14
  79.   "Column to position cursor in in cvs-mode.
  80. Column 0 is left-most column.")
  81.  
  82. (defvar cvs-mode-map nil
  83.   "Keymap for the cvs mode.")
  84.  
  85. (defvar cvs-edit-mode-map nil
  86.   "Keymap for the cvs edit mode (used when editing cvs log messages).")
  87.  
  88. (defvar cvs-buffer-name "*cvs*"
  89.   "Name of the cvs buffer.")
  90.  
  91. (defvar cvs-commit-prompt-buffer "*cvs-commit-message*"
  92.   "Name of buffer in which the user is prompted for a log message when
  93. committing files.")
  94.  
  95. (defvar cvs-temp-buffer-name "*cvs-tmp*"
  96.   "*Name of the cvs temporary buffer.
  97. Output from cvs is placed here by synchronous commands.")
  98.  
  99. (defvar cvs-cvs-diff-flags nil
  100.   "*List of strings to use as flags to pass to ``cvs diff''.
  101. Do not confuse with cvs-diff-flags. Used by cvs-diff-cvs.
  102. Set this to '(\"-u\") to get a Unidiff format, or '(\"-c\") to get context diffs.")
  103.  
  104. (defvar cvs-diff-ignore-marks nil
  105.   "*Non-nil if cvs-diff and cvs-diff-backup should ignore any marked files.
  106. Normally they run diff on the files that are marked (with cvs-mark),
  107. or the file under the cursor if no files are marked.  If this variable
  108. is set to a non-nil value they will always run diff on the file on the
  109. current line.")
  110.  
  111. (defvar cvs-status-flags nil
  112.   "*List of strings to pass to ``cvs status''.")
  113.  
  114. (defvar cvs-log-flags nil
  115.   "*List of strings to pass to ``cvs log''.")
  116.  
  117. (defvar cvs-diff-flags nil
  118.   "*List of strings to use as flags to pass to ``diff''.
  119. Do not confuse with cvs-cvs-diff-flags.  Used by cvs-diff-backup.")
  120.  
  121. (defvar cvs-update-prog-output-skip-regexp "$"
  122.   "*A regexp that matches the end of the output from all cvs update programs.
  123. That is, output from any programs that are run by CVS (by the flag -u
  124. in the `modules' file - see cvs(5)) when `cvs update' is performed should
  125. terminate with a line that this regexp matches.  It is enough that
  126. some part of the line is matched.
  127.  
  128. The default (a single $) fits programs without output.")
  129.  
  130. (defvar cvs-buffers-to-delete nil
  131.   "List of temporary buffers that should be discarded as soon as possible.
  132. Due to a bug in emacs 18.57 the sentinel can't discard them reliably.")
  133.  
  134. ;; You are NOT allowed to disable this message by default.  However, you
  135. ;; are encouraged to inform your users that by adding
  136. ;;    (setq cvs-inhibit-copyright-message t)
  137. ;; to their .emacs they can get rid of it.  Just don't add that line
  138. ;; to your default.el!
  139. (defvar cvs-inhibit-copyright-message nil
  140.   "*Non-nil means don't display a Copyright message in the ``*cvs*'' buffer.")
  141.  
  142. (defconst pcl-cvs-version "1.03.1"
  143.   "A string denoting the current release version of pcl-cvs.")
  144.  
  145. (defvar cvs-startup-message
  146.   (if cvs-inhibit-copyright-message
  147.       "PCL-CVS release 1.03.1"
  148.     "PCL-CVS release 1.03.1.  Copyright (C) 1992 Per Cederqvist
  149. Pcl-cvs comes with absolutely no warranty; for details consult the manual.
  150. This is free software, and you are welcome to redistribute it under certain
  151. conditions; again, consult the TeXinfo manual for details.")
  152.   "*Startup message for CVS.")
  153.  
  154. (defvar cvs-update-running nil
  155.   "This is set to nil when no process is running, and to
  156. the process when a cvs update process is running.")
  157.  
  158. ;;; The cvs data structure:
  159. ;;;
  160. ;;; When the `cvs update' is ready we parse the output. Every file
  161. ;;; that is affected in some way is added as a cookie of fileinfo
  162. ;;; (as defined below).
  163. ;;;
  164.  
  165. ;;; cvs-fileinfo
  166. ;;;
  167. ;;;  marked         t/nil
  168. ;;;  type         One of
  169. ;;;               UPDATED    - file copied from repository
  170. ;;;               MODIFIED   - modified by you, unchanged in
  171. ;;;                    repository
  172. ;;;               ADDED      - added by you, not yet committed
  173. ;;;               REMOVED    - removed by you, not yet committed
  174. ;;;               CVS-REMOVED- removed, since file no longer exists
  175. ;;;                    in the repository.
  176. ;;;               MERGED     - successful merge
  177. ;;;               CONFLICT   - conflict when merging
  178. ;;;               REM-CONFLICT-removed in repository, changed locally.
  179. ;;;               MOD-CONFLICT-removed locally, changed in repository.
  180. ;;;               DIRCHANGE  - A change of directory.
  181. ;;;               UNKNOWN    - An unknown file.
  182. ;;;               MOVE-AWAY  - A file that is in the way.
  183. ;;;               REPOS-MISSING- The directory is removed from the
  184. ;;;                      repository. Go fetch a backup.
  185. ;;;                        MESSAGE    - This is a special fileinfo that is used
  186. ;;;                            to display a text that should be in
  187. ;;;                                       full-log.
  188. ;;;  dir         Directory the file resides in. Should not end with
  189. ;;;             slash.
  190. ;;;  file-name         The file name.
  191. ;;;  backup-file     Name of the backup file if MERGED or CONFLICT.
  192. ;;;  cvs-diff-buffer     A buffer that contains a 'cvs diff file'.
  193. ;;;  backup-diff-buffer     A buffer that contains a 'diff file backup-file'.
  194. ;;;  full-log         The output from cvs, unparsed.
  195. ;;;  mod-time         Modification time of file used for *-diff-buffer.
  196. ;;;  handled         True if this file doesn't require further action.
  197. ;;; 
  198. ;;; Constructor:
  199.  
  200. ;;; cvs-fileinfo
  201.  
  202. ;;; Constructor:
  203.  
  204. (defun cvs-create-fileinfo (type
  205.                 dir
  206.                 file-name
  207.                 full-log)
  208.   "Create a fileinfo from all parameters.
  209. Arguments: TYPE DIR FILE-NAME FULL-LOG.
  210. A fileinfo has the following fields:
  211.  
  212.   marked        t/nil
  213.   type              One of
  214.             UPDATED       - file copied from repository
  215.             MODIFIED   - modified by you, unchanged in
  216.                      repository
  217.             ADDED       - added by you, not yet committed
  218.             REMOVED       - removed by you, not yet committed
  219.             CVS-REMOVED- removed, since file no longer exists
  220.                      in the repository.
  221.             MERGED       - successful merge
  222.             CONFLICT   - conflict when merging
  223.             REM-CONFLICT-removed in repository, but altered
  224.                      locally.
  225.             MOD-CONFLICT-removed locally, changed in repository.
  226.             DIRCHANGE  - A change of directory.
  227.             UNKNOWN       - An unknown file.
  228.             MOVE-AWAY  - A file that is in the way.
  229.             REPOS-MISSING- The directory has vanished from the
  230.                        repository.
  231.                         MESSAGE    - This is a special fileinfo that is used
  232.                          to display a text that should be in
  233.                                        full-log.
  234.   dir              Directory the file resides in. Should not end with slash.
  235.   file-name          The file name.
  236.   backup-file          Name of the backup file if MERGED or CONFLICT.
  237.   cvs-diff-buffer     A buffer that contains a 'cvs diff file'.
  238.   backup-diff-buffer  A buffer that contains a 'diff file backup-file'.
  239.   full-log          The output from cvs, unparsed.
  240.   mod-time          Modification time of file used for *-diff-buffer.
  241.   handled          True if this file doesn't require further action."
  242.   (cons
  243.    'CVS-FILEINFO
  244.    (vector nil nil type dir file-name nil nil nil full-log nil)))
  245.  
  246.  
  247. ;;; Selectors:
  248.  
  249. (defun cvs-fileinfo->handled (cvs-fileinfo)
  250.   "Get the  `handled' field from CVS-FILEINFO."
  251.   (elt (cdr cvs-fileinfo) 0))
  252.  
  253. (defun cvs-fileinfo->marked (cvs-fileinfo)
  254.   "Check if CVS-FILEINFO is marked."
  255.   (elt (cdr cvs-fileinfo) 1))
  256.  
  257. (defun cvs-fileinfo->type (cvs-fileinfo)
  258.   "Get type from CVS-FILEINFO.
  259. Type is one of UPDATED, MODIFIED, ADDED, REMOVED, CVS-REMOVED, MERGED,
  260. CONFLICT, REM-CONFLICT, MOD-CONFLICT, DIRCHANGE, UNKNOWN, MOVE-AWAY,
  261. REPOS-MISSING or MESSAGE."
  262.   (elt (cdr cvs-fileinfo) 2))
  263.  
  264. (defun cvs-fileinfo->dir (cvs-fileinfo)
  265.   "Get dir from CVS-FILEINFO.
  266. The directory name does not end with a slash. "
  267.   (elt (cdr cvs-fileinfo) 3))
  268.  
  269. (defun cvs-fileinfo->file-name (cvs-fileinfo)
  270.   "Get file-name from CVS-FILEINFO."
  271.   (elt (cdr cvs-fileinfo) 4))
  272.  
  273. (defun cvs-fileinfo->backup-file (cvs-fileinfo)
  274.   "Get backup-file from CVS-FILEINFO."
  275.   (elt (cdr cvs-fileinfo) 5))
  276.  
  277. (defun cvs-fileinfo->cvs-diff-buffer (cvs-fileinfo)
  278.   "Get cvs-diff-buffer from CVS-FILEINFO."
  279.   (elt (cdr cvs-fileinfo) 6))
  280.  
  281. (defun cvs-fileinfo->backup-diff-buffer (cvs-fileinfo)
  282.   "Get backup-diff-buffer from CVS-FILEINFO."
  283.   (elt (cdr cvs-fileinfo) 7))
  284.  
  285. (defun cvs-fileinfo->full-log (cvs-fileinfo)
  286.   "Get full-log from CVS-FILEINFO."
  287.   (elt (cdr cvs-fileinfo) 8))
  288.  
  289. (defun cvs-fileinfo->mod-time (cvs-fileinfo)
  290.   "Get mod-time from CVS-FILEINFO."
  291.   (elt (cdr cvs-fileinfo) 9))
  292.  
  293. ;;; Modifiers:
  294.  
  295. (defun cvs-set-fileinfo->handled (cvs-fileinfo newval)
  296.   "Set handled in CVS-FILEINFO to NEWVAL."
  297.   (aset (cdr cvs-fileinfo) 0 newval))
  298.  
  299. (defun cvs-set-fileinfo->marked (cvs-fileinfo newval)
  300.   "Set marked in CVS-FILEINFO to NEWVAL."
  301.   (aset (cdr cvs-fileinfo) 1 newval))
  302.  
  303. (defun cvs-set-fileinfo->type (cvs-fileinfo newval)
  304.   "Set type in CVS-FILEINFO to NEWVAL."
  305.   (aset (cdr cvs-fileinfo) 2 newval))
  306.  
  307. (defun cvs-set-fileinfo->dir (cvs-fileinfo newval)
  308.   "Set dir in CVS-FILEINFO to NEWVAL.
  309. The directory should now end with a slash."
  310.   (aset (cdr cvs-fileinfo) 3 newval))
  311.  
  312. (defun cvs-set-fileinfo->file-name (cvs-fileinfo newval)
  313.   "Set file-name in CVS-FILEINFO to NEWVAL."
  314.   (aset (cdr cvs-fileinfo) 4 newval))
  315.  
  316. (defun cvs-set-fileinfo->backup-file (cvs-fileinfo newval)
  317.   "Set backup-file in CVS-FILEINFO to NEWVAL."
  318.   (aset (cdr cvs-fileinfo) 5 newval))
  319.  
  320. (defun cvs-set-fileinfo->cvs-diff-buffer (cvs-fileinfo newval)
  321.   "Set cvs-diff-buffer in CVS-FILEINFO to NEWVAL."
  322.   (aset (cdr cvs-fileinfo) 6 newval))
  323.  
  324. (defun cvs-set-fileinfo->backup-diff-buffer (cvs-fileinfo newval)
  325.   "Set backup-diff-buffer in CVS-FILEINFO to NEWVAL."
  326.   (aset (cdr cvs-fileinfo) 7 newval))
  327.  
  328. (defun cvs-set-fileinfo->full-log (cvs-fileinfo newval)
  329.   "Set full-log in CVS-FILEINFO to NEWVAL."
  330.   (aset (cdr cvs-fileinfo) 8 newval))
  331.  
  332. (defun cvs-set-fileinfo->mod-time (cvs-fileinfo newval)
  333.   "Set full-log in CVS-FILEINFO to NEWVAL."
  334.   (aset (cdr cvs-fileinfo) 9 newval))
  335.  
  336.  
  337.  
  338. ;;; Predicate:
  339.  
  340. (defun cvs-fileinfo-p (object)
  341.   "Return t if OBJECT is a cvs-fileinfo."
  342.   (eq (car-safe object) 'CVS-FILEINFO))
  343.  
  344. ;;;; End of types.
  345.  
  346. (defun cvs-use-temp-buffer ()
  347.   "Display a temporary buffer in another window and select it.
  348. The selected window will not be changed.  The temporary buffer will
  349. be erased and writable."
  350.  
  351.   (display-buffer (get-buffer-create cvs-temp-buffer-name))
  352.   (set-buffer cvs-temp-buffer-name)
  353.   (setq buffer-read-only nil)
  354.   (erase-buffer))
  355.  
  356. ; Too complicated to handle all the cases that are generated.
  357. ; Maybe later.
  358. ;(defun cvs-examine (directory &optional local)
  359. ;  "Run a 'cvs -n update' in the current working directory.
  360. ;That is, check what needs to be done, but don't change the disc.
  361. ;Feed the output to a *cvs* buffer and run cvs-mode on it.
  362. ;If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run."
  363. ;  (interactive (list (read-file-name "CVS Update (directory): "
  364. ;                     nil default-directory nil)
  365. ;             current-prefix-arg))
  366. ;  (cvs-do-update directory local 'noupdate))
  367.  
  368. (defun cvs-update (directory &optional local)
  369.   "Run a 'cvs update' in the current working directory. Feed the
  370. output to a *cvs* buffer and run cvs-mode on it.
  371. If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run."
  372.   (interactive (list (read-file-name "CVS Update (directory): "
  373.                      nil default-directory nil)
  374.              current-prefix-arg))
  375.   (cvs-do-update directory local nil)
  376.   (switch-to-buffer cvs-buffer-name))
  377.  
  378. (defun cvs-update-other-window (directory &optional local)
  379.   "Run a 'cvs update' in the current working directory. Feed the
  380. output to a *cvs* buffer, display it in the other window, and run
  381. cvs-mode on it.
  382.  
  383. If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run."
  384.   (interactive (list (read-file-name "CVS Update other window (directory): "
  385.                      nil default-directory nil)
  386.              current-prefix-arg))
  387.   (cvs-do-update directory local nil)
  388.   (switch-to-buffer-other-window cvs-buffer-name))
  389.  
  390. (defun cvs-filter (predicate list &rest extra-args)
  391.   "Apply PREDICATE to each element on LIST.
  392. Args: PREDICATE LIST &rest EXTRA-ARGS.
  393. Return a new list consisting of those elements that PREDICATE
  394. returns non-nil for.
  395.  
  396. If more than two arguments are given the remaining args are
  397. passed to PREDICATE."
  398.   ;; Avoid recursion - this should work for LONG lists also!
  399.   (let* ((head (cons 'dummy-header nil))
  400.      (tail head))
  401.     (while list
  402.       (if (apply predicate (car list) extra-args)
  403.       (setq tail (setcdr tail (list (car list)))))
  404.       (setq list (cdr list)))
  405.     (cdr head)))
  406.  
  407. (defun cvs-update-no-prompt ()
  408.   "Run cvs update in current directory."
  409.   (interactive)
  410.   (cvs-do-update default-directory nil nil))
  411.  
  412. (defun cvs-do-update (directory local dont-change-disc)
  413.   "Do a 'cvs update' in DIRECTORY.
  414. Args: DIRECTORY LOCAL DONT-CHANGE-DISC &optional NOTTHISWINDOW.
  415. If LOCAL is non-nil 'cvs update -l' is executed.
  416. If DONT-CHANGE-DISC is non-nil 'cvs -n update' is executed.
  417. Both LOCAL and DONT-CHANGE-DISC may be non-nil simultaneously.
  418.  
  419. *Note*: DONT-CHANGE-DISC does not yet work. The parser gets confused."
  420.   (save-some-buffers)
  421.   (if (not (file-exists-p cvs-program))
  422.       (error "%s: file not found (check setting of cvs-program)"
  423.          cvs-program))
  424.   (if (not (getenv "CVSROOT"))
  425.       (error "You must set the CVSROOT environment variable \
  426. before starting emacs."))
  427.   (let* ((this-dir (file-name-as-directory (expand-file-name directory)))
  428.      (update-buffer (generate-new-buffer
  429.              (concat (file-name-nondirectory
  430.                   (substring this-dir 0 -1))
  431.                  "-update")))
  432.      (temp-name (make-temp-name
  433.              (concat (file-name-as-directory
  434.                   (or (getenv "TMPDIR") "/tmp"))
  435.                  "pcl-cvs.")))
  436.      (args nil))
  437.  
  438.     ;; Check that this-dir exists and is a directory that is under CVS contr.
  439.  
  440.     (if (not (file-directory-p this-dir))
  441.     (error "%s is not a directory." this-dir))
  442.     (if (not (file-directory-p (concat this-dir "CVS")))
  443.     (error "%s does not contain CVS controlled files." this-dir))
  444.  
  445.     ;; Check that at most one `cvs update' is run at any time.
  446.  
  447.     (if (and cvs-update-running (process-status cvs-update-running)
  448.          (or (eq (process-status cvs-update-running) 'run)
  449.          (eq (process-status cvs-update-running) 'stop)))
  450.     (error "Can't run two `cvs update' simultaneously."))
  451.  
  452.     ;; Generate "-n update -l".
  453.     (setq args (concat (if dont-change-disc " -n ")
  454.                " update "
  455.                (if local " -l ")))
  456.  
  457.     ;; Set up the buffer that receives the output from "cvs update".
  458.     (set-buffer update-buffer)
  459.     (setq default-directory this-dir)
  460.     (make-local-variable 'cvs-stdout-file)
  461.     (setq cvs-stdout-file temp-name)
  462.  
  463.     (setq cvs-update-running
  464.       (let ((process-connection-type nil)) ; Use a pipe, not a pty.
  465.         (start-process "cvs" update-buffer cvs-shell "-c"
  466.                (concat cvs-program " " args " > " temp-name))))
  467.  
  468.     (setq mode-line-process
  469.       (concat ": "
  470.           (symbol-name (process-status cvs-update-running))))
  471.     (set-buffer-modified-p (buffer-modified-p))    ; Update the mode line.
  472.     (set-process-sentinel cvs-update-running 'cvs-sentinel)
  473.     (set-process-filter cvs-update-running 'cvs-update-filter)
  474.     (set-marker (process-mark cvs-update-running) (point-min))
  475.  
  476.     (cookie-create
  477.      cvs-buffer-name 'cvs-pp
  478.      cvs-startup-message    ;Se comment above cvs-startup-message.
  479.      "---------- End -----")
  480.  
  481.     (cookie-enter-first
  482.      cvs-buffer-name
  483.      (cvs-create-fileinfo
  484.       'MESSAGE nil nil (concat "\n    Running `cvs " args "' in " this-dir
  485.                    "...\n")))
  486.  
  487.     ;; Work around a bug in emacs 18.57 and earlier.
  488.     (setq cvs-buffers-to-delete
  489.       (cvs-delete-unused-temporary-buffers cvs-buffers-to-delete))))
  490.  
  491.  
  492. (defun cvs-delete-unused-temporary-buffers (list)
  493.   "Delete all buffers on LIST that is not visible.
  494. Return a list of all buffers that still is alive."
  495.  
  496.   (cond
  497.    ((null list) nil)
  498.    ((get-buffer-window (car list))
  499.     (cons (car list)
  500.       (cvs-delete-unused-temporary-buffers (cdr list))))
  501.    (t
  502.     (kill-buffer (car list))
  503.     (cvs-delete-unused-temporary-buffers (cdr list)))))
  504.  
  505.  
  506. (put 'cvs-mode 'mode-class 'special)
  507.  
  508. (defun cvs-mode ()
  509.   "\\<cvs-mode-map>Mode used for pcl-cvs, a frontend to CVS.
  510.  
  511. To get the *cvs* buffer you should use ``\\[cvs-update]''.
  512.  
  513. Full documentation is in the TeXinfo file.  These are the most useful commands:
  514.  
  515. \\[cookie-previous-cookie] Move up.                    \\[cookie-next-cookie] Move down.
  516. \\[cvs-commit]   Commit file.                \\[cvs-update-no-prompt]   Reupdate directory.
  517. \\[cvs-mark]   Mark file/dir.              \\[cvs-unmark]   Unmark file/dir.
  518. \\[cvs-mark-all-files]   Mark all files.             \\[cvs-unmark-all-files]   Unmark all files.
  519. \\[cvs-find-file]   Edit file/run Dired.        \\[cvs-find-file-other-window]   Find file or run Dired in other window.
  520. \\[cvs-remove-handled]   Remove processed entries.   \\[cvs-add-change-log-entry-other-window]   Write ChangeLog in other window.
  521. \\[cvs-add]   Add to repository.          \\[cvs-remove-file]   Remove file.
  522. \\[cvs-diff-cvs]   Diff between base revision. \\[cvs-diff-backup]   Diff backup file.
  523. \\[cvs-acknowledge] Delete line from buffer.    \\[cvs-ignore]   Add file to the .cvsignore file.
  524. \\[cvs-log]   Run ``cvs log''.            \\[cvs-status]   Run ``cvs status''.
  525.  
  526. Entry to this mode runs cvs-mode-hook.
  527. This description is updated for release 1.03.1 of pcl-cvs.
  528. All bindings:
  529. \\{cvs-mode-map}"
  530.   (interactive)
  531.   (setq major-mode 'cvs-mode)
  532.   (setq mode-name "CVS")
  533.   (buffer-flush-undo (current-buffer))
  534.   (make-local-variable 'goal-column)
  535.   (setq goal-column cvs-cursor-column)
  536.   (use-local-map cvs-mode-map)
  537.   (run-hooks 'cvs-mode-hook))
  538.  
  539. (defun cvs-sentinel (proc msg)
  540.   "Sentinel for the cvs update process.
  541. This is responsible for parsing the output from the cvs update when
  542. it is finished."
  543.   (cond
  544.    ((null (buffer-name (process-buffer proc)))
  545.     ;; buffer killed
  546.     (set-process-buffer proc nil))
  547.    ((memq (process-status proc) '(signal exit))
  548.     (let* ((obuf (current-buffer))
  549.        (omax (point-max))
  550.        (opoint (point)))
  551.       ;; save-excursion isn't the right thing if
  552.       ;;  process-buffer is current-buffer
  553.       (unwind-protect
  554.       (progn
  555.         (set-buffer (process-buffer proc))
  556.         (setq mode-line-process
  557.           (concat ": "
  558.               (symbol-name (process-status proc))))
  559.         (let* ((out-file cvs-stdout-file)
  560.            (stdout-buffer (find-file-noselect out-file)))
  561.           (cvs-parse-update stdout-buffer (process-buffer proc))
  562.           (setq cvs-buffers-to-delete
  563.             (cons (process-buffer proc)
  564.               (cons stdout-buffer
  565.                 cvs-buffers-to-delete)))
  566.           (delete-file out-file)))
  567.     (set-buffer-modified-p (buffer-modified-p))
  568.     (setq cvs-update-running nil))
  569.       (if (equal obuf (process-buffer proc))
  570.       nil
  571.     (set-buffer (process-buffer proc))
  572.     (if (< opoint omax)
  573.         (goto-char opoint))
  574.     (set-buffer obuf))))))
  575.  
  576. (defun cvs-update-filter (proc string)
  577.   "Filter function for pcl-cvs.
  578. This function gets the output that CVS sends to stderr. It inserts it
  579. into (process-buffer proc) but it also checks if CVS is waiting for a
  580. lock file. If so, it inserts a message cookie in the *cvs* buffer."
  581.   (let ((old-buffer (current-buffer))
  582.     (data (match-data)))
  583.     (unwind-protect
  584.     (progn
  585.            (set-buffer (process-buffer proc))
  586.            (save-excursion
  587.              ;; Insert the text, moving the process-marker.
  588.              (goto-char (process-mark proc))
  589.              (insert string)
  590.              (set-marker (process-mark proc) (point))
  591.         ;; Delete any old lock message
  592.         (if (tin-nth cvs-buffer-name 1)
  593.         (tin-delete cvs-buffer-name
  594.                 (tin-nth cvs-buffer-name 1)))
  595.         ;; Check if CVS is waiting for a lock.
  596.         (beginning-of-line 0)    ;Move to beginning of last
  597.                     ;complete line.
  598.         (cond
  599.          ((looking-at
  600.            "^cvs update: \\[..:..:..\\] waiting \
  601. for \\(.*\\)lock in \\(.*\\)$")
  602.           (setq cvs-lock-file (buffer-substring (match-beginning 2)
  603.                             (match-end 2)))
  604.           (cookie-enter-last
  605.            cvs-buffer-name
  606.            (cvs-create-fileinfo
  607.         'MESSAGE nil nil
  608.         (concat "\tWaiting for "
  609.             (buffer-substring (match-beginning 1)
  610.                       (match-end 1))
  611.             "lock in " cvs-lock-file
  612.             ".\n\t (type M-x cvs-delete-lock to delete it)")))))))
  613.       (store-match-data data)
  614.       (set-buffer old-buffer))))
  615.  
  616. (defun cvs-delete-lock ()
  617.   "Delete the lock file that CVS is waiting for.
  618. Note that this can be dangerous.  You should only do this
  619. if you are convinced that the process that created the lock is dead."
  620.   (interactive)
  621.   (cond
  622.    ((not (or (file-exists-p
  623.           (concat (file-name-as-directory cvs-lock-file) "#cvs.lock"))
  624.          (cvs-filter (function cvs-lock-file-p)
  625.              (directory-files cvs-lock-file))))
  626.     (error "No lock files found."))
  627.    ((yes-or-no-p (concat "Really delete locks in " cvs-lock-file "? "))
  628.     ;; Re-read the directory -- the locks might have disappeared.
  629.     (let ((locks (cvs-filter (function cvs-lock-file-p)
  630.                  (directory-files cvs-lock-file))))
  631.       (while locks
  632.     (delete-file (concat (file-name-as-directory cvs-lock-file)
  633.                  (car locks)))
  634.     (setq locks (cdr locks)))
  635.       (cvs-remove-directory
  636.        (concat (file-name-as-directory cvs-lock-file) "#cvs.lock"))))))
  637.  
  638. (defun cvs-remove-directory (dir)
  639.   "Remove a directory."
  640.   (if (file-directory-p dir)
  641.       (call-process cvs-rmdir-program nil nil nil dir)
  642.     (error "Not a directory: %s" dir))
  643.   (if (file-exists-p dir)
  644.       (error "Could not remove directory %s" dir)))
  645.  
  646. (defun cvs-lock-file-p (file)
  647.   "Return true if FILE looks like a CVS lock file."
  648.   (or
  649.    (string-match "^#cvs.tfl.[0-9]+$" file)
  650.    (string-match "^#cvs.rfl.[0-9]+$" file)
  651.    (string-match "^#cvs.wfl.[0-9]+$" file)))
  652.  
  653. (defun cvs-skip-line (stdout stderr regexp &optional arg)
  654.   "Like forward-line, but check that the skipped line matches REGEXP.
  655. Args: STDOUT STDERR REGEXP &optional ARG.
  656.  
  657. If it doesn't match REGEXP a bug report is generated and displayed.
  658. STDOUT and STDERR is only used to do that.
  659.  
  660. If optional ARG, a number, is given the ARGth parenthesized expression
  661. in the REGEXP is returned as a string.
  662. Point should be in column 1 when this function is called."
  663.   (cond
  664.    ((looking-at regexp)
  665.     (forward-line 1)
  666.     (if arg
  667.     (buffer-substring (match-beginning arg)
  668.               (match-end arg))))
  669.    (t
  670.     (cvs-parse-error stdout stderr
  671.              (if (eq (current-buffer) stdout) 'STDOUT 'STDERR)
  672.              (point)))))
  673.  
  674. (defun cvs-get-current-dir (root-dir dirname)
  675.   "Return current working directory, suitable for cvs-parse-update.
  676. Args: ROOT-DIR DIRNAME.
  677. Concatenates ROOT-DIR and DIRNAME to form an absolute path."
  678.   (if (string= "." dirname)
  679.       (substring root-dir 0 -1)
  680.     (concat root-dir dirname)))
  681.  
  682. (defun cvs-compare-fileinfos (a b)
  683.   "Compare fileinfo A with fileinfo B and return t if A is `less'."
  684.   (cond
  685.    ;; Sort acording to directories.
  686.    ((string< (cvs-fileinfo->dir a) (cvs-fileinfo->dir b)) t)
  687.    ((not (string= (cvs-fileinfo->dir a) (cvs-fileinfo->dir b))) nil)
  688.    
  689.    ;; The DIRCHANGE entry is always first within the directory.
  690.    ((and (eq (cvs-fileinfo->type a) 'DIRCHANGE)
  691.      (not (eq (cvs-fileinfo->type b) 'DIRCHANGE))) t)
  692.    ((and (eq (cvs-fileinfo->type b) 'DIRCHANGE)
  693.      (not (eq (cvs-fileinfo->type a) 'DIRCHANGE))) nil)
  694.    ;; All files are sorted by file name.
  695.    ((string< (cvs-fileinfo->file-name a) (cvs-fileinfo->file-name b)))))
  696.  
  697. (defun cvs-parse-error (stdout-buffer stderr-buffer err-buf pos)
  698.   "Handle a parse error when parsing the output from cvs.
  699. Args: STDOUT-BUFFER STDERR-BUFFER ERR-BUF POS.
  700. ERR-BUF should be 'STDOUT or 'STDERR."
  701.   (setq pos (1- pos))
  702.   (set-buffer cvs-buffer-name)
  703.   (setq buffer-read-only nil)
  704.   (erase-buffer)
  705.   (insert "To: ceder@lysator.liu.se\n")
  706.   (insert "Subject: pcl-cvs " pcl-cvs-version " parse error.\n")
  707.   (insert "--text follows this line--\n\n")
  708.   (insert "This bug report is automatically generated by pcl-cvs\n")
  709.   (insert "because it doesn't understand some output from CVS.  Below\n")
  710.   (insert "is detailed information about the error.  Please send\n")
  711.   (insert "this, together with any information you think might be\n")
  712.   (insert "useful for me to fix the bug, to the address above.  But\n")
  713.   (insert "please check the \"known problems\" section of the\n")
  714.   (insert "documentation first.  Note that this buffer contains\n")
  715.   (insert "information that you might consider confidential.  You\n")
  716.   (insert "are encouraged to read through it before sending it.\n")
  717.   (insert "\n")
  718.   (insert "Press C-c C-c to send this email.\n\n")
  719.   (insert "Please state the version of these programs you are using:\n")
  720.   (insert "RCS:  \ndiff: \n\n")
  721.  
  722.   (let* ((stdout (save-excursion (set-buffer stdout-buffer) (buffer-string)))
  723.      (stderr (save-excursion (set-buffer stderr-buffer) (buffer-string)))
  724.      (errstr (if (eq err-buf 'STDOUT) stdout stderr))
  725.      (errline-end (string-match "\n" errstr pos))
  726.      (errline (substring errstr pos errline-end)))
  727.     (insert (format "Offending line (%d chars): >" (- errline-end pos)))
  728.     (insert errline)
  729.     (insert "<\n")
  730.     (insert "Sent to " (symbol-name err-buf) " at pos " (format "%d\n" pos))
  731.     (insert "Emacs-version: " (emacs-version) "\n")
  732.     (insert "Pcl-cvs $" "Id:" "$" ": " "Id: pcl-cvs.el,v 1.52.2.3 1992/09/23 20:04:29 ceder Exp \n")
  733.     (insert "\n")
  734.     (insert (format "--- Contents of stdout buffer (%d chars) ---\n"
  735.             (length stdout)))
  736.     (insert stdout)
  737.     (insert "--- End of stdout buffer ---\n")
  738.     (insert (format "--- Contents of stderr buffer (%d chars) ---\n"
  739.             (length stderr)))
  740.     (insert stderr)
  741.     (insert "--- End of stderr buffer ---\n")
  742.     (insert "End of bug report.\n")
  743.     (require 'sendmail)
  744.     (mail-mode)
  745.     (error "CVS parse error - please report this bug.")))
  746.       
  747. (defun cvs-parse-update (stdout-buffer stderr-buffer)
  748.   "Parse the output from `cvs update'.
  749.  
  750. Args: STDOUT-BUFFER STDERR-BUFFER.
  751.  
  752. This functions parses the from `cvs update' (which should be
  753. separated in its stdout- and stderr-components) and prints a
  754. pretty representation of it in the *cvs* buffer.
  755.  
  756. Signals an error if unexpected output was detected in the buffer."
  757.   (let* ((head (cons 'dummy nil))
  758.      (tail (cvs-parse-stderr stdout-buffer stderr-buffer
  759.                  head default-directory))
  760.      (buf (get-buffer cvs-buffer-name))
  761.      (root-dir default-directory))
  762.     (cvs-parse-stdout stdout-buffer stderr-buffer tail root-dir)
  763.     (setq head (sort (cdr head) (function cvs-compare-fileinfos)))
  764.  
  765.     (cookie-create
  766.      buf 'cvs-pp cvs-startup-message    ;Se comment above cvs-startup-message.
  767.      "---------- End -----")
  768.  
  769.     (cookie-enter-cookies buf head)
  770.     (cvs-remove-stdout-shadows buf)
  771.     (cvs-remove-empty-directories buf)
  772.     (set-buffer buf)
  773.     (cvs-mode)
  774.     (setq cookie-last-tin (tin-nth buf 0))
  775.     (goto-char (point-min))
  776.     (cookie-previous-cookie buf (point-min) 1)
  777.     (setq default-directory root-dir)))
  778.  
  779. (defun cvs-remove-stdout-shadows (buffer)
  780.   "Remove entries in the *cvs* BUFFER that comes from both stdout and stderr.
  781. If there is two entries for a single file the second one should be
  782. deleted. (Remember that sort uses a stable sort algorithm, so one can
  783. be sure that the stderr entry is always first)."
  784.   (tin-filter buffer
  785.           (function
  786.            (lambda (tin)
  787.          (not (cvs-shadow-entry-p (current-buffer) tin))))))
  788.  
  789. (defun cvs-shadow-entry-p (cvs-buf tin)
  790.   "Return non-nil if TIN is a shadow entry.
  791. Args: CVS-BUF TIN.
  792. A TIN is a shadow entry if the previous tin contains the same file."
  793.   (let* ((previous-tin (tin-previous cvs-buf tin))
  794.      (curr (cookie-cookie cvs-buf tin))
  795.      (prev (and previous-tin (cookie-cookie cvs-buf previous-tin))))
  796.     (and
  797.      prev curr
  798.      (string= (cvs-fileinfo->file-name prev) (cvs-fileinfo->file-name curr))
  799.      (string= (cvs-fileinfo->dir prev)       (cvs-fileinfo->dir curr))
  800.      (or
  801.       (and (eq (cvs-fileinfo->type prev) 'CONFLICT)
  802.        (eq (cvs-fileinfo->type curr) 'CONFLICT))
  803.       (and (eq (cvs-fileinfo->type prev) 'MERGED)
  804.        (eq (cvs-fileinfo->type curr) 'MODIFIED))))))
  805.  
  806.  
  807. (defun cvs-parse-stderr (stdout-buffer stderr-buffer head dir)
  808.   "Parse the output from CVS that is written to stderr.
  809. Args: STDOUT-BUFFER STDERR-BUFFER HEAD DIR
  810. STDOUT-BUFFER holds the output that cvs sent to stdout. It is only
  811. used to create a bug report in case there is a parse error.
  812. STDERR-BUFFER is the buffer that holds the output to parse.
  813. HEAD is a cons-cell, the head of the list that is built.
  814. DIR is the directory the `cvs update' was run in.
  815.  
  816. This function returns the last cons-cell in the list that is built."
  817.  
  818.   (save-window-excursion
  819.     (set-buffer stderr-buffer)
  820.     (goto-char (point-min))
  821.     (let ((current-dir dir)
  822.       (root-dir dir))
  823.  
  824.       (while (< (point) (point-max))
  825.     (cond
  826.  
  827.      ;; CVS is descending a subdirectory.
  828.      
  829.      ((looking-at "cvs update: Updating \\(.*\\)$")
  830.       (setq current-dir
  831.         (cvs-get-current-dir
  832.          root-dir
  833.          (buffer-substring (match-beginning 1) (match-end 1))))
  834.       (setcdr head (list (cvs-create-fileinfo
  835.                   'DIRCHANGE current-dir
  836.                   nil (buffer-substring (match-beginning 0)
  837.                             (match-end 0)))))
  838.       (setq head (cdr head))
  839.       (forward-line 1))
  840.  
  841.      ;; File removed, since it is removed (by third party) in repository.
  842.        
  843.      ((or (looking-at
  844.            "cvs update: warning: \\(.*\\) is not (any longer) pertinent")
  845.           (looking-at
  846.            "cvs update: \\(.*\\) is no longer in the repository"))
  847.  
  848.       (setcdr head (list (cvs-create-fileinfo
  849.                   'CVS-REMOVED current-dir
  850.                   (file-name-nondirectory
  851.                    (buffer-substring (match-beginning 1)
  852.                          (match-end 1)))
  853.                   (buffer-substring (match-beginning 0)
  854.                         (match-end 0)))))
  855.       (setq head (cdr head))
  856.       (forward-line 1))
  857.  
  858.      ;; File removed by you, but recreated by cvs. Ignored.
  859.  
  860.      ((looking-at "cvs update: warning: .* was lost$")
  861.       (forward-line 1))
  862.  
  863.      ;; A file that has been created by you, but added to the cvs
  864.      ;; repository by another.
  865.  
  866.      ((looking-at "^cvs update: move away \\(.*\\); it is in the way$")
  867.       (setcdr head (list (cvs-create-fileinfo
  868.                   'MOVE-AWAY current-dir
  869.                   (file-name-nondirectory
  870.                    (buffer-substring (match-beginning 1)
  871.                          (match-end 1)))
  872.                   (buffer-substring (match-beginning 0)
  873.                         (match-end 0)))))
  874.       (setq head (cdr head))
  875.       (forward-line 1))
  876.  
  877.      ;; Empty line. Probably inserted by mistake by user (or developer :-)
  878.      ;; Ignore.
  879.  
  880.      ((looking-at "^$")
  881.       (forward-line 1))
  882.  
  883.      ;; Cvs waits for a lock. Ignore.
  884.  
  885.      ((looking-at
  886.        "^cvs update: \\[..:..:..\\] waiting for .*lock in ")
  887.       (forward-line 1))
  888.  
  889.      ;; File removed in repository, but edited by you.
  890.  
  891.      ((looking-at
  892.        "cvs update: conflict: \\(.*\\) is modified but no longer \
  893. in the repository$")
  894.       (setcdr head (list
  895.             (cvs-create-fileinfo
  896.              'REM-CONFLICT current-dir
  897.              (file-name-nondirectory
  898.               (buffer-substring (match-beginning 1) (match-end 1)))
  899.              (buffer-substring (match-beginning 0)
  900.                        (match-end 0)))))
  901.       (setq head (cdr head))
  902.       (forward-line 1))
  903.  
  904.      ((looking-at
  905.        "cvs update: conflict: removed \\(.*\\) was modified by \
  906. second party")
  907.       (setcdr head
  908.           (list
  909.            (cvs-create-fileinfo
  910.             'MOD-CONFLICT current-dir
  911.             (buffer-substring (match-beginning 1) (match-end 1))
  912.             (buffer-substring (match-beginning 0) (match-end 0)))))
  913.       (setq head (cdr head))
  914.       (forward-line 1))
  915.  
  916.      ((looking-at "cvs update: in directory ")
  917.       (let ((start (point)))
  918.         (forward-line 1)
  919.         (cvs-skip-line
  920.          stdout-buffer stderr-buffer
  921.          (regexp-quote "cvs [update aborted]: there is no repository "))
  922.         (setcdr head (list
  923.               (cvs-create-fileinfo
  924.                'REPOS-MISSING current-dir
  925.                nil
  926.                (buffer-substring start (point)))))
  927.         (setq head (cdr head))))
  928.  
  929.        (t
  930.  
  931.     ;; CVS has decided to merge someone elses changes into this
  932.     ;; document. This leads to a lot of garbage being printed.
  933.     ;; First there is two lines that contains no information
  934.     ;; that we skip (but we check that we recognize them).
  935.  
  936.     (let ((complex-start (point))
  937.           initial-revision filename)
  938.  
  939.       (cvs-skip-line stdout-buffer stderr-buffer "^RCS file: .*$")
  940.       (setq initial-revision
  941.         (cvs-skip-line stdout-buffer stderr-buffer
  942.                    "^retrieving revision \\(.*\\)$" 1))
  943.       (cvs-skip-line stdout-buffer stderr-buffer "^retrieving revision .*$")
  944.  
  945.       ;; Get the file name from the next line.
  946.  
  947.       (setq
  948.        filename
  949.        (cvs-skip-line
  950.         stdout-buffer stderr-buffer
  951.         "^Merging differences between [0-9.]+ and [0-9.]+ into \\(.*\\)$"
  952.         1))
  953.  
  954.       (cond
  955.        ;; Was it a conflict?
  956.        ((looking-at
  957.          ;; Allow both RCS 5.5 and 5.6. (5.6 prints "rcs" and " warning").
  958.          "^\\(rcs\\)?merge\\( warning\\)?: overlaps during merge$")
  959.  
  960.         ;; Yes, this is a conflict.
  961.         (cvs-skip-line
  962.          stdout-buffer stderr-buffer
  963.          "^\\(rcs\\)?merge\\( warning\\)?: overlaps during merge$")
  964.  
  965.         (cvs-skip-line stdout-buffer stderr-buffer
  966.                "^cvs update: conflicts found in ")
  967.  
  968.         (let ((fileinfo
  969.            (cvs-create-fileinfo
  970.             'CONFLICT current-dir
  971.             filename
  972.             (buffer-substring complex-start (point)))))
  973.  
  974.           (cvs-set-fileinfo->backup-file
  975.            fileinfo
  976.            (concat cvs-bakprefix filename "." initial-revision))
  977.  
  978.           (setcdr head (list fileinfo))
  979.           (setq head (cdr head))))
  980.  
  981.        ;; Was it a conflict, and was RCS compiled without DIFF3_BIN?
  982.  
  983.        ((looking-at
  984.          ;; Allow both RCS 5.5 and 5.6. (5.6 prints "rcs" and " warning").
  985.          "^\\(rcs\\)?merge\\( warning\\)?: overlaps or other probl\
  986. ems during merge$")
  987.  
  988.         ;; Yes, this is a conflict.
  989.         (cvs-skip-line
  990.          stdout-buffer stderr-buffer
  991.          "^\\(rcs\\)?merge\\( warning\\)?: overlaps .*during merge$")
  992.  
  993.         (cvs-skip-line stdout-buffer stderr-buffer
  994.                "^cvs update: could not merge ")
  995.         (cvs-skip-line stdout-buffer stderr-buffer
  996.                "^cvs update: restoring .* from backup file ")
  997.  
  998.         (let ((fileinfo
  999.            (cvs-create-fileinfo
  1000.             'CONFLICT current-dir
  1001.             filename
  1002.             (buffer-substring complex-start (point)))))
  1003.  
  1004.           (setcdr head (list fileinfo))
  1005.           (setq head (cdr head))))       
  1006.  
  1007.        (t
  1008.         ;; Not a conflict; it must be a succesful merge.
  1009.         (let ((fileinfo
  1010.            (cvs-create-fileinfo
  1011.             'MERGED current-dir
  1012.             filename
  1013.             (buffer-substring complex-start (point)))))
  1014.           (cvs-set-fileinfo->backup-file
  1015.            fileinfo
  1016.            (concat cvs-bakprefix filename "." initial-revision))
  1017.           (setcdr head (list fileinfo))
  1018.           (setq head (cdr head)))))))))))
  1019.   head)
  1020.  
  1021.  
  1022. (defun cvs-parse-stdout (stdout-buffer stderr-buffer head root-dir)
  1023.   "Parse the output from CVS that is written to stderr.
  1024. Args: STDOUT-BUFFER STDERR-BUFFER HEAD ROOT-DIR
  1025. STDOUT-BUFFER is the buffer that holds the output to parse.
  1026. STDERR-BUFFER holds the output that cvs sent to stderr. It is only
  1027. used to create a bug report in case there is a parse error.
  1028.  
  1029. HEAD is a cons-cell, the head of the list that is built.
  1030. ROOT-DIR is the directory the `cvs update' was run in.
  1031.  
  1032. This function doesn't return anything particular."
  1033.   (save-window-excursion
  1034.     (set-buffer stdout-buffer)
  1035.     (goto-char (point-min))
  1036.     (while (< (point) (point-max))
  1037.       (cond
  1038.  
  1039.        ;; M: The file is modified by the user, and untouched in the repository.
  1040.        ;; A: The file is "cvs add"ed, but not "cvs ci"ed.
  1041.        ;; R: The file is "cvs remove"ed, but not "cvs ci"ed.
  1042.        ;; C: Conflict
  1043.        ;; U: The file is copied from the repository.
  1044.        ;; ?: Unknown file.
  1045.  
  1046.  
  1047.        ((looking-at "\\([MARCU?]\\) \\(.*\\)$")
  1048.     (let*
  1049.         ((c         (char-after (match-beginning 1)))
  1050.          (full-path
  1051.           (concat (file-name-as-directory root-dir)
  1052.               (buffer-substring (match-beginning 2) (match-end 2))))
  1053.          (fileinfo (cvs-create-fileinfo
  1054.             (cond ((eq c ?M) 'MODIFIED)
  1055.                   ((eq c ?A) 'ADDED)
  1056.                   ((eq c ?R) 'REMOVED)
  1057.                   ((eq c ?C) 'CONFLICT)
  1058.                   ((eq c ?U) 'UPDATED)
  1059.                   ((eq c ??) 'UNKNOWN))
  1060.             (substring (file-name-directory full-path) 0 -1)
  1061.             (file-name-nondirectory full-path)
  1062.             (buffer-substring (match-beginning 0) (match-end 0)))))
  1063.       ;; Updated files require no further action.
  1064.       (if (eq c ?U)
  1065.           (cvs-set-fileinfo->handled fileinfo t))
  1066.  
  1067.       ;; Link this last on the list.
  1068.       (setcdr head (list fileinfo))
  1069.       (setq head (cdr head))
  1070.       (forward-line 1)))
  1071.  
  1072.        ;; Executing a program because of the -u option in modules.
  1073.        ((looking-at "cvs update: Executing")
  1074.     ;; Skip by any output the program may generate to stdout.
  1075.     ;; Note that pcl-cvs will get seriously confused if the
  1076.     ;; program prints anything to stderr.
  1077.     (re-search-forward cvs-update-prog-output-skip-regexp)
  1078.     (forward-line 1))
  1079.  
  1080.        (t (cvs-parse-error stdout-buffer stderr-buffer 'STDOUT (point)))))))
  1081.  
  1082. (defun cvs-pp (fileinfo)
  1083.   "Pretty print FILEINFO into a string."
  1084.  
  1085.   (let ((a (cvs-fileinfo->type fileinfo))
  1086.         (s (if (cvs-fileinfo->marked fileinfo)
  1087.                "*" " "))
  1088.         (f (cvs-fileinfo->file-name fileinfo))
  1089.         (ci (if (cvs-fileinfo->handled fileinfo)
  1090.                 "  " "ci")))
  1091.     (cond
  1092.      ((eq a 'UPDATED)
  1093.       (format "%s Updated     %s" s f))
  1094.      ((eq a 'MODIFIED)
  1095.       (format "%s Modified %s %s" s ci f))
  1096.      ((eq a 'MERGED)
  1097.       (format "%s Merged   %s %s" s ci f))
  1098.      ((eq a 'CONFLICT)
  1099.       (format "%s Conflict    %s" s f))
  1100.      ((eq a 'ADDED)
  1101.       (format "%s Added    %s %s" s ci f))
  1102.      ((eq a 'REMOVED)
  1103.       (format "%s Removed  %s %s" s ci f))
  1104.      ((eq a 'UNKNOWN)
  1105.       (format "%s Unknown     %s" s f))
  1106.      ((eq a 'CVS-REMOVED)
  1107.       (format "%s Removed from repository:  %s" s f))
  1108.      ((eq a 'REM-CONFLICT)
  1109.       (format "%s Conflict: Removed from repository, changed by you: %s" s f))
  1110.      ((eq a 'MOD-CONFLICT)
  1111.       (format "%s Conflict: Removed by you, changed in repository: %s" s f))
  1112.      ((eq a 'DIRCHANGE)
  1113.       (format "\nIn directory %s:"
  1114.               (cvs-fileinfo->dir fileinfo)))
  1115.      ((eq a 'MOVE-AWAY)
  1116.       (format "%s Move away %s - it is in the way" s f))
  1117.      ((eq a 'REPOS-MISSING)
  1118.       (format "  This repository is missing! Remove this dir manually."))
  1119.      ((eq a 'MESSAGE)
  1120.       (cvs-fileinfo->full-log fileinfo))
  1121.      (t
  1122.       (format "%s Internal error! %s" s f)))))
  1123.  
  1124.  
  1125. ;;; You can define your own keymap in .emacs. pcl-cvs.el won't overwrite it.
  1126.  
  1127. (if cvs-mode-map
  1128.     nil
  1129.   (setq cvs-mode-map (make-keymap))
  1130.   (suppress-keymap cvs-mode-map)
  1131.   (define-key cvs-mode-map " "    'cookie-next-cookie)
  1132.   (define-key cvs-mode-map "?"    'describe-mode)
  1133.   (define-key cvs-mode-map "A"    'cvs-add-change-log-entry-other-window)
  1134.   (define-key cvs-mode-map "M"    'cvs-mark-all-files)
  1135.   (define-key cvs-mode-map "U"    'cvs-undo-local-changes)
  1136.   (define-key cvs-mode-map "\C-?"  'cvs-unmark-up)
  1137.   (define-key cvs-mode-map "\C-k"  'cvs-acknowledge)
  1138.   (define-key cvs-mode-map "\C-n"  'cookie-next-cookie)
  1139.   (define-key cvs-mode-map "\C-p"  'cookie-previous-cookie)
  1140.   (define-key cvs-mode-map "\M-\C-?" 'cvs-unmark-all-files)
  1141.   (define-key cvs-mode-map "a"    'cvs-add)
  1142.   (define-key cvs-mode-map "b"    'cvs-diff-backup)
  1143.   (define-key cvs-mode-map "c"    'cvs-commit)
  1144.   (define-key cvs-mode-map "d"    'cvs-diff-cvs)
  1145.   (define-key cvs-mode-map "e"    'cvs-find-file)
  1146.   (define-key cvs-mode-map "f"    'cvs-find-file)
  1147.   (define-key cvs-mode-map "g"    'cvs-update-no-prompt)
  1148.   (define-key cvs-mode-map "i"    'cvs-ignore)
  1149.   (define-key cvs-mode-map "l"    'cvs-log)
  1150.   (define-key cvs-mode-map "m"    'cvs-mark)
  1151.   (define-key cvs-mode-map "n"    'cookie-next-cookie)
  1152.   (define-key cvs-mode-map "o"    'cvs-find-file-other-window)
  1153.   (define-key cvs-mode-map "p"    'cookie-previous-cookie)
  1154.   (define-key cvs-mode-map "r"    'cvs-remove-file)
  1155.   (define-key cvs-mode-map "s"    'cvs-status)
  1156.   (define-key cvs-mode-map "x"    'cvs-remove-handled)
  1157.   (define-key cvs-mode-map "u"    'cvs-unmark))
  1158.  
  1159.  
  1160. (defun cvs-get-marked (&optional ignore-marks)
  1161.   "Return a list of all selected tins.
  1162. If there are any marked tins, and IGNORE-MARKS is nil, return them.
  1163. Otherwise, if the cursor selects a directory, return all files in it.
  1164. Otherwise return (a list containing) the file the cursor points to, or
  1165. an empty list if it doesn't point to a file at all.
  1166.  
  1167. Args: &optional IGNORE-MARKS."
  1168.     
  1169.   (cond
  1170.    ;; Any marked cookies?
  1171.    ((and (not ignore-marks)
  1172.      (tin-collect (current-buffer)
  1173.               'cvs-fileinfo->marked)))
  1174.    ;; Nope.
  1175.    (t
  1176.     (let ((sel (tin-get-selection
  1177.         (current-buffer) (point) cookie-last-tin)))
  1178.       (cond
  1179.        ;; If a directory is selected, all it members are returned.
  1180.        ((and sel (eq (cvs-fileinfo->type
  1181.             (cookie-cookie (current-buffer) sel))
  1182.                'DIRCHANGE))
  1183.     (tin-collect
  1184.      (current-buffer) 'cvs-dir-member-p
  1185.      (cvs-fileinfo->dir (cookie-cookie (current-buffer) sel))))
  1186.        (t
  1187.     (list sel)))))))
  1188.  
  1189.  
  1190. (defun cvs-dir-member-p (fileinfo dir)
  1191.   "Return true if FILEINFO represents a file in directory DIR."
  1192.   (and (not (eq (cvs-fileinfo->type fileinfo) 'DIRCHANGE))
  1193.        (string= (cvs-fileinfo->dir fileinfo) dir)))
  1194.  
  1195. (defun cvs-dir-empty-p (cvs-buf tin)
  1196.   "Return non-nil if TIN is a directory that is empty.
  1197. Args: CVS-BUF TIN."
  1198.   (and (eq (cvs-fileinfo->type (cookie-cookie cvs-buf tin)) 'DIRCHANGE)
  1199.        (or (not (tin-next cvs-buf tin))
  1200.        (eq (cvs-fileinfo->type (cookie-cookie cvs-buf
  1201.                           (tin-next cvs-buf tin)))
  1202.            'DIRCHANGE))))
  1203.  
  1204. (defun cvs-remove-handled ()
  1205.   "Remove all lines that are handled.
  1206. Empty directories are removed."
  1207.   (interactive)
  1208.   ;; Pass one: remove files that are handled.
  1209.   (cookie-filter (current-buffer)
  1210.          (function
  1211.           (lambda (fileinfo) (not (cvs-fileinfo->handled fileinfo)))))
  1212.   ;; Pass two: remove empty directories.
  1213.   (cvs-remove-empty-directories (current-buffer)))
  1214.  
  1215.  
  1216. (defun cvs-remove-empty-directories (buffer)
  1217.   "Remove empty directories in the *cvs* BUFFER."
  1218.   (tin-filter buffer
  1219.           (function
  1220.            (lambda (tin)
  1221.          (not (cvs-dir-empty-p (current-buffer) tin))))))
  1222.  
  1223. (defun cvs-mark (pos)
  1224.   "Mark a fileinfo. Args: POS.
  1225. If the fileinfo is a directory, all the contents of that directory are
  1226. marked instead. A directory can never be marked.
  1227. POS is a buffer position."
  1228.  
  1229.   (interactive "d")
  1230.  
  1231.   (let* ((tin (tin-get-selection
  1232.            (current-buffer) pos cookie-last-tin))
  1233.      (sel (cookie-cookie (current-buffer) tin)))
  1234.  
  1235.     (cond
  1236.      ;; Does POS point to a directory? If so, mark all files in that directory.
  1237.      ((eq (cvs-fileinfo->type sel) 'DIRCHANGE)
  1238.       (cookie-map
  1239.        (function (lambda (f dir)
  1240.            (cond
  1241.             ((cvs-dir-member-p f dir)
  1242.              (cvs-set-fileinfo->marked f t)
  1243.              t))))        ;Tell cookie to redisplay this cookie.
  1244.        (current-buffer)
  1245.        (cvs-fileinfo->dir sel)))
  1246.      (t
  1247.       (cvs-set-fileinfo->marked sel t)
  1248.       (tin-invalidate-tins (current-buffer) tin)
  1249.       (cookie-next-cookie (current-buffer) pos 1)))))
  1250.   
  1251.  
  1252. (defun cvs-committable (tin cvs-buf)
  1253.   "Check if the TIN is committable.
  1254. It is committable if it
  1255.    a) is not handled and
  1256.    b) is either MODIFIED, ADDED, REMOVED, MERGED or CONFLICT."
  1257.   (let* ((fileinfo (cookie-cookie cvs-buf tin))
  1258.      (type (cvs-fileinfo->type fileinfo)))
  1259.     (and (not (cvs-fileinfo->handled fileinfo))
  1260.      (or (eq type 'MODIFIED)
  1261.          (eq type 'ADDED)
  1262.          (eq type 'REMOVED)
  1263.          (eq type 'MERGED)
  1264.          (eq type 'CONFLICT)))))
  1265.  
  1266. (defun cvs-commit ()
  1267.  
  1268.   "Check in all marked files, or the current file.
  1269. The user will be asked for a log message in a buffer.
  1270. If cvs-erase-input-buffer is non-nil that buffer will be erased.
  1271. Otherwise mark and point will be set around the entire contents of the
  1272. buffer so that it is easy to kill the contents of the buffer with \\[kill-region]."
  1273.  
  1274.   (interactive)
  1275.  
  1276.   (let* ((cvs-buf (current-buffer))
  1277.      (marked (cvs-filter (function cvs-committable)
  1278.                  (cvs-get-marked)
  1279.                  cvs-buf)))
  1280.     (if (null marked)
  1281.     (error "Nothing to commit!")
  1282.       (pop-to-buffer (get-buffer-create cvs-commit-prompt-buffer))
  1283.       (goto-char (point-min))
  1284.  
  1285.       (if cvs-erase-input-buffer
  1286.       (erase-buffer)
  1287.     (push-mark (point-max)))
  1288.       (cvs-edit-mode)
  1289.       (make-local-variable 'cvs-commit-list)
  1290.       (setq cvs-commit-list marked)
  1291.       (message "Press C-c C-c when you are done editing."))))
  1292.  
  1293.  
  1294. (defun cvs-edit-done ()
  1295.   "Commit the files to the repository."
  1296.   (interactive)
  1297.   (save-some-buffers)
  1298.   (let ((cc-list cvs-commit-list)
  1299.     (cc-buffer (get-buffer cvs-buffer-name))
  1300.     (msg-buffer (current-buffer))
  1301.     (msg (buffer-substring (point-min) (point-max))))
  1302.     (pop-to-buffer cc-buffer)
  1303.     (bury-buffer msg-buffer)
  1304.     (cvs-use-temp-buffer)
  1305.     (message "Committing...")
  1306.     (cvs-execute-list cc-list cvs-program (list "commit" "-m" msg))
  1307.     (mapcar (function
  1308.          (lambda (tin)
  1309.            (cvs-set-fileinfo->handled (cookie-cookie cc-buffer tin) t)))
  1310.         cc-list)
  1311.     (apply 'tin-invalidate-tins cc-buffer cc-list)
  1312.     (set-buffer cc-buffer)
  1313.     (if cvs-auto-remove-handled
  1314.     (cvs-remove-handled)))
  1315.   
  1316.   (message "Committing... Done."))
  1317.  
  1318.  
  1319. (defun cvs-execute-list (tin-list program constant-args)
  1320.   "Run PROGRAM on all elements on TIN-LIST.
  1321. Args: TIN-LIST PROGRAM CONSTANT-ARGS
  1322. The PROGRAM will be called with pwd set to the directory the
  1323. files reside in. CONSTANT-ARGS should be a list of strings. The
  1324. arguments given to the program will be CONSTANT-ARGS followed by all
  1325. the files (from TIN-LIST) that resides in that directory. If the files
  1326. in TIN-LIST resides in different directories the PROGRAM will be run
  1327. once for each directory (if all files in the same directory appears
  1328. after each other)."
  1329.              
  1330.     (while tin-list
  1331.       (let ((current-dir (cvs-fileinfo->dir
  1332.               (cookie-cookie cvs-buffer-name
  1333.                      (car tin-list))))
  1334.         arg-list arg-str)
  1335.  
  1336.     ;; Collect all marked files in this directory.
  1337.  
  1338.     (while (and tin-list
  1339.             (string=
  1340.              current-dir
  1341.              (cvs-fileinfo->dir
  1342.               (cookie-cookie cvs-buffer-name (car tin-list)))))
  1343.       (setq arg-list
  1344.         (cons (cvs-fileinfo->file-name
  1345.                (cookie-cookie cvs-buffer-name (car tin-list)))
  1346.               arg-list))
  1347.       (setq tin-list (cdr tin-list)))
  1348.  
  1349.     (setq arg-list (nreverse arg-list))
  1350.  
  1351.     ;; Execute the command on all the files that were collected.
  1352.  
  1353.     (setq default-directory (file-name-as-directory current-dir))
  1354.     (insert (format "=== cd %s\n" default-directory))
  1355.     (insert (format "=== %s %s\n\n"
  1356.             program
  1357.             (mapconcat '(lambda (foo) foo)
  1358.                    (nconc (copy-sequence constant-args)
  1359.                       arg-list)
  1360.                    " ")))
  1361.     (apply 'call-process program nil t t
  1362.            (nconc (copy-sequence constant-args) arg-list))
  1363.     (goto-char (point-max)))))
  1364.  
  1365.  
  1366. (defun cvs-execute-single-file-list (tin-list extractor program constant-args)
  1367.   "Run PROGRAM on all elements on TIN-LIST.
  1368.  
  1369. Args: TIN-LIST EXTRACTOR PROGRAM CONSTANT-ARGS
  1370.  
  1371. The PROGRAM will be called with pwd set to the directory the files
  1372. reside in.  CONSTANT-ARGS is a list of strings to pass as arguments to
  1373. PROGRAM.  The arguments given to the program will be CONSTANT-ARGS
  1374. followed by the list that EXTRACTOR returns.
  1375.  
  1376. EXTRACTOR will be called once for each file on TIN-LIST.  It is given
  1377. one argument, the cvs-fileinfo.  It can return t, which means ignore
  1378. this file, or a list of arguments to send to the program."
  1379.  
  1380.     (while tin-list
  1381.       (let ((default-directory (file-name-as-directory
  1382.                 (cvs-fileinfo->dir
  1383.                  (cookie-cookie cvs-buffer-name
  1384.                         (car tin-list)))))
  1385.         (arg-list
  1386.          (funcall extractor
  1387.               (cookie-cookie cvs-buffer-name (car tin-list)))))
  1388.  
  1389.     ;; Execute the command unless extractor returned t.
  1390.  
  1391.     (if (eq arg-list t)
  1392.         nil
  1393.       (insert (format "=== cd %s\n" default-directory))
  1394.       (insert (format "=== %s %s\n\n"
  1395.               program
  1396.               (mapconcat '(lambda (foo) foo)
  1397.                      (nconc (copy-sequence constant-args)
  1398.                         arg-list)
  1399.                      " ")))
  1400.       (apply 'call-process program nil t t
  1401.          (nconc (copy-sequence constant-args) arg-list))
  1402.       (goto-char (point-max))))
  1403.       (setq tin-list (cdr tin-list))))
  1404.  
  1405.  
  1406. (defun cvs-edit-mode ()
  1407.   "\\<cvs-edit-mode-map>Mode for editing cvs log messages.
  1408. Commands:
  1409. \\[cvs-edit-done] checks in the file when you are ready.
  1410. This mode is based on fundamental mode."
  1411.   (interactive)
  1412.   (use-local-map cvs-edit-mode-map)
  1413.   (setq major-mode 'cvs-edit-mode)
  1414.   (setq mode-name "CVS Log")
  1415.   (auto-fill-mode 1))
  1416.  
  1417.  
  1418. (if cvs-edit-mode-map
  1419.     nil
  1420.   (setq cvs-edit-mode-map (make-sparse-keymap))
  1421.   (define-prefix-command 'cvs-control-c-prefix)
  1422.   (define-key cvs-edit-mode-map "\C-c" 'cvs-control-c-prefix)
  1423.   (define-key cvs-edit-mode-map "\C-c\C-c" 'cvs-edit-done))
  1424.  
  1425.  
  1426. (defun cvs-diff-cvs (&optional ignore-marks)
  1427.   "Diff the selected files against the repository.
  1428. The flags the variable cvs-cvs-diff-flags will be passed to ``cvs diff''.
  1429. If the variable cvs-diff-ignore-marks is non-nil any marked files will
  1430. not be considered to be selected.  An optional prefix argument will
  1431. invert the influence from cvs-diff-ignore-marks."
  1432.  
  1433.   (interactive "P")
  1434.  
  1435.   (if (not (listp cvs-cvs-diff-flags))
  1436.       (error "cvs-cvs-diff-flags should be a list of strings"))
  1437.  
  1438.   (save-some-buffers)
  1439.   (let ((marked (cvs-get-marked
  1440.          (or (and ignore-marks (not cvs-diff-ignore-marks))
  1441.              (and (not ignore-marks) cvs-diff-ignore-marks)))))
  1442.     (cvs-use-temp-buffer)
  1443.     (message "cvsdiffing...")
  1444.     (cvs-execute-list marked cvs-program (cons "diff" cvs-cvs-diff-flags)))
  1445.   (message "cvsdiffing... Done."))
  1446.  
  1447.  
  1448. (defun cvs-backup-diffable (tin cvs-buf)
  1449.   "Check if the TIN is backup-diffable.
  1450. It must have a backup file to be diffable."
  1451.   (cvs-fileinfo->backup-file (cookie-cookie cvs-buf tin)))
  1452.  
  1453. (defun cvs-diff-backup (&optional ignore-marks)
  1454.   "Diff the files against the backup file.
  1455. This command can be used on files that are marked with \"Merged\"
  1456. or \"Conflict\" in the *cvs* buffer.
  1457.  
  1458. If the variable cvs-diff-ignore-marks is non-nil any marked files will
  1459. not be considered to be selected.  An optional prefix argument will
  1460. invert the influence from cvs-diff-ignore-marks.
  1461.  
  1462. The flags in cvs-diff-flags will be passed to ``diff''."
  1463.  
  1464.   (interactive "P")
  1465.  
  1466.   (if (not (listp cvs-diff-flags))
  1467.       (error "cvs-diff-flags should be a list of strings."))
  1468.  
  1469.   (save-some-buffers)
  1470.   (let ((marked (cvs-filter
  1471.          (function cvs-backup-diffable)
  1472.          (cvs-get-marked
  1473.           (or
  1474.            (and ignore-marks (not cvs-diff-ignore-marks))
  1475.            (and (not ignore-marks) cvs-diff-ignore-marks)))
  1476.          (current-buffer))))
  1477.     (if (null marked)
  1478.     (error "No ``Conflict'' or ``Merged'' file selected!"))
  1479.     (cvs-use-temp-buffer)
  1480.     (message "diffing...")
  1481.     (cvs-execute-single-file-list
  1482.      marked 'cvs-diff-backup-extractor cvs-diff-program cvs-diff-flags))
  1483.   (message "diffing... Done."))
  1484.  
  1485.  
  1486. (defun cvs-diff-backup-extractor (fileinfo)
  1487.   "Return the filename and the name of the backup file as a list.
  1488. Signal an error if there is no backup file."
  1489.   (if (null (cvs-fileinfo->backup-file fileinfo))
  1490.       (error "%s has no backup file."
  1491.          (concat
  1492.           (file-name-as-directory (cvs-fileinfo->dir fileinfo))
  1493.           (cvs-fileinfo->file-name fileinfo))))
  1494.   (list (cvs-fileinfo->file-name fileinfo)
  1495.     (cvs-fileinfo->backup-file fileinfo)))
  1496.  
  1497. (defun cvs-find-file-other-window (pos)
  1498.   "Select a buffer containing the file in another window.
  1499. Args: POS"
  1500.   (interactive "d")
  1501.   (let ((cookie-last-tin
  1502.      (tin-get-selection (current-buffer) pos cookie-last-tin)))
  1503.     (if cookie-last-tin
  1504.     (let ((type (cvs-fileinfo->type (cookie-cookie (current-buffer)
  1505.                                cookie-last-tin))))
  1506.       (cond
  1507.        ((or (eq type 'REMOVED)
  1508.         (eq type 'CVS-REMOVED))
  1509.         (error "Can't visit a removed file."))
  1510.        ((eq type 'DIRCHANGE)
  1511.         (let ((obuf (current-buffer))
  1512.           (odir default-directory))
  1513.           (setq default-directory
  1514.             (file-name-as-directory
  1515.              (cvs-fileinfo->dir
  1516.               (cookie-cookie (current-buffer) cookie-last-tin))))
  1517.           (dired-other-window default-directory)
  1518.           (set-buffer obuf)
  1519.           (setq default-directory odir)))
  1520.        (t
  1521.         (find-file-other-window (cvs-full-path (current-buffer)
  1522.                            cookie-last-tin)))))
  1523.       (error "There is no file to find."))))
  1524.  
  1525. (defun cvs-full-path (buffer tin)
  1526.   "Return the full path for the file that is described in TIN.
  1527. Args: BUFFER TIN."
  1528.   (concat
  1529.    (file-name-as-directory
  1530.     (cvs-fileinfo->dir (cookie-cookie buffer tin)))
  1531.    (cvs-fileinfo->file-name (cookie-cookie buffer tin))))
  1532.  
  1533. (defun cvs-find-file (pos)
  1534.   "Select a buffer containing the file in another window.
  1535. Args: POS"
  1536.   (interactive "d")
  1537.   (let* ((cvs-buf (current-buffer))
  1538.      (cookie-last-tin (tin-get-selection cvs-buf pos cookie-last-tin)))
  1539.     (if cookie-last-tin
  1540.     (let* ((fileinfo (cookie-cookie cvs-buf cookie-last-tin))
  1541.            (type (cvs-fileinfo->type fileinfo)))
  1542.       (cond
  1543.        ((or (eq type 'REMOVED)
  1544.         (eq type 'CVS-REMOVED))
  1545.         (error "Can't visit a removed file."))
  1546.        ((eq type 'DIRCHANGE)
  1547.         (let ((odir default-directory))
  1548.           (setq default-directory
  1549.             (file-name-as-directory (cvs-fileinfo->dir fileinfo)))
  1550.           (dired default-directory)
  1551.           (set-buffer cvs-buf)
  1552.           (setq default-directory odir))) 
  1553.        (t
  1554.         (find-file (cvs-full-path cvs-buf cookie-last-tin)))))
  1555.       (error "There is no file to find."))))
  1556.  
  1557. (defun cvs-mark-all-files ()
  1558.   "Mark all files.
  1559. Directories are not marked."
  1560.   (interactive)
  1561.   (cookie-map (function (lambda (cookie)
  1562.               (cond
  1563.                ((not (eq (cvs-fileinfo->type cookie) 'DIRCHANGE))
  1564.                 (cvs-set-fileinfo->marked cookie t)
  1565.                 t))))
  1566.           (current-buffer)))
  1567.  
  1568.  
  1569. (defun cvs-unmark (pos)
  1570.   "Unmark a fileinfo. Args: POS."
  1571.   (interactive "d")
  1572.  
  1573.   (let* ((tin (tin-get-selection (current-buffer) pos cookie-last-tin))
  1574.      (sel (cookie-cookie (current-buffer) tin)))
  1575.  
  1576.     (cond
  1577.      ((eq (cvs-fileinfo->type sel) 'DIRCHANGE)
  1578.       (cookie-map
  1579.        (function (lambda (f dir)
  1580.            (cond
  1581.             ((cvs-dir-member-p f dir)
  1582.              (cvs-set-fileinfo->marked f nil)
  1583.              t))))
  1584.        (current-buffer)
  1585.        (cvs-fileinfo->dir sel)))
  1586.      (t
  1587.       (cvs-set-fileinfo->marked sel nil)
  1588.       (tin-invalidate-tins (current-buffer) tin)
  1589.       (cookie-next-cookie (current-buffer) pos 1)))))
  1590.  
  1591. (defun cvs-unmark-all-files ()
  1592.   "Unmark all files.
  1593. Directories are also unmarked, but that doesn't matter, since
  1594. they should always be unmarked."
  1595.   (interactive)
  1596.   (cookie-map (function (lambda (cookie)
  1597.               (cvs-set-fileinfo->marked cookie nil)
  1598.               t))
  1599.           (current-buffer)))
  1600.  
  1601.  
  1602. (defun cvs-do-removal (cvs-buf tins)
  1603.   "Remove files.
  1604. Args: CVS-BUF TINS.
  1605. CVS-BUF is the *cvs* buffer. TINS is a list of tins that the
  1606. user wants to delete. The files are deleted. If the type of
  1607. the tin is 'UNKNOWN the tin is removed from the buffer. If it
  1608. is anything else the file is added to a list that should be
  1609. `cvs remove'd and the tin is changed to be of type 'REMOVED.
  1610.  
  1611. Returns a list of tins files that should be `cvs remove'd."
  1612.   (cvs-use-temp-buffer)
  1613.   (mapcar 'cvs-insert-full-path tins)
  1614.   (cond
  1615.    ((and tins (yes-or-no-p (format "Delete %d files? " (length tins))))
  1616.     (let (files-to-remove)
  1617.       (while tins
  1618.     (let* ((tin (car tins))
  1619.            (fileinfo (cookie-cookie cvs-buf tin))
  1620.            (type (cvs-fileinfo->type fileinfo)))
  1621.       (if (not (or (eq type 'REMOVED) (eq type 'CVS-REMOVED)))
  1622.           (progn
  1623.         (delete-file (cvs-full-path cvs-buf tin))
  1624.         (cond
  1625.          ((or (eq type 'UNKNOWN) (eq type 'MOVE-AWAY))
  1626.           (tin-delete cvs-buf tin))
  1627.          (t
  1628.           (setq files-to-remove (cons tin files-to-remove))
  1629.           (cvs-set-fileinfo->type fileinfo 'REMOVED)
  1630.           (cvs-set-fileinfo->handled fileinfo nil)
  1631.           (tin-invalidate-tins cvs-buf tin))))))
  1632.     (setq tins (cdr tins)))
  1633.       files-to-remove))
  1634.    (t nil)))
  1635.  
  1636.  
  1637.  
  1638. (defun cvs-remove-file ()
  1639.   "Remove all marked files."
  1640.   (interactive)
  1641.   (let ((files-to-remove (cvs-do-removal (current-buffer) (cvs-get-marked))))
  1642.     (if (null files-to-remove)
  1643.     nil
  1644.       (cvs-use-temp-buffer)
  1645.       (message "removing from repository...")
  1646.       (cvs-execute-list files-to-remove cvs-program '("remove"))
  1647.       (message "removing from repository... done."))))
  1648.  
  1649. (defun cvs-undo-local-changes ()
  1650.   "Undo local changes to all marked files.
  1651. The file is removed and `cvs update FILE' is run."
  1652.   (interactive)
  1653.   (let ((tins-to-undo (cvs-get-marked)))
  1654.     (cvs-use-temp-buffer)
  1655.     (mapcar 'cvs-insert-full-path tins-to-undo)
  1656.     (cond
  1657.      ((and tins-to-undo (yes-or-no-p (format "Undo changes to %d files? "
  1658.                          (length tins-to-undo))))
  1659.       (let (files-to-update)
  1660.     (while tins-to-undo
  1661.       (let* ((tin (car tins-to-undo))
  1662.          (fileinfo (cookie-cookie cvs-buffer-name tin))
  1663.          (type (cvs-fileinfo->type fileinfo)))
  1664.         (cond
  1665.          ((or
  1666.            (eq type 'UPDATED) (eq type 'MODIFIED) (eq type 'MERGED)
  1667.            (eq type 'CONFLICT) (eq type 'CVS-REMOVED)
  1668.            (eq type 'REM-CONFLICT) (eq type 'MOVE-AWAY)
  1669.            (eq type 'REMOVED))
  1670.           (if (not (eq type 'REMOVED))
  1671.           (delete-file (cvs-full-path cvs-buffer-name tin)))
  1672.           (setq files-to-update (cons tin files-to-update))
  1673.           (cvs-set-fileinfo->type fileinfo 'UPDATED)
  1674.           (cvs-set-fileinfo->handled fileinfo t)
  1675.           (tin-invalidate-tins cvs-buffer-name tin))
  1676.  
  1677.          ((eq type 'MOD-CONFLICT)
  1678.           (error "Use cvs-add instead on %s."
  1679.              (cvs-fileinfo->file-name fileinfo)))
  1680.  
  1681.          ((eq type 'DIRCHANGE)
  1682.           (error "Undo on directories not supported (yet)."))
  1683.  
  1684.          ((eq type 'ADDED)
  1685.           (error "There is no old revision to get for %s"
  1686.              (cvs-fileinfo->file-name fileinfo))))
  1687.  
  1688.         (setq tins-to-undo (cdr tins-to-undo))))
  1689.     (cvs-use-temp-buffer)
  1690.     (message "Regetting files from repository...")
  1691.     (cvs-execute-list files-to-update cvs-program '("update"))
  1692.     (message "Regetting files from repository... done."))))))
  1693.  
  1694. (defun cvs-acknowledge ()
  1695.   "Remove all marked files from the buffer."
  1696.   (interactive)
  1697.  
  1698.   (mapcar (function (lambda (tin)
  1699.               (tin-delete (current-buffer) tin)))
  1700.       (cvs-get-marked))
  1701.   (setq cookie-last-tin nil))
  1702.  
  1703.  
  1704. (defun cvs-unmark-up (pos)
  1705.   "Unmark the file on the previous line.
  1706. Takes one argument POS, a buffer position."
  1707.   (interactive "d")
  1708.   (cookie-previous-cookie (current-buffer) pos 1)
  1709.   (cvs-set-fileinfo->marked (cookie-cookie (current-buffer) cookie-last-tin)
  1710.                 nil)
  1711.   (tin-invalidate-tins (current-buffer) cookie-last-tin))
  1712.  
  1713. (defun cvs-add-file-update-buffer (cvs-buf tin)
  1714.   "Subfunction to cvs-add. Internal use only.
  1715. Update the display. Return non-nil if `cvs add' should be called on this
  1716. file. Args: CVS-BUF TIN.
  1717. Returns 'ADD or 'RESURRECT."
  1718.   (let ((fileinfo (cookie-cookie cvs-buf tin)))
  1719.     (cond
  1720.      ((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN)
  1721.       (cvs-set-fileinfo->type fileinfo 'ADDED)
  1722.       (tin-invalidate-tins cvs-buf tin)
  1723.       'ADD)
  1724.      ((eq (cvs-fileinfo->type fileinfo) 'REMOVED)
  1725.       (cvs-set-fileinfo->type fileinfo 'UPDATED)
  1726.       (cvs-set-fileinfo->handled fileinfo t)
  1727.       (tin-invalidate-tins cvs-buf tin)
  1728.       'RESURRECT))))
  1729.  
  1730. (defun cvs-add-sub (cvs-buf candidates)
  1731.   "Internal use only.
  1732. Args: CVS-BUF CANDIDATES.
  1733. CANDIDATES is a list of tins. Updates the CVS-BUF and returns a pair of lists.
  1734. The first list is unknown tins that shall be `cvs add -m msg'ed.
  1735. The second list is removed files that shall be `cvs add'ed (resurrected)."
  1736.   (let (add resurrect)
  1737.     (while candidates
  1738.       (let ((type (cvs-add-file-update-buffer cvs-buf (car candidates))))
  1739.     (cond ((eq type 'ADD)
  1740.            (setq add (cons (car candidates) add)))
  1741.           ((eq type 'RESURRECT)
  1742.            (setq resurrect (cons (car candidates) resurrect)))))
  1743.       (setq candidates (cdr candidates)))
  1744.     (cons add resurrect)))
  1745.  
  1746. (defun cvs-add ()
  1747.   "Add marked files to the cvs repository."
  1748.   (interactive)
  1749.  
  1750.   (let* ((buf (current-buffer))
  1751.      (result (cvs-add-sub buf (cvs-get-marked)))
  1752.      (added (car result))
  1753.      (resurrect (cdr result))
  1754.      (msg (if added (read-from-minibuffer "Enter description: "))))
  1755.  
  1756.     (if (or resurrect added)
  1757.     (cvs-use-temp-buffer))
  1758.  
  1759.     (cond (resurrect
  1760.        (message "Resurrecting files from repository...")
  1761.        (cvs-execute-list resurrect cvs-program '("add"))
  1762.        (message "Done.")))
  1763.  
  1764.     (cond (added
  1765.        (message "Adding new files to repository...")
  1766.        (cvs-execute-list added cvs-program (list "add" "-m" msg))
  1767.        (message "Done.")))))
  1768.  
  1769. (defun cvs-ignore ()
  1770.   "Arrange so that CVS ignores the selected files.
  1771. This command ignores files that are not flagged as `Unknown'."
  1772.   (interactive)
  1773.  
  1774.   (mapcar (function (lambda (tin)
  1775.               (cond
  1776.                ((eq (cvs-fileinfo->type
  1777.                  (cookie-cookie (current-buffer) tin)) 'UNKNOWN)
  1778.             (cvs-append-to-ignore
  1779.              (cookie-cookie (current-buffer) tin))
  1780.             (tin-delete (current-buffer) tin)))))
  1781.       (cvs-get-marked))
  1782.   (setq cookie-last-tin nil))
  1783.  
  1784. (defun cvs-append-to-ignore (fileinfo)
  1785.   "Append the file in fileinfo to the .cvsignore file"
  1786.   (save-window-excursion
  1787.     (set-buffer (find-file-noselect (concat (file-name-as-directory
  1788.                          (cvs-fileinfo->dir fileinfo))
  1789.                         ".cvsignore")))
  1790.     (goto-char (point-max))
  1791.     (if (not (zerop (current-column)))
  1792.     (insert "\n"))
  1793.     (insert (cvs-fileinfo->file-name fileinfo) "\n")
  1794.     (save-buffer)))
  1795.  
  1796. (defun cvs-status ()
  1797.   "Show cvs status for all marked files."
  1798.   (interactive)
  1799.  
  1800.   (save-some-buffers)
  1801.   (let ((marked (cvs-get-marked)))
  1802.     (cvs-use-temp-buffer)
  1803.     (message "Running cvs status ...")
  1804.     (cvs-execute-list marked cvs-program (cons "status" cvs-status-flags)))
  1805.   (message "Running cvs status ... Done."))
  1806.  
  1807. (defun cvs-log ()
  1808.   "Display the cvs log of all selected files."
  1809.   (interactive)
  1810.  
  1811.   (let ((marked (cvs-get-marked)))
  1812.     (cvs-use-temp-buffer)
  1813.     (message "Running cvs log ...")
  1814.     (cvs-execute-list marked cvs-program (cons "log" cvs-log-flags)))
  1815.   (message "Running cvs log ... Done."))
  1816.  
  1817. (defun cvs-byte-compile-files ()
  1818.   "Run byte-compile-file on all selected files that end in '.el'."
  1819.   (interactive)
  1820.   (let ((marked (cvs-get-marked)))
  1821.     (while marked
  1822.       (let ((filename (cvs-full-path (current-buffer) (car marked))))
  1823.     (if (string-match "\\.el$" filename)
  1824.         (byte-compile-file filename)))
  1825.       (setq marked (cdr marked)))))
  1826.  
  1827. (defun cvs-insert-full-path (tin)
  1828.   "Insert full path to the file described in TIN in the current buffer."
  1829.   (insert (format "%s\n" (cvs-full-path cvs-buffer-name tin))))
  1830.  
  1831.  
  1832. (defun cvs-add-change-log-entry-other-window (pos)
  1833.   "Add a ChangeLog entry in the ChangeLog of the current directory.
  1834. Args: POS."
  1835.   (interactive "d")
  1836.   (let* ((cvs-buf (current-buffer))
  1837.      (odir default-directory))
  1838.     (setq default-directory
  1839.       (file-name-as-directory
  1840.        (cvs-fileinfo->dir
  1841.         (cookie-cookie
  1842.          cvs-buf
  1843.          (tin-get-selection cvs-buf pos cookie-last-tin)))))
  1844.     (if (not default-directory)        ;In case there was no entries.
  1845.     (setq default-directory odir))
  1846.     (add-change-log-entry-other-window)
  1847.     (set-buffer cvs-buf)
  1848.     (setq default-directory odir)))
  1849.  
  1850.  
  1851. (defun print-cvs-tin (foo)
  1852.   "Debug utility."
  1853.   (let ((cookie (cookie-cookie (current-buffer) foo))
  1854.     (stream (get-buffer-create "debug")))
  1855.     (princ "==============\n" stream)
  1856.     (princ (cvs-fileinfo->file-name cookie) stream)
  1857.     (princ "\n" stream)
  1858.     (princ (cvs-fileinfo->dir cookie) stream)
  1859.     (princ "\n" stream)
  1860.     (princ (cvs-fileinfo->full-log cookie) stream)
  1861.     (princ "\n" stream)
  1862.     (princ (cvs-fileinfo->marked cookie) stream)
  1863.     (princ "\n" stream)))
  1864.  
  1865.  
  1866. (if (string-match "Lucid" emacs-version)
  1867.     (progn
  1868.       (autoload 'pcl-cvs-fontify "pcl-cvs-lucid")
  1869.       (add-hook 'cvs-mode-hook 'pcl-cvs-fontify)))
  1870.  
  1871.