Fix last commit
[emacs.git] / lisp / vc / pcvs.el
Commit [+]AuthorDateLineData
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -04001;;; pcvs.el --- a front-end to CVS -*- lexical-binding:t -*-
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00002
7e09ef09 Paul Eggert2015-01-01 14:26:41 -08003;; Copyright (C) 1991-2015 Free Software Foundation, Inc.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00004
5;; Author: (The PCL-CVS Trust) pcl-cvs@cyclic.com
6;; (Per Cederqvist) ceder@lysator.liu.se
7;; (Greg A. Woods) woods@weird.com
8;; (Jim Blandy) jimb@cyclic.com
9;; (Karl Fogel) kfogel@floss.red-bean.com
10;; (Jim Kingdon) kingdon@cyclic.com
a7996e05
SM
Stefan Monnier2000-09-29 03:14:36 +000011;; (Stefan Monnier) monnier@cs.yale.edu
12;; (Greg Klanderman) greg@alphatech.com
13;; (Jari Aalto+mail.emacs) jari.aalto@poboxes.com
3b52037b Stefan Monnier2004-03-28 22:02:16 +000014;; Maintainer: (Stefan Monnier) monnier@gnu.org
9766adfb Juri Linkov2010-06-11 22:09:57 +030015;; Keywords: CVS, vc, release management
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +000016
17;; This file is part of GNU Emacs.
18
eb3fa2cf Glenn Morris2008-05-06 08:06:51 +000019;; GNU Emacs is free software: you can redistribute it and/or modify
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +000020;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
Glenn Morris2008-05-06 08:06:51 +000021;; the Free Software Foundation, either version 3 of the License, or
22;; (at your option) any later version.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +000023
24;; GNU Emacs is distributed in the hope that it will be useful,
25;; but WITHOUT ANY WARRANTY; without even the implied warranty of
26;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
27;; GNU General Public License for more details.
28
29;; You should have received a copy of the GNU General Public License
eb3fa2cf Glenn Morris2008-05-06 08:06:51 +000030;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +000031
32;;; Commentary:
33
cb5850f2
GM
Glenn Morris2012-01-23 00:45:59 -080034;; PCL-CVS is a front-end to the CVS version control system.
35;; It presents the status of all the files in your working area and
36;; allows you to commit/update several of them at a time.
37;; Compare with the general Emacs utility vc-dir, which tries
38;; to be VCS-agnostic. You may find PCL-CVS better/faster for CVS.
cb3430a1
SM
Stefan Monnier2000-03-22 02:57:23 +000039
40;; PCL-CVS was originally written by Per Cederqvist many years ago. This
41;; version derives from the XEmacs-21 version, itself based on the 2.0b2
42;; version (last release from Per). It is a thorough rework.
43
cb5850f2
GM
Glenn Morris2012-01-23 00:45:59 -080044;; PCL-CVS is not a replacement for VC, but adds extra functionality.
45;; As such, I've tried to make PCL-CVS and VC interoperate seamlessly
46;; (I also use VC).
cb3430a1
SM
Stefan Monnier2000-03-22 02:57:23 +000047
48;; To use PCL-CVS just use `M-x cvs-examine RET <dir> RET'.
96190aa1 Stefan Monnier2000-08-09 15:28:06 +000049;; There is a TeXinfo manual, which can be helpful to get started.
cb3430a1 Stefan Monnier2000-03-22 02:57:23 +000050
ee8d23ee
SM
Stefan Monnier2000-12-08 16:58:57 +000051;;; Bugs:
52
76829576
SM
Stefan Monnier2001-09-22 20:23:16 +000053;; - Extracting an old version seems not to recognize encoding correctly.
54;; That's probably because it's done via a process rather than a file.
ee8d23ee Stefan Monnier2000-12-08 16:58:57 +000055
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +000056;;; Todo:
57
cb3430a1 Stefan Monnier2000-03-22 02:57:23 +000058;; ******** FIX THE DOCUMENTATION *********
f1180544 Juanma Barranquero2003-02-04 12:29:42 +000059;;
ee8d23ee Stefan Monnier2000-12-08 16:58:57 +000060;; - rework the displaying of error messages.
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +000061;; - allow to flush messages only
62;; - allow to protect files like ChangeLog from flushing
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +000063;; - query the user for cvs-get-marked (for some cmds or if nothing's selected)
64;; - don't return the first (resp last) FI if the cursor is before
65;; (resp after) it.
66;; - allow cvs-confirm-removals to force always confirmation.
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +000067;; - cvs-checkout should ask for a revision (with completion).
68;; - removal confirmation should allow specifying another file name.
f1180544 Juanma Barranquero2003-02-04 12:29:42 +000069;;
96190aa1 Stefan Monnier2000-08-09 15:28:06 +000070;; - hide fileinfos without getting rid of them (will require ewok work).
cb3430a1
SM
Stefan Monnier2000-03-22 02:57:23 +000071;; - add toolbar entries
72;; - marking
73;; marking directories should jump to just after the dir.
74;; allow (un)marking directories at a time with the mouse.
be0add30
SM
Stefan Monnier2001-04-13 15:18:11 +000075;; allow cvs-cmd-do to either clear the marks or not.
76;; add a "marks active" notion, like transient-mark-mode does.
cb3430a1
SM
Stefan Monnier2000-03-22 02:57:23 +000077;; - liveness indicator
78;; - indicate in docstring if the cmd understands the `b' prefix(es).
79;; - call smerge-mode when opening CONFLICT files.
cb3430a1
SM
Stefan Monnier2000-03-22 02:57:23 +000080;; - have vc-checkin delegate to cvs-mode-commit when applicable
81;; - higher-level CVS operations
82;; cvs-mode-rename
83;; cvs-mode-branch
84;; - module-level commands
85;; add support for parsing 'modules' file ("cvs co -c")
86;; cvs-mode-rcs2log
87;; cvs-rdiff
88;; cvs-release
89;; cvs-import
90;; C-u M-x cvs-checkout should ask for a cvsroot
91;; cvs-mode-handle-new-vendor-version
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +000092;; - checks out module, or alternately does update join
93;; - does "cvs -n tag LAST_VENDOR" to find old files into *cvs*
cb3430a1 Stefan Monnier2000-03-22 02:57:23 +000094;; cvs-export
44946a4c Stefan Monnier2000-08-16 20:27:39 +000095;; (with completion on tag names and hooks to help generate full releases)
cb3430a1
SM
Stefan Monnier2000-03-22 02:57:23 +000096;; - display stickiness information. And current CVS/Tag as well.
97;; - write 'cvs-mode-admin' to do arbitrary 'cvs admin' commands
6dc7d3d5
SM
Stefan Monnier2000-06-12 04:53:34 +000098;; Most interesting would be version removal and log message replacement.
99;; The last one would be neat when called from log-view-mode.
cb3430a1 Stefan Monnier2000-03-22 02:57:23 +0000100;; - cvs-mode-incorporate
6dc7d3d5 Stefan Monnier2000-06-12 04:53:34 +0000101;; It would merge in the status from one *cvs* buffer into another.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000102;; This would be used to populate such a buffer that had been created with
103;; a `cvs {update,status,checkout} -l'.
cb3430a1
SM
Stefan Monnier2000-03-22 02:57:23 +0000104;; - cvs-mode-(i)diff-other-{file,buffer,cvs-buffer}
105;; - offer the choice to kill the process when the user kills the cvs buffer.
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000106;; right now, it's killed without further ado.
cb3430a1 Stefan Monnier2000-03-22 02:57:23 +0000107;; - make `cvs-mode-ignore' allow manually entering a pattern.
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000108;; to which dir should it apply ?
cb3430a1
SM
Stefan Monnier2000-03-22 02:57:23 +0000109;; - cvs-mode-ignore should try to remove duplicate entries.
110;; - maybe poll/check CVS/Entries files to react to external `cvs' commands ?
111;; - some kind of `cvs annotate' support ?
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000112;; but vc-annotate can be used instead.
44946a4c
SM
Stefan Monnier2000-08-16 20:27:39 +0000113;; - proper `g' that passes safe args and uses either cvs-status or cvs-examine
114;; maybe also use cvs-update depending on I-don't-know-what.
cb3430a1 Stefan Monnier2000-03-22 02:57:23 +0000115;; - add message-levels so that we can hide some levels of messages
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000116
117;;; Code:
118
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -0400119(eval-when-compile (require 'cl-lib))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000120(require 'ewoc) ;Ewoc was once cookie
121(require 'pcvs-defs)
122(require 'pcvs-util)
123(require 'pcvs-parse)
124(require 'pcvs-info)
7aa7fff0 Xue Fuqiao2013-07-30 08:25:31 +0800125(require 'vc-cvs)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000126
127\f
128;;;;
129;;;; global vars
130;;;;
131
132(defvar cvs-cookies) ;;nil
133 ;;"Handle for the cookie structure that is displayed in the *cvs* buffer.")
134;;(make-variable-buffer-local 'cvs-cookies)
135
136;;;;
137;;;; Dynamically scoped variables
138;;;;
139
140(defvar cvs-from-vc nil "Bound to t inside VC advice.")
141
027b73ac Sam Steingold2000-08-03 18:11:47 +0000142;;;;
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000143;;;; flags variables
027b73ac Sam Steingold2000-08-03 18:11:47 +0000144;;;;
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000145
146(defun cvs-defaults (&rest defs)
147 (let ((defs (cvs-first defs cvs-shared-start)))
148 (append defs
44946a4c Stefan Monnier2000-08-16 20:27:39 +0000149 (make-list (- cvs-shared-start (length defs)) (car defs))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000150 cvs-shared-flags)))
151
152;; For cvs flags, we need to add "-f" to override the cvsrc settings
153;; we also want to evict the annoying -q and -Q options that hide useful
154;; information from pcl-cvs.
155(cvs-flags-define cvs-cvs-flags '(("-f")))
156
157(cvs-flags-define cvs-checkout-flags (cvs-defaults '("-P")))
158(cvs-flags-define cvs-status-flags (cvs-defaults '("-v") nil))
159(cvs-flags-define cvs-log-flags (cvs-defaults nil))
6dc7d3d5 Stefan Monnier2000-06-12 04:53:34 +0000160(cvs-flags-define cvs-diff-flags (cvs-defaults '("-u" "-N") '("-c" "-N") '("-u" "-b")))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000161(cvs-flags-define cvs-tag-flags (cvs-defaults nil))
162(cvs-flags-define cvs-add-flags (cvs-defaults nil))
163(cvs-flags-define cvs-commit-flags (cvs-defaults nil))
164(cvs-flags-define cvs-remove-flags (cvs-defaults nil))
165;;(cvs-flags-define cvs-undo-flags (cvs-defaults nil))
166(cvs-flags-define cvs-update-flags (cvs-defaults '("-d" "-P")))
167
168(defun cvs-reread-cvsrc ()
169 "Reset the default arguments to those in the `cvs-cvsrc-file'."
170 (interactive)
ca0a7168
SM
Stefan Monnier2001-12-02 07:40:43 +0000171 (condition-case nil
172 (with-temp-buffer
173 (insert-file-contents cvs-cvsrc-file)
174 ;; fetch the values
175 (dolist (cmd '("cvs" "checkout" "status" "log" "diff" "tag"
176 "add" "commit" "remove" "update"))
177 (goto-char (point-min))
843e5edd
SM
Stefan Monnier2002-01-25 22:41:28 +0000178 (when (re-search-forward
179 (concat "^" cmd "\\(\\s-+\\(.*\\)\\)?$") nil t)
180 (let* ((sym (intern (concat "cvs-" cmd "-flags")))
ad4fed11 Richard M. Stallman2007-08-12 18:11:57 +0000181 (val (split-string-and-unquote (or (match-string 2) ""))))
843e5edd Stefan Monnier2002-01-25 22:41:28 +0000182 (cvs-flags-set sym 0 val))))
ca0a7168
SM
Stefan Monnier2001-12-02 07:40:43 +0000183 ;; ensure that cvs doesn't have -q or -Q
184 (cvs-flags-set 'cvs-cvs-flags 0
185 (cons "-f"
186 (cdr (cvs-partition
843e5edd Stefan Monnier2002-01-25 22:41:28 +0000187 (lambda (x) (member x '("-q" "-Q" "-f")))
ca0a7168
SM
Stefan Monnier2001-12-02 07:40:43 +0000188 (cvs-flags-query 'cvs-cvs-flags
189 nil 'noquery))))))
190 (file-error nil)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000191
192;; initialize to cvsrc's default values
193(cvs-reread-cvsrc)
194
195\f
196;;;;
197;;;; Mouse bindings and mode motion
198;;;;
199
6a26cf4a
SM
Stefan Monnier2003-05-12 18:16:43 +0000200(defvar cvs-minor-current-files)
201
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000202(defun cvs-menu (e)
203 "Popup the CVS menu."
204 (interactive "e")
96190aa1
SM
Stefan Monnier2000-08-09 15:28:06 +0000205 (let ((cvs-minor-current-files
206 (list (ewoc-data (ewoc-locate
207 cvs-cookies (posn-point (event-end e)))))))
ee8d23ee Stefan Monnier2000-12-08 16:58:57 +0000208 (popup-menu cvs-menu e)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000209
210(defvar cvs-mode-line-process nil
211 "Mode-line control for displaying info on cvs process status.")
212
213
027b73ac Sam Steingold2000-08-03 18:11:47 +0000214;;;;
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000215;;;; Query-Type-Descriptor for Tags
027b73ac Sam Steingold2000-08-03 18:11:47 +0000216;;;;
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000217
218(autoload 'cvs-status-get-tags "cvs-status")
219(defun cvs-tags-list ()
220 "Return a list of acceptable tags, ready for completions."
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -0400221 (cl-assert (cvs-buffer-p))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000222 (let ((marked (cvs-get-marked)))
f58e0fd5
SM
Stefan Monnier2012-07-10 07:51:54 -0400223 `(("BASE") ("HEAD")
224 ,@(when marked
225 (with-temp-buffer
226 (process-file cvs-program
227 nil ;no input
228 t ;output to current-buffer
229 nil ;don't update display while running
230 "status"
231 "-v"
232 (cvs-fileinfo->full-name (car marked)))
233 (goto-char (point-min))
234 (let ((tags (cvs-status-get-tags)))
235 (when (listp tags) tags)))))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000236
237(defvar cvs-tag-history nil)
238(defconst cvs-qtypedesc-tag
239 (cvs-qtypedesc-create 'identity 'identity 'cvs-tags-list 'cvs-tag-history))
240
027b73ac Sam Steingold2000-08-03 18:11:47 +0000241;;;;
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000242
906cbe45 Stefan Monnier2003-03-16 01:09:05 +0000243(defun cvs-mode! (&optional -cvs-mode!-fun)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000244 "Switch to the *cvs* buffer.
245If -CVS-MODE!-FUN is provided, it is executed *cvs* being the current buffer
246 and with its window selected. Else, the *cvs* buffer is simply selected.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000247-CVS-MODE!-FUN is called interactively if applicable and else with no argument."
248 (let* ((-cvs-mode!-buf (current-buffer))
249 (cvsbuf (cond ((cvs-buffer-p) (current-buffer))
250 ((and cvs-buffer (cvs-buffer-p cvs-buffer)) cvs-buffer)
3afbc435 Pavel Janík2001-07-16 07:46:48 +0000251 (t (error "can't find the *cvs* buffer"))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000252 (-cvs-mode!-wrapper cvs-minor-wrap-function)
253 (-cvs-mode!-cont (lambda ()
254 (save-current-buffer
255 (if (commandp -cvs-mode!-fun)
256 (call-interactively -cvs-mode!-fun)
257 (funcall -cvs-mode!-fun))))))
258 (if (not -cvs-mode!-fun) (set-buffer cvsbuf)
259 (let ((cvs-mode!-buf (current-buffer))
260 (cvs-mode!-owin (selected-window))
261 (cvs-mode!-nwin (get-buffer-window cvsbuf 'visible)))
262 (unwind-protect
263 (progn
264 (set-buffer cvsbuf)
265 (when cvs-mode!-nwin (select-window cvs-mode!-nwin))
266 (if -cvs-mode!-wrapper
267 (funcall -cvs-mode!-wrapper -cvs-mode!-buf -cvs-mode!-cont)
268 (funcall -cvs-mode!-cont)))
269 (set-buffer cvs-mode!-buf)
270 (when (and cvs-mode!-nwin (eq cvs-mode!-nwin (selected-window)))
271 ;; the selected window has not been changed by FUN
272 (select-window cvs-mode!-owin)))))))
273
027b73ac Sam Steingold2000-08-03 18:11:47 +0000274;;;;
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000275;;;; Prefixes
027b73ac Sam Steingold2000-08-03 18:11:47 +0000276;;;;
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000277
278(defvar cvs-branches (list cvs-vendor-branch "HEAD" "HEAD"))
279(cvs-prefix-define cvs-branch-prefix
280 "Current selected branch."
281 "version"
282 (cons cvs-vendor-branch cvs-branches)
283 cvs-qtypedesc-tag)
284
285(defun cvs-set-branch-prefix (arg)
286 "Set the branch prefix to take action at the next command.
287See `cvs-prefix-set' for a further the description of the behavior.
288\\[universal-argument] 1 selects the vendor branch
289and \\[universal-argument] 2 selects the HEAD."
290 (interactive "P")
291 (cvs-mode!)
292 (cvs-prefix-set 'cvs-branch-prefix arg))
293
294(defun cvs-add-branch-prefix (flags &optional arg)
295 "Add branch selection argument if the branch prefix was set.
296The argument is added (or not) to the list of FLAGS and is constructed
297by appending the branch to ARG which defaults to \"-r\"."
298 (let ((branch (cvs-prefix-get 'cvs-branch-prefix)))
299 ;; deactivate the secondary prefix, even if not used.
300 (cvs-prefix-get 'cvs-secondary-branch-prefix)
301 (if branch (cons (concat (or arg "-r") branch) flags) flags)))
302
303(cvs-prefix-define cvs-secondary-branch-prefix
304 "Current secondary selected branch."
305 "version"
306 (cons cvs-vendor-branch cvs-branches)
307 cvs-qtypedesc-tag)
308
309(defun cvs-set-secondary-branch-prefix (arg)
310 "Set the branch prefix to take action at the next command.
311See `cvs-prefix-set' for a further the description of the behavior.
312\\[universal-argument] 1 selects the vendor branch
313and \\[universal-argument] 2 selects the HEAD."
314 (interactive "P")
315 (cvs-mode!)
316 (cvs-prefix-set 'cvs-secondary-branch-prefix arg))
317
318(defun cvs-add-secondary-branch-prefix (flags &optional arg)
319 "Add branch selection argument if the secondary branch prefix was set.
320The argument is added (or not) to the list of FLAGS and is constructed
321by appending the branch to ARG which defaults to \"-r\".
322Since the `cvs-secondary-branch-prefix' is only active if the primary
323prefix is active, it is important to read the secondary prefix before
c80e3b4a Paul Eggert2011-12-04 00:02:42 -0800324the primary since reading the primary can deactivate it."
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000325 (let ((branch (and (cvs-prefix-get 'cvs-branch-prefix 'read-only)
326 (cvs-prefix-get 'cvs-secondary-branch-prefix))))
327 (if branch (cons (concat (or arg "-r") branch) flags) flags)))
328
027b73ac Sam Steingold2000-08-03 18:11:47 +0000329;;;;
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000330
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +0000331(define-minor-mode cvs-minor-mode
332 "This mode is used for buffers related to a main *cvs* buffer.
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000333All the `cvs-mode' buffer operations are simply rebound under
316e1d5b Stefan Monnier2000-11-06 07:17:33 +0000334the \\[cvs-mode-map] prefix."
00821115
MR
Markus Rost2002-11-18 20:56:45 +0000335 nil " CVS"
336 :group 'pcl-cvs)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000337(put 'cvs-minor-mode 'permanent-local t)
338
339
340(defvar cvs-temp-buffers nil)
341(defun cvs-temp-buffer (&optional cmd normal nosetup)
342 "Create a temporary buffer to run CMD in.
343If CMD is a string, use it to lookup `cvs-buffer-name-alist' to find
5983b317 Juanma Barranquero2014-03-12 05:00:03 +0100344the buffer name to be used and its major mode.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000345
346The selected window will not be changed. The new buffer will not maintain undo
347information and will be read-only unless NORMAL is non-nil. It will be emptied
5983b317 Juanma Barranquero2014-03-12 05:00:03 +0100348\(unless NOSETUP is non-nil) and its `default-directory' will be inherited
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000349from the current buffer."
350 (let* ((cvs-buf (current-buffer))
351 (info (cdr (assoc cmd cvs-buffer-name-alist)))
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -0400352 (name (eval (nth 0 info) `((cmd . ,cmd))))
dedffa6a Gerd Moellmann2000-08-06 09:18:02 +0000353 (mode (nth 1 info))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000354 (dir default-directory)
355 (buf (cond
356 (name (cvs-get-buffer-create name))
8f53f317 Stefan Monnier2005-04-01 17:58:09 +0000357 ((and (bufferp cvs-temp-buffer) (buffer-live-p cvs-temp-buffer))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000358 cvs-temp-buffer)
359 (t
360 (set (make-local-variable 'cvs-temp-buffer)
361 (cvs-get-buffer-create
cc5da1ec
SM
Stefan Monnier2013-10-07 23:47:24 -0400362 (eval cvs-temp-buffer-name `((dir . ,dir)))
363 'noreuse))))))
027b73ac Sam Steingold2000-08-03 18:11:47 +0000364
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -0400365 ;; Handle the potential pre-existing process.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000366 (let ((proc (get-buffer-process buf)))
367 (when (and (not normal) (processp proc)
368 (memq (process-status proc) '(run stop)))
8a769de6
SM
Stefan Monnier2003-05-23 19:31:02 +0000369 (if cmd
370 ;; When CMD is specified, the buffer is normally shown to the
371 ;; user, so interrupting the process is not harmful.
372 ;; Use `delete-process' rather than `kill-process' otherwise
373 ;; the pending output of the process will still get inserted
374 ;; after we erase the buffer.
375 (delete-process proc)
376 (error "Can not run two cvs processes simultaneously"))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000377
378 (if (not name) (kill-local-variable 'other-window-scroll-buffer)
379 ;; Strangely, if no window is created, `display-buffer' ends up
380 ;; doing a `switch-to-buffer' which does a `set-buffer', hence
381 ;; the need for `save-excursion'.
382 (unless nosetup (save-excursion (display-buffer buf)))
383 ;; FIXME: this doesn't do the right thing if the user later on
384 ;; does a `find-file-other-window' and `scroll-other-window'
385 (set (make-local-variable 'other-window-scroll-buffer) buf))
386
387 (add-to-list 'cvs-temp-buffers buf)
388
389 (with-current-buffer buf
390 (setq buffer-read-only nil)
391 (setq default-directory dir)
405b8717
SM
Stefan Monnier2007-07-25 04:50:33 +0000392 (unless nosetup
393 ;; Disable undo before calling erase-buffer since it may generate
394 ;; a very large and unwanted undo record.
395 (buffer-disable-undo)
396 (erase-buffer))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000397 (set (make-local-variable 'cvs-buffer) cvs-buf)
398 ;;(cvs-minor-mode 1)
399 (let ((lbd list-buffers-directory))
405b8717 Stefan Monnier2007-07-25 04:50:33 +0000400 (if (fboundp mode) (funcall mode) (fundamental-mode))
11ee8d90 Juanma Barranquero2009-09-25 04:35:14 +0000401 (when lbd (setq list-buffers-directory lbd)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000402 (cvs-minor-mode 1)
403 ;;(set (make-local-variable 'cvs-buffer) cvs-buf)
405b8717
SM
Stefan Monnier2007-07-25 04:50:33 +0000404 (if normal
405 (buffer-enable-undo)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000406 (setq buffer-read-only t)
407 (buffer-disable-undo))
408 buf)))
409
410(defun cvs-mode-kill-buffers ()
411 "Kill all the \"temporary\" buffers created by the *cvs* buffer."
412 (interactive)
413 (dolist (buf cvs-temp-buffers) (ignore-errors (kill-buffer buf))))
414
415(defun cvs-make-cvs-buffer (dir &optional new)
416 "Create the *cvs* buffer for directory DIR.
417If non-nil, NEW means to create a new buffer no matter what."
418 ;; the real cvs-buffer creation
419 (setq dir (cvs-expand-dir-name dir))
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -0400420 (let* ((buffer-name (eval cvs-buffer-name `((dir . ,dir))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000421 (buffer
422 (or (and (not new)
423 (eq cvs-reuse-cvs-buffer 'current)
424 (cvs-buffer-p) ;reuse the current buffer if possible
425 (current-buffer))
426 ;; look for another cvs buffer visiting the same directory
427 (save-excursion
428 (unless new
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -0400429 (cl-dolist (buffer (cons (current-buffer) (buffer-list)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000430 (set-buffer buffer)
431 (and (cvs-buffer-p)
f58e0fd5
SM
Stefan Monnier2012-07-10 07:51:54 -0400432 (pcase cvs-reuse-cvs-buffer
433 (`always t)
434 (`subdir
121b8917
GM
Glenn Morris2012-04-16 19:57:09 -0400435 (or (string-prefix-p default-directory dir)
436 (string-prefix-p dir default-directory)))
f58e0fd5
SM
Stefan Monnier2012-07-10 07:51:54 -0400437 (`samedir (string= default-directory dir)))
438 (cl-return buffer)))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000439 ;; we really have to create a new buffer:
440 ;; we temporarily bind cwd to "" to prevent
441 ;; create-file-buffer from using directory info
442 ;; unless it is explicitly in the cvs-buffer-name.
443 (cvs-get-buffer-create buffer-name new))))
444 (with-current-buffer buffer
445 (or
446 (and (string= dir default-directory) (cvs-buffer-p)
447 ;; just a refresh
448 (ignore-errors
449 (cvs-cleanup-collection cvs-cookies nil nil t)
450 (current-buffer)))
451 ;; setup from scratch
452 (progn
453 (setq default-directory dir)
454 (setq buffer-read-only nil)
455 (erase-buffer)
94d79fb4
SM
Stefan Monnier2003-05-13 15:22:39 +0000456 (insert "Repository : " (directory-file-name (cvs-get-cvsroot))
457 "\nModule : " (cvs-get-module)
458 "\nWorking dir: " (abbreviate-file-name dir)
459 (if (not (file-readable-p "CVS/Tag")) "\n"
460 (let ((tag (cvs-file-to-string "CVS/Tag")))
461 (cond
462 ((string-match "\\`T" tag)
463 (concat "\nTag : " (substring tag 1)))
464 ((string-match "\\`D" tag)
465 (concat "\nDate : " (substring tag 1)))
8a769de6
SM
Stefan Monnier2003-05-23 19:31:02 +0000466 ("\n"))))
467 "\n")
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000468 (setq buffer-read-only t)
469 (cvs-mode)
470 (set (make-local-variable 'list-buffers-directory) buffer-name)
471 ;;(set (make-local-variable 'cvs-temp-buffer) (cvs-temp-buffer))
1b04f30a Thien-Thi Nguyen2006-05-27 17:41:18 +0000472 (let ((cookies (ewoc-create 'cvs-fileinfo-pp "\n\n" "\n" t)))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000473 (set (make-local-variable 'cvs-cookies) cookies)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000474 (add-hook 'kill-buffer-hook
475 (lambda ()
476 (ignore-errors (kill-buffer cvs-temp-buffer)))
477 nil t)
478 ;;(set-buffer buf)
479 buffer))))))
480
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -0400481(cl-defun cvs-cmd-do (cmd dir flags fis new
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000482 &key cvsargs noexist dont-change-disc noshow)
483 (let* ((dir (file-name-as-directory
484 (abbreviate-file-name (expand-file-name dir))))
485 (cvsbuf (cvs-make-cvs-buffer dir new)))
486 ;; Check that dir is under CVS control.
487 (unless (file-directory-p dir)
6dc7d3d5 Stefan Monnier2000-06-12 04:53:34 +0000488 (error "%s is not a directory" dir))
883e7198
SM
Stefan Monnier2002-05-16 20:03:52 +0000489 (unless (or noexist (file-directory-p (expand-file-name "CVS" dir))
490 (file-expand-wildcards (expand-file-name "*/CVS" dir)))
6dc7d3d5 Stefan Monnier2000-06-12 04:53:34 +0000491 (error "%s does not contain CVS controlled files" dir))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000492
493 (set-buffer cvsbuf)
494 (cvs-mode-run cmd flags fis
495 :cvsargs cvsargs :dont-change-disc dont-change-disc)
496
497 (if noshow cvsbuf
498 (let ((pop-up-windows nil)) (pop-to-buffer cvsbuf)))))
499;; (funcall (if (and (boundp 'pop-up-frames) pop-up-frames)
500;; 'pop-to-buffer 'switch-to-buffer)
501;; cvsbuf))))
502
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000503(defun cvs-run-process (args fis postprocess &optional single-dir)
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -0400504 (cl-assert (cvs-buffer-p cvs-buffer))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000505 (save-current-buffer
506 (let ((procbuf (current-buffer))
507 (cvsbuf cvs-buffer)
508 (single-dir (or single-dir (eq cvs-execute-single-dir t))))
027b73ac Sam Steingold2000-08-03 18:11:47 +0000509
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000510 (set-buffer procbuf)
511 (goto-char (point-max))
512 (unless (bolp) (let ((inhibit-read-only t)) (insert "\n")))
513 ;; find the set of files we'll process in this round
514 (let* ((dir+files+rest
515 (if (or (null fis) (not single-dir))
516 ;; not single-dir mode: just process the whole thing
2231c2bc Stefan Monnier2005-04-26 20:37:31 +0000517 (list "" (mapcar 'cvs-fileinfo->full-name fis) nil)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000518 ;; single-dir mode: extract the same-dir-elements
519 (let ((dir (cvs-fileinfo->dir (car fis))))
520 ;; output the concerned dir so the parser can translate paths
521 (let ((inhibit-read-only t))
522 (insert "pcl-cvs: descending directory " dir "\n"))
523 ;; loop to find the same-dir-elems
f58e0fd5
SM
Stefan Monnier2012-07-10 07:51:54 -0400524 (cl-do* ((files () (cons (cvs-fileinfo->file fi) files))
525 (fis fis (cdr fis))
526 (fi (car fis) (car fis)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000527 ((not (and fis (string= dir (cvs-fileinfo->dir fi))))
528 (list dir files fis))))))
dedffa6a
GM
Gerd Moellmann2000-08-06 09:18:02 +0000529 (dir (nth 0 dir+files+rest))
530 (files (nth 1 dir+files+rest))
531 (rest (nth 2 dir+files+rest)))
027b73ac Sam Steingold2000-08-03 18:11:47 +0000532
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000533 (add-hook 'kill-buffer-hook
534 (lambda ()
535 (let ((proc (get-buffer-process (current-buffer))))
536 (when (processp proc)
537 (set-process-filter proc nil)
8f53f317
SM
Stefan Monnier2005-04-01 17:58:09 +0000538 ;; Abort postprocessing but leave the sentinel so it
539 ;; will update the list of running procs.
540 (process-put proc 'cvs-postprocess nil)
541 (interrupt-process proc))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000542 nil t)
543
544 ;; create the new process and setup the procbuffer correspondingly
8f53f317
SM
Stefan Monnier2005-04-01 17:58:09 +0000545 (let* ((msg (cvs-header-msg args fis))
546 (args (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000547 (if cvs-cvsroot (list "-d" cvs-cvsroot))
548 args
549 files))
6b2e4334
SM
Stefan Monnier2002-09-03 01:40:29 +0000550 ;; If process-connection-type is nil and the repository
551 ;; is accessed via SSH, a bad interaction between libc,
552 ;; CVS and SSH can lead to garbled output.
8f53f317 Stefan Monnier2005-04-01 17:58:09 +0000553 ;; It might be a glibc-specific problem (but it can also happens
1854d6e2 Stefan Monnier2003-02-10 21:48:38 +0000554 ;; under Mac OS X, it seems).
8f53f317
SM
Stefan Monnier2005-04-01 17:58:09 +0000555 ;; It seems that using a pty can help circumvent the problem,
556 ;; but at the cost of screwing up when the process thinks it
557 ;; can ask for user input (such as password or host-key
558 ;; confirmation). A better workaround is to set CVS_RSH to
559 ;; an appropriate script, or to use a later version of CVS.
560 (process-connection-type nil) ; Use a pipe, not a pty.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000561 (process
562 ;; the process will be run in the selected dir
563 (let ((default-directory (cvs-expand-dir-name dir)))
62b84d36 Stefan Monnier2007-09-15 02:22:12 +0000564 (apply 'start-file-process "cvs" procbuf cvs-program args))))
8f53f317
SM
Stefan Monnier2005-04-01 17:58:09 +0000565 ;; setup the process.
566 (process-put process 'cvs-buffer cvs-buffer)
567 (with-current-buffer cvs-buffer (cvs-update-header msg 'add))
568 (process-put process 'cvs-header msg)
569 (process-put
570 process 'cvs-postprocess
571 (if (null rest)
572 ;; this is the last invocation
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -0400573 postprocess
8f53f317 Stefan Monnier2005-04-01 17:58:09 +0000574 ;; else, we have to register ourselves to be rerun on the rest
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -0400575 (lambda () (cvs-run-process args rest postprocess single-dir))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000576 (set-process-sentinel process 'cvs-sentinel)
577 (set-process-filter process 'cvs-update-filter)
578 (set-marker (process-mark process) (point-max))
579 (ignore-errors (process-send-eof process)) ;close its stdin to avoid hangs
027b73ac Sam Steingold2000-08-03 18:11:47 +0000580
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000581 ;; now finish setting up the cvs-buffer
582 (set-buffer cvsbuf)
583 (setq cvs-mode-line-process (symbol-name (process-status process)))
584 (force-mode-line-update)))))
585
586 ;; The following line is said to improve display updates on some
587 ;; emacsen. It shouldn't be needed, but it does no harm.
588 (sit-for 0))
589
31982e1f Stefan Monnier2004-12-01 22:35:15 +0000590(defun cvs-header-msg (args fis)
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000591 (let* ((lastarg nil)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000592 (args (mapcar (lambda (arg)
593 (cond
6b2e4334 Stefan Monnier2002-09-03 01:40:29 +0000594 ;; filter out the largish commit message
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000595 ((and (eq lastarg nil) (string= arg "commit"))
596 (setq lastarg 'commit) arg)
597 ((and (eq lastarg 'commit) (string= arg "-m"))
598 (setq lastarg '-m) arg)
599 ((eq lastarg '-m)
600 (setq lastarg 'done) "<log message>")
6b2e4334
SM
Stefan Monnier2002-09-03 01:40:29 +0000601 ;; filter out the largish `admin -mrev:msg' message
602 ((and (eq lastarg nil) (string= arg "admin"))
603 (setq lastarg 'admin) arg)
604 ((and (eq lastarg 'admin)
605 (string-match "\\`-m[^:]*:" arg))
606 (setq lastarg 'done)
607 (concat (match-string 0 arg) "<log message>"))
608 ;; Keep the rest as is.
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000609 (t arg)))
31982e1f
SM
Stefan Monnier2004-12-01 22:35:15 +0000610 args)))
611 (concat cvs-program " "
ad4fed11 Richard M. Stallman2007-08-12 18:11:57 +0000612 (combine-and-quote-strings
31982e1f
SM
Stefan Monnier2004-12-01 22:35:15 +0000613 (append (cvs-flags-query 'cvs-cvs-flags nil 'noquery)
614 (if cvs-cvsroot (list "-d" cvs-cvsroot))
615 args
2231c2bc Stefan Monnier2005-04-26 20:37:31 +0000616 (mapcar 'cvs-fileinfo->full-name fis))))))
31982e1f
SM
Stefan Monnier2004-12-01 22:35:15 +0000617
618(defun cvs-update-header (cmd add)
619 (let* ((hf (ewoc-get-hf cvs-cookies))
620 (str (car hf))
621 (done "")
622 (tin (ewoc-nth cvs-cookies 0)))
4c36be58 Paul Eggert2011-11-17 01:09:20 -0800623 ;; look for the first *real* fileinfo (to determine emptiness)
31982e1f
SM
Stefan Monnier2004-12-01 22:35:15 +0000624 (while
625 (and tin
626 (memq (cvs-fileinfo->type (ewoc-data tin))
627 '(MESSAGE DIRCHANGE)))
628 (setq tin (ewoc-next cvs-cookies tin)))
629 (if add
04e408d9
SM
Stefan Monnier2006-10-02 00:21:07 +0000630 (progn
631 ;; Remove the default empty line, if applicable.
632 (if (not (string-match "." str)) (setq str "\n"))
633 (setq str (concat "-- Running " cmd " ...\n" str)))
31982e1f Stefan Monnier2004-12-01 22:35:15 +0000634 (if (not (string-match
8b5f251b
SM
Stefan Monnier2007-09-07 19:47:56 +0000635 ;; FIXME: If `cmd' is large, this will bump into the
636 ;; compiled-regexp size limit. We could drop the "^" anchor
637 ;; and use search-forward to circumvent the problem.
31982e1f
SM
Stefan Monnier2004-12-01 22:35:15 +0000638 (concat "^-- Running " (regexp-quote cmd) " \\.\\.\\.\n") str))
639 (error "Internal PCL-CVS error while removing message")
640 (setq str (replace-match "" t t str))
04e408d9
SM
Stefan Monnier2006-10-02 00:21:07 +0000641 ;; Re-add the default empty line, if applicable.
642 (if (not (string-match "." str)) (setq str "\n\n"))
643 (setq done (concat "-- last cmd: " cmd " --\n"))))
31982e1f
SM
Stefan Monnier2004-12-01 22:35:15 +0000644 ;; set the new header and footer
645 (ewoc-set-hf cvs-cookies
646 str (concat "\n--------------------- "
647 (if tin "End" "Empty")
648 " ---------------------\n"
649 done))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000650
651
6c42fc3e Daniel Hackney2013-09-04 23:30:07 -0400652(defun cvs-sentinel (proc _msg)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000653 "Sentinel for the cvs update process.
654This is responsible for parsing the output from the cvs update when
655it is finished."
656 (when (memq (process-status proc) '(signal exit))
5f0e7257 Stefan Monnier2005-04-01 18:01:55 +0000657 (let ((cvs-postproc (process-get proc 'cvs-postprocess))
7a34e7b1
SM
Stefan Monnier2005-10-06 15:32:14 +0000658 (cvs-buf (process-get proc 'cvs-buffer))
659 (procbuf (process-buffer proc)))
660 (unless (buffer-live-p cvs-buf) (setq cvs-buf nil))
661 (unless (buffer-live-p procbuf) (setq procbuf nil))
8f53f317
SM
Stefan Monnier2005-04-01 17:58:09 +0000662 ;; Since the buffer and mode line will show that the
663 ;; process is dead, we can delete it now. Otherwise it
664 ;; will stay around until M-x list-processes.
665 (process-put proc 'postprocess nil)
666 (delete-process proc)
667 ;; Don't do anything if the main buffer doesn't exist any more.
7a34e7b1 Stefan Monnier2005-10-06 15:32:14 +0000668 (when cvs-buf
8f53f317
SM
Stefan Monnier2005-04-01 17:58:09 +0000669 (with-current-buffer cvs-buf
670 (cvs-update-header (process-get proc 'cvs-header) nil)
671 (setq cvs-mode-line-process (symbol-name (process-status proc)))
672 (force-mode-line-update)
673 (when cvs-postproc
7a34e7b1 Stefan Monnier2005-10-06 15:32:14 +0000674 (if (null procbuf)
8f53f317
SM
Stefan Monnier2005-04-01 17:58:09 +0000675 ;;(set-process-buffer proc nil)
676 (error "cvs' process buffer was killed")
7a34e7b1
SM
Stefan Monnier2005-10-06 15:32:14 +0000677 (with-current-buffer procbuf
678 ;; Do the postprocessing like parsing and such.
cc5da1ec
SM
Stefan Monnier2013-10-07 23:47:24 -0400679 (save-excursion
680 (funcall cvs-postproc)))))))
7a34e7b1
SM
Stefan Monnier2005-10-06 15:32:14 +0000681 ;; Check whether something is left.
682 (when (and procbuf (not (get-buffer-process procbuf)))
683 (with-current-buffer procbuf
684 ;; IIRC, we enable undo again once the process is finished
685 ;; for cases where the output was inserted in *vc-diff* or
686 ;; in a file-like buffer. --Stef
687 (buffer-enable-undo)
688 (with-current-buffer (or cvs-buf (current-buffer))
689 (message "CVS process has completed in %s"
690 (buffer-name))))))))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000691
a399e814
SM
Stefan Monnier2002-06-24 22:49:38 +0000692(defun cvs-parse-process (dcd &optional subdir old-fis)
693 "Parse the output of a cvs process.
694DCD is the `dont-change-disc' flag to use when parsing that output.
695SUBDIR is the subdirectory (if any) where this command was run.
696OLD-FIS is the list of fileinfos on which the cvs command was applied and
697 which should be considered up-to-date if they are missing from the output."
3b52037b
SM
Stefan Monnier2004-03-28 22:02:16 +0000698 (when (eq system-type 'darwin)
699 ;; Fixup the ^D^H^H inserted at beginning of buffer sometimes on MacOSX
700 ;; because of the call to `process-send-eof'.
701 (save-excursion
702 (goto-char (point-min))
703 (while (re-search-forward "^\\^D\b+" nil t)
704 (let ((inhibit-read-only t))
705 (delete-region (match-beginning 0) (match-end 0))))))
498ecdde
SM
Stefan Monnier2002-06-25 00:11:28 +0000706 (let* ((fileinfos (cvs-parse-buffer 'cvs-parse-table dcd subdir))
707 last)
708 (with-current-buffer cvs-buffer
709 ;; Expand OLD-FIS to actual files.
710 (let ((fis nil))
711 (dolist (fi old-fis)
712 (setq fis (if (eq (cvs-fileinfo->type fi) 'DIRCHANGE)
713 (nconc (ewoc-collect cvs-cookies 'cvs-dir-member-p
714 (cvs-fileinfo->dir fi))
715 fis)
716 (cons fi fis))))
717 (setq old-fis fis))
718 ;; Drop OLD-FIS which were already up-to-date.
719 (let ((fis nil))
720 (dolist (fi old-fis)
721 (unless (eq (cvs-fileinfo->type fi) 'UP-TO-DATE) (push fi fis)))
722 (setq old-fis fis))
723 ;; Add the new fileinfos to the ewoc.
724 (dolist (fi fileinfos)
725 (setq last (cvs-addto-collection cvs-cookies fi last))
726 ;; This FI was in the output, so remove it from OLD-FIS.
727 (setq old-fis (delq (ewoc-data last) old-fis)))
728 ;; Process the "silent output" (i.e. absence means up-to-date).
a399e814 Stefan Monnier2002-06-24 22:49:38 +0000729 (dolist (fi old-fis)
498ecdde
SM
Stefan Monnier2002-06-25 00:11:28 +0000730 (setf (cvs-fileinfo->type fi) 'UP-TO-DATE)
731 (setq last (cvs-addto-collection cvs-cookies fi last)))
732 (setq fileinfos (nconc old-fis fileinfos))
733 ;; Clean up the ewoc as requested by the user.
734 (cvs-cleanup-collection cvs-cookies
735 (eq cvs-auto-remove-handled t)
736 cvs-auto-remove-directories
737 nil)
738 ;; Revert buffers if necessary.
739 (when (and cvs-auto-revert (not dcd) (not cvs-from-vc))
740 (cvs-revert-if-needed fileinfos)))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000741
742(defmacro defun-cvs-mode (fun args docstring interact &rest body)
743 "Define a function to be used in a *cvs* buffer.
744This will look for a *cvs* buffer and execute BODY in it.
745Since the interactive arguments might need to be queried after
746switching to the *cvs* buffer, the generic code is rather ugly,
747but luckily we can often use simpler alternatives.
748
749FUN can be either a symbol (i.e. STYLE is nil) or a cons (FUN . STYLE).
750ARGS and DOCSTRING are the normal argument list.
751INTERACT is the interactive specification or nil for non-commands.
752
5983b317 Juanma Barranquero2014-03-12 05:00:03 +0100753STYLE can be either `SIMPLE', `NOARGS' or `DOUBLE'. It's an error for it
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000754to have any other value, unless other details of the function make it
755clear what alternative to use.
5983b317
JB
Juanma Barranquero2014-03-12 05:00:03 +0100756- `SIMPLE' will get all the interactive arguments from the original buffer.
757- `NOARGS' will get all the arguments from the *cvs* buffer and will
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000758 always behave as if called interactively.
5983b317 Juanma Barranquero2014-03-12 05:00:03 +0100759- `DOUBLE' is the generic case."
cc5da1ec
SM
Stefan Monnier2013-10-07 23:47:24 -0400760 (declare (debug (&define sexp lambda-list stringp
761 ("interactive" interactive) def-body))
a96a1d43 John Paul Wallington2008-08-09 15:53:32 +0000762 (doc-string 3))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000763 (let ((style (cvs-cdr fun))
764 (fun (cvs-car fun)))
765 (cond
766 ;; a trivial interaction, no need to move it
767 ((or (eq style 'SIMPLE)
dedffa6a
GM
Gerd Moellmann2000-08-06 09:18:02 +0000768 (null (nth 1 interact))
769 (stringp (nth 1 interact)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000770 `(defun ,fun ,args ,docstring ,interact
771 (cvs-mode! (lambda () ,@body))))
772
773 ;; fun is only called interactively: move all the args to the inner fun
774 ((eq style 'NOARGS)
775 `(defun ,fun () ,docstring (interactive)
776 (cvs-mode! (lambda ,args ,interact ,@body))))
777
778 ;; bad case
779 ((eq style 'DOUBLE)
780 (string-match ".*" docstring)
781 (let ((line1 (match-string 0 docstring))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000782 (fun-1 (intern (concat (symbol-name fun) "-1"))))
783 `(progn
784 (defun ,fun-1 ,args
785 ,(concat docstring "\nThis function only works within a *cvs* buffer.
786For interactive use, use `" (symbol-name fun) "' instead.")
787 ,interact
788 ,@body)
bd9fa00e Juri Linkov2005-12-08 07:49:07 +0000789 (put ',fun-1 'definition-name ',fun)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000790 (defun ,fun ()
791 ,(concat line1 "\nWrapper function that switches to a *cvs* buffer
792before calling the real function `" (symbol-name fun-1) "'.\n")
793 (interactive)
794 (cvs-mode! ',fun-1)))))
795
91ba1953 Stefan Monnier2004-05-19 18:55:51 +0000796 (t (error "Unknown style %s in `defun-cvs-mode'" style)))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000797
798(defun-cvs-mode cvs-mode-kill-process ()
799 "Kill the temporary buffer and associated process."
800 (interactive)
8f53f317 Stefan Monnier2005-04-01 17:58:09 +0000801 (when (and (bufferp cvs-temp-buffer) (buffer-live-p cvs-temp-buffer))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000802 (let ((proc (get-buffer-process cvs-temp-buffer)))
803 (when proc (delete-process proc)))))
804
be0add30
SM
Stefan Monnier2001-04-13 15:18:11 +0000805;;
806;; Maintaining the collection in the face of updates
807;;
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000808
809(defun cvs-addto-collection (c fi &optional tin)
3c7fafc7 Stefan Monnier2000-10-15 05:18:48 +0000810 "Add FI to C and return FI's corresponding tin.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000811FI is inserted in its proper place or maybe even merged with a preexisting
812 fileinfo if applicable.
813TIN specifies an optional starting point."
814 (unless tin (setq tin (ewoc-nth c 0)))
815 (while (and tin (cvs-fileinfo< fi (ewoc-data tin)))
816 (setq tin (ewoc-prev c tin)))
3c7fafc7 Stefan Monnier2000-10-15 05:18:48 +0000817 (if (null tin) (ewoc-enter-first c fi) ;empty collection
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -0400818 (cl-assert (not (cvs-fileinfo< fi (ewoc-data tin))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000819 (let ((next-tin (ewoc-next c tin)))
820 (while (not (or (null next-tin)
821 (cvs-fileinfo< fi (ewoc-data next-tin))))
822 (setq tin next-tin next-tin (ewoc-next c next-tin)))
be0add30
SM
Stefan Monnier2001-04-13 15:18:11 +0000823 (if (or (cvs-fileinfo< (ewoc-data tin) fi)
824 (eq (cvs-fileinfo->type fi) 'MESSAGE))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000825 ;; tin < fi < next-tin
826 (ewoc-enter-after c tin fi)
827 ;; fi == tin
828 (cvs-fileinfo-update (ewoc-data tin) fi)
3c7fafc7 Stefan Monnier2000-10-15 05:18:48 +0000829 (ewoc-invalidate c tin)
498ecdde
SM
Stefan Monnier2002-06-25 00:11:28 +0000830 ;; Move cursor back to where it belongs.
831 (when (bolp) (cvs-move-to-goal-column))
3c7fafc7 Stefan Monnier2000-10-15 05:18:48 +0000832 tin))))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000833
6dc7d3d5
SM
Stefan Monnier2000-06-12 04:53:34 +0000834(defcustom cvs-cleanup-functions nil
835 "Functions to tweak the cleanup process.
836The functions are called with a single argument (a FILEINFO) and should
837return a non-nil value if that fileinfo should be removed."
838 :group 'pcl-cvs
839 :type '(hook :options (cvs-cleanup-removed)))
840
841(defun cvs-cleanup-removed (fi)
842 "Non-nil if FI has been cvs-removed but still exists.
843This is intended for use on `cvs-cleanup-functions' when you have cvs-removed
844automatically generated files (which should hence not be under CVS control)
845but can't commit the removal because the repository's owner doesn't understand
846the problem."
847 (and (or (eq (cvs-fileinfo->type fi) 'REMOVED)
848 (and (eq (cvs-fileinfo->type fi) 'CONFLICT)
849 (eq (cvs-fileinfo->subtype fi) 'REMOVED)))
2231c2bc Stefan Monnier2005-04-26 20:37:31 +0000850 (file-exists-p (cvs-fileinfo->full-name fi))))
6dc7d3d5 Stefan Monnier2000-06-12 04:53:34 +0000851
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000852;; called at the following times:
853;; - postparse ((eq cvs-auto-remove-handled t) cvs-auto-remove-directories nil)
854;; - pre-run ((eq cvs-auto-remove-handled 'delayed) nil t)
855;; - remove-handled (t (or cvs-auto-remove-directories 'handled) t)
856;; - cvs-cmd-do (nil nil t)
857;; - post-ignore (nil nil nil)
858;; - acknowledge (nil nil nil)
859;; - remove (nil nil nil)
860(defun cvs-cleanup-collection (c rm-handled rm-dirs rm-msgs)
861 "Remove undesired entries.
862C is the collection
1c851e98
SM
Stefan Monnier2013-01-08 12:34:35 -0500863RM-HANDLED if non-nil means remove handled entries (if file is currently
864 visited, only remove if value is `all').
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000865RM-DIRS behaves like `cvs-auto-remove-directories'.
866RM-MSGS if non-nil means remove messages."
867 (let (last-fi first-dir (rerun t))
868 (while rerun
869 (setq rerun nil)
870 (setq first-dir t)
871 (setq last-fi (cvs-create-fileinfo 'DEAD "../" "" "")) ;place-holder
872 (ewoc-filter
873 c (lambda (fi)
874 (let* ((type (cvs-fileinfo->type fi))
875 (subtype (cvs-fileinfo->subtype fi))
876 (keep
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -0400877 (pcase type
1c851e98 Stefan Monnier2013-01-08 12:34:35 -0500878 ;; Remove temp messages and keep the others.
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -0400879 (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP))))
1c851e98 Stefan Monnier2013-01-08 12:34:35 -0500880 ;; Remove dead entries.
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -0400881 (`DEAD nil)
1c851e98 Stefan Monnier2013-01-08 12:34:35 -0500882 ;; Handled also?
e01c13fe Stefan Monnier2012-09-29 23:44:35 -0400883 (`UP-TO-DATE
1c851e98
SM
Stefan Monnier2013-01-08 12:34:35 -0500884 (not
885 (if (find-buffer-visiting (cvs-fileinfo->full-name fi))
886 (eq rm-handled 'all)
887 rm-handled)))
888 ;; Keep the rest.
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -0400889 (_ (not (run-hook-with-args-until-success
6dc7d3d5 Stefan Monnier2000-06-12 04:53:34 +0000890 'cvs-cleanup-functions fi))))))
027b73ac Sam Steingold2000-08-03 18:11:47 +0000891
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000892 ;; mark dirs for removal
893 (when (and keep rm-dirs
894 (eq (cvs-fileinfo->type last-fi) 'DIRCHANGE)
895 (not (when first-dir (setq first-dir nil) t))
896 (or (eq rm-dirs 'all)
121b8917 Glenn Morris2012-04-16 19:57:09 -0400897 (not (string-prefix-p
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000898 (cvs-fileinfo->dir last-fi)
899 (cvs-fileinfo->dir fi)))
900 (and (eq type 'DIRCHANGE) (eq rm-dirs 'empty))
901 (eq subtype 'FOOTER)))
902 (setf (cvs-fileinfo->type last-fi) 'DEAD)
903 (setq rerun t))
b15b5618
SM
Stefan Monnier2000-05-10 22:28:36 +0000904 (when keep (setq last-fi fi)))))
905 ;; remove empty last dir
906 (when (and rm-dirs
907 (not first-dir)
908 (eq (cvs-fileinfo->type last-fi) 'DIRCHANGE))
909 (setf (cvs-fileinfo->type last-fi) 'DEAD)
910 (setq rerun t)))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000911
912(defun cvs-get-cvsroot ()
5983b317 Juanma Barranquero2014-03-12 05:00:03 +0100913 "Get the CVSROOT for DIR."
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000914 (let ((cvs-cvsroot-file (expand-file-name "Root" "CVS")))
915 (or (cvs-file-to-string cvs-cvsroot-file t)
916 cvs-cvsroot
917 (getenv "CVSROOT")
918 "?????")))
919
920(defun cvs-get-module ()
921 "Return the current CVS module.
922This usually doesn't really work but is a handy initval in a prompt."
923 (let* ((repfile (expand-file-name "Repository" "CVS"))
924 (rep (cvs-file-to-string repfile t)))
925 (cond
926 ((null rep) "")
927 ((not (file-name-absolute-p rep)) rep)
928 (t
929 (let* ((root (cvs-get-cvsroot))
930 (str (concat (file-name-as-directory (or root "/")) " || " rep)))
931 (if (and root (string-match "\\(.*\\) || \\1\\(.*\\)\\'" str))
932 (match-string 2 str)
933 (file-name-nondirectory rep)))))))
934
935
936\f
937;;;;
938;;;; running a "cvs checkout".
939;;;;
940
941;;;###autoload
59bb9410 Stefan Monnier2005-04-03 21:18:51 +0000942(defun cvs-checkout (modules dir flags &optional root)
5983b317 Juanma Barranquero2014-03-12 05:00:03 +0100943 "Run a `cvs checkout MODULES' in DIR.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000944Feed the output to a *cvs* buffer, display it in the current window,
945and run `cvs-mode' on it.
946
947With a prefix argument, prompt for cvs FLAGS to use."
948 (interactive
59bb9410
SM
Stefan Monnier2005-04-03 21:18:51 +0000949 (let ((root (cvs-get-cvsroot)))
950 (if (or (null root) current-prefix-arg)
951 (setq root (read-string "CVS Root: ")))
ad4fed11
RS
Richard M. Stallman2007-08-12 18:11:57 +0000952 (list (split-string-and-unquote
953 (read-string "Module(s): " (cvs-get-module)))
59bb9410
SM
Stefan Monnier2005-04-03 21:18:51 +0000954 (read-directory-name "CVS Checkout Directory: "
955 nil default-directory nil)
956 (cvs-add-branch-prefix
957 (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags"))
958 root)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000959 (when (eq flags t)
960 (setf flags (cvs-flags-query 'cvs-checkout-flags nil 'noquery)))
59bb9410
SM
Stefan Monnier2005-04-03 21:18:51 +0000961 (let ((cvs-cvsroot root))
962 (cvs-cmd-do "checkout" (or dir default-directory)
963 (append flags modules) nil 'new
964 :noexist t)))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000965
38400c2a Stefan Monnier2004-11-11 23:45:52 +0000966(defun-cvs-mode (cvs-mode-checkout . NOARGS) (dir)
5983b317 Juanma Barranquero2014-03-12 05:00:03 +0100967 "Run `cvs checkout' against the current branch.
38400c2a Stefan Monnier2004-11-11 23:45:52 +0000968The files are stored to DIR."
e248903c Juanma Barranquero2005-06-14 15:20:05 +0000969 (interactive
38400c2a Stefan Monnier2004-11-11 23:45:52 +0000970 (let* ((branch (cvs-prefix-get 'cvs-branch-prefix))
e248903c Juanma Barranquero2005-06-14 15:20:05 +0000971 (prompt (format "CVS Checkout Directory for `%s%s': "
38400c2a
SM
Stefan Monnier2004-11-11 23:45:52 +0000972 (cvs-get-module)
973 (if branch (format " (branch: %s)" branch)
974 ""))))
975 (list (read-directory-name prompt nil default-directory nil))))
ad4fed11 Richard M. Stallman2007-08-12 18:11:57 +0000976 (let ((modules (split-string-and-unquote (cvs-get-module)))
38400c2a
SM
Stefan Monnier2004-11-11 23:45:52 +0000977 (flags (cvs-add-branch-prefix
978 (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags")))
979 (cvs-cvsroot (cvs-get-cvsroot)))
980 (cvs-checkout modules dir flags)))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000981\f
027b73ac Sam Steingold2000-08-03 18:11:47 +0000982;;;;
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000983;;;; The code for running a "cvs update" and friends in various ways.
027b73ac Sam Steingold2000-08-03 18:11:47 +0000984;;;;
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000985
986(defun-cvs-mode (cvs-mode-revert-buffer . SIMPLE)
6c42fc3e Daniel Hackney2013-09-04 23:30:07 -0400987 (&optional _ignore-auto _noconfirm)
f3d73dc9 Dave Love2001-01-26 20:46:42 +0000988 "Rerun `cvs-examine' on the current directory with the default flags."
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +0000989 (interactive)
990 (cvs-examine default-directory t))
991
f29897bb
RS
Reiner Steib2007-08-25 12:25:50 +0000992(defun cvs-query-directory (prompt)
993 "Read directory name, prompting with PROMPT.
994If in a *cvs* buffer, don't prompt unless a prefix argument is given."
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000995 (if (and (cvs-buffer-p)
f29897bb Reiner Steib2007-08-25 12:25:50 +0000996 (not current-prefix-arg))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000997 default-directory
f29897bb Reiner Steib2007-08-25 12:25:50 +0000998 (read-directory-name prompt nil default-directory nil)))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +0000999
6dc7d3d5 Stefan Monnier2000-06-12 04:53:34 +00001000;;;###autoload
6c42fc3e Daniel Hackney2013-09-04 23:30:07 -04001001(defun cvs-quickdir (dir &optional _flags noshow)
6dc7d3d5
SM
Stefan Monnier2000-06-12 04:53:34 +00001002 "Open a *cvs* buffer on DIR without running cvs.
1003With a prefix argument, prompt for a directory to use.
1004A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
1005 prevents reuse of an existing *cvs* buffer.
1006Optional argument NOSHOW if non-nil means not to display the buffer.
1007FLAGS is ignored."
1008 (interactive (list (cvs-query-directory "CVS quickdir (directory): ")))
1009 ;; FIXME: code duplication with cvs-cmd-do and cvs-parse-process
1010 (let* ((dir (file-name-as-directory
1011 (abbreviate-file-name (expand-file-name dir))))
1012 (new (> (prefix-numeric-value current-prefix-arg) 8))
1013 (cvsbuf (cvs-make-cvs-buffer dir new))
1014 last)
1015 ;; Check that dir is under CVS control.
1016 (unless (file-directory-p dir)
1017 (error "%s is not a directory" dir))
1018 (unless (file-directory-p (expand-file-name "CVS" dir))
1019 (error "%s does not contain CVS controlled files" dir))
1020 (set-buffer cvsbuf)
1021 (dolist (fi (cvs-fileinfo-from-entries ""))
1022 (setq last (cvs-addto-collection cvs-cookies fi last)))
1023 (cvs-cleanup-collection cvs-cookies
1024 (eq cvs-auto-remove-handled t)
1025 cvs-auto-remove-directories
1026 nil)
1027 (if noshow cvsbuf
1028 (let ((pop-up-windows nil)) (pop-to-buffer cvsbuf)))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001029
1030;;;###autoload
1031(defun cvs-examine (directory flags &optional noshow)
1032 "Run a `cvs -n update' in the specified DIRECTORY.
1033That is, check what needs to be done, but don't change the disc.
1034Feed the output to a *cvs* buffer and run `cvs-mode' on it.
1035With a prefix argument, prompt for a directory and cvs FLAGS to use.
1036A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
1037 prevents reuse of an existing *cvs* buffer.
1038Optional argument NOSHOW if non-nil means not to display the buffer."
1039 (interactive (list (cvs-query-directory "CVS Examine (directory): ")
1040 (cvs-flags-query 'cvs-update-flags "cvs -n update flags")))
1041 (when (eq flags t)
1042 (setf flags (cvs-flags-query 'cvs-update-flags nil 'noquery)))
160181b8 Sam Steingold2003-04-20 22:03:00 +00001043 (when find-file-visit-truename (setq directory (file-truename directory)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001044 (cvs-cmd-do "update" directory flags nil
1045 (> (prefix-numeric-value current-prefix-arg) 8)
1046 :cvsargs '("-n")
1047 :noshow noshow
1048 :dont-change-disc t))
1049
1050
1051;;;###autoload
1052(defun cvs-update (directory flags)
1053 "Run a `cvs update' in the current working DIRECTORY.
1054Feed the output to a *cvs* buffer and run `cvs-mode' on it.
3dcdb054 Stefan Monnier2002-10-01 18:48:35 +00001055With a \\[universal-argument] prefix argument, prompt for a directory to use.
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001056A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
3dcdb054
SM
Stefan Monnier2002-10-01 18:48:35 +00001057 prevents reuse of an existing *cvs* buffer.
1058The prefix is also passed to `cvs-flags-query' to select the FLAGS
1059 passed to cvs."
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001060 (interactive (list (cvs-query-directory "CVS Update (directory): ")
1061 (cvs-flags-query 'cvs-update-flags "cvs update flags")))
1062 (when (eq flags t)
1063 (setf flags (cvs-flags-query 'cvs-update-flags nil 'noquery)))
1064 (cvs-cmd-do "update" directory flags nil
1065 (> (prefix-numeric-value current-prefix-arg) 8)))
1066
1067
1068;;;###autoload
1069(defun cvs-status (directory flags &optional noshow)
1070 "Run a `cvs status' in the current working DIRECTORY.
1071Feed the output to a *cvs* buffer and run `cvs-mode' on it.
1072With a prefix argument, prompt for a directory and cvs FLAGS to use.
1073A prefix arg >8 (ex: \\[universal-argument] \\[universal-argument]),
1074 prevents reuse of an existing *cvs* buffer.
1075Optional argument NOSHOW if non-nil means not to display the buffer."
1076 (interactive (list (cvs-query-directory "CVS Status (directory): ")
1077 (cvs-flags-query 'cvs-status-flags "cvs status flags")))
1078 (when (eq flags t)
1079 (setf flags (cvs-flags-query 'cvs-status-flags nil 'noquery)))
1080 (cvs-cmd-do "status" directory flags nil
1081 (> (prefix-numeric-value current-prefix-arg) 8)
1082 :noshow noshow :dont-change-disc t))
1083
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001084(defun cvs-update-filter (proc string)
5983b317 Juanma Barranquero2014-03-12 05:00:03 +01001085 "Filter function for PCL-CVS.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001086This function gets the output that CVS sends to stdout. It inserts
1087the STRING into (process-buffer PROC) but it also checks if CVS is waiting
1088for a lock file. If so, it inserts a message cookie in the *cvs* buffer."
1089 (save-match-data
1090 (with-current-buffer (process-buffer proc)
1091 (let ((inhibit-read-only t))
1092 (save-excursion
1093 ;; Insert the text, moving the process-marker.
1094 (goto-char (process-mark proc))
1095 (insert string)
1096 (set-marker (process-mark proc) (point))
1097 ;; FIXME: Delete any old lock message
1098 ;;(if (tin-nth cookies 1)
1099 ;; (tin-delete cookies
1100 ;; (tin-nth cookies 1)))
1101 ;; Check if CVS is waiting for a lock.
316e1d5b Stefan Monnier2000-11-06 07:17:33 +00001102 (beginning-of-line 0) ;Move to beginning of last complete line.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001103 (when (looking-at "^[ a-z]+: \\(.*waiting for .*lock in \\(.*\\)\\)$")
1104 (let ((msg (match-string 1))
1105 (lock (match-string 2)))
1106 (with-current-buffer cvs-buffer
1107 (set (make-local-variable 'cvs-lock-file) lock)
1108 ;; display the lock situation in the *cvs* buffer:
1109 (ewoc-enter-last
1110 cvs-cookies
1111 (cvs-create-fileinfo
1112 'MESSAGE "" " "
1113 (concat msg
be0add30
SM
Stefan Monnier2001-04-13 15:18:11 +00001114 (when (file-exists-p lock)
1115 (substitute-command-keys
1116 "\n\t(type \\[cvs-mode-delete-lock] to delete it)")))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001117 :subtype 'TEMP))
1118 (pop-to-buffer (current-buffer))
1119 (goto-char (point-max))
1120 (beep)))))))))
1121
1122\f
1123;;;;
1124;;;; The cvs-mode and its associated commands.
1125;;;;
1126
1127(cvs-prefix-define cvs-force-command "" "" '("/F") cvs-qtypedesc-string1)
1128(defun-cvs-mode cvs-mode-force-command (arg)
1129 "Force the next cvs command to operate on all the selected files.
1130By default, cvs commands only operate on files on which the command
1131\"makes sense\". This overrides the safety feature on the next cvs command.
1132It actually behaves as a toggle. If prefixed by \\[universal-argument] \\[universal-argument],
1133the override will persist until the next toggle."
1134 (interactive "P")
1135 (cvs-prefix-set 'cvs-force-command arg))
1136
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001137(put 'cvs-mode 'mode-class 'special)
94d79fb4 Stefan Monnier2003-05-13 15:22:39 +00001138(define-derived-mode cvs-mode nil "CVS"
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001139 "Mode used for PCL-CVS, a frontend to CVS.
cb3430a1 Stefan Monnier2000-03-22 02:57:23 +00001140Full documentation is in the Texinfo file."
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001141 (setq mode-line-process
1142 '("" cvs-force-command cvs-ignore-marks-modif
1143 ":" (cvs-branch-prefix
1144 ("" cvs-branch-prefix (cvs-secondary-branch-prefix
1145 ("->" cvs-secondary-branch-prefix))))
1146 " " cvs-mode-line-process))
94d79fb4 Stefan Monnier2003-05-13 15:22:39 +00001147 (if buffer-file-name
e248903c Juanma Barranquero2005-06-14 15:20:05 +00001148 (error "Use M-x cvs-quickdir to get a *cvs* buffer"))
6b2e4334 Stefan Monnier2002-09-03 01:40:29 +00001149 (buffer-disable-undo)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001150 ;;(set (make-local-variable 'goal-column) cvs-cursor-column)
1151 (set (make-local-variable 'revert-buffer-function) 'cvs-mode-revert-buffer)
cb3430a1 Stefan Monnier2000-03-22 02:57:23 +00001152 (setq truncate-lines t)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001153 (cvs-prefix-make-local 'cvs-branch-prefix)
1154 (cvs-prefix-make-local 'cvs-secondary-branch-prefix)
1155 (cvs-prefix-make-local 'cvs-force-command)
1156 (cvs-prefix-make-local 'cvs-ignore-marks-modif)
1157 (make-local-variable 'cvs-mode-line-process)
1158 (make-local-variable 'cvs-temp-buffers))
1159
1160
1161(defun cvs-buffer-p (&optional buffer)
1162 "Return whether the (by default current) BUFFER is a `cvs-mode' buffer."
1163 (save-excursion
1164 (if buffer (set-buffer buffer))
1165 (and (eq major-mode 'cvs-mode))))
1166
1167(defun cvs-buffer-check ()
1168 "Check that the current buffer follows cvs-buffer's conventions."
1169 (let ((buf (current-buffer))
1170 (check 'none))
1171 (or (and (setq check 'collection)
1172 (eq (ewoc-buffer cvs-cookies) buf)
1173 (setq check 'cvs-temp-buffer)
1174 (or (null cvs-temp-buffer)
8f53f317 Stefan Monnier2005-04-01 17:58:09 +00001175 (null (buffer-live-p cvs-temp-buffer))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001176 (and (eq (with-current-buffer cvs-temp-buffer cvs-buffer) buf)
1177 (equal (with-current-buffer cvs-temp-buffer
1178 default-directory)
1179 default-directory)))
1180 t)
1181 (error "Inconsistent %s in buffer %s" check (buffer-name buf)))))
1182
1183
ee8d23ee Stefan Monnier2000-12-08 16:58:57 +00001184(defun cvs-mode-quit ()
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001185 "Quit PCL-CVS, killing the *cvs* buffer."
1186 (interactive)
1187 (and (y-or-n-p "Quit pcl-cvs? ") (kill-buffer (current-buffer))))
1188
1189;; Give help....
1190
1191(defun cvs-help ()
1192 "Display help for various PCL-CVS commands."
1193 (interactive)
1194 (if (eq last-command 'cvs-help)
ca98cd37 Stefan Monnier2000-12-10 21:20:56 +00001195 (describe-function 'cvs-mode) ; would need minor-mode for log-edit-mode
8a26c165 Deepak Goel2005-09-18 12:25:02 +00001196 (message "%s"
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001197 (substitute-command-keys
1198 "`\\[cvs-help]':help `\\[cvs-mode-add]':add `\\[cvs-mode-commit]':commit \
1199`\\[cvs-mode-diff-map]':diff* `\\[cvs-mode-log]':log \
1200`\\[cvs-mode-remove]':remove `\\[cvs-mode-status]':status \
1201`\\[cvs-mode-undo]':undo"))))
1202
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001203;; Move around in the buffer
1204
498ecdde
SM
Stefan Monnier2002-06-25 00:11:28 +00001205(defun cvs-move-to-goal-column ()
1206 (let* ((eol (line-end-position))
1207 (fpos (next-single-property-change (point) 'cvs-goal-column nil eol)))
1208 (when (< fpos eol)
1209 (goto-char fpos))))
1210
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001211(defun-cvs-mode cvs-mode-previous-line (arg)
1212 "Go to the previous line.
1213If a prefix argument is given, move by that many lines."
1214 (interactive "p")
6efa25a1 Kai Großjohann2002-04-03 16:56:36 +00001215 (ewoc-goto-prev cvs-cookies arg)
498ecdde Stefan Monnier2002-06-25 00:11:28 +00001216 (cvs-move-to-goal-column))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001217
1218(defun-cvs-mode cvs-mode-next-line (arg)
1219 "Go to the next line.
1220If a prefix argument is given, move by that many lines."
1221 (interactive "p")
6efa25a1 Kai Großjohann2002-04-03 16:56:36 +00001222 (ewoc-goto-next cvs-cookies arg)
498ecdde Stefan Monnier2002-06-25 00:11:28 +00001223 (cvs-move-to-goal-column))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001224
027b73ac Sam Steingold2000-08-03 18:11:47 +00001225;;;;
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001226;;;; Mark handling
027b73ac Sam Steingold2000-08-03 18:11:47 +00001227;;;;
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001228
1229(defun-cvs-mode cvs-mode-mark (&optional arg)
1230 "Mark the fileinfo on the current line.
1231If the fileinfo is a directory, all the contents of that directory are
5983b317 Juanma Barranquero2014-03-12 05:00:03 +01001232marked instead. A directory can never be marked."
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001233 (interactive)
44946a4c Stefan Monnier2000-08-16 20:27:39 +00001234 (let* ((tin (ewoc-locate cvs-cookies))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001235 (fi (ewoc-data tin)))
1236 (if (eq (cvs-fileinfo->type fi) 'DIRCHANGE)
1237 ;; it's a directory: let's mark all files inside
1238 (ewoc-map
1239 (lambda (f dir)
1240 (when (cvs-dir-member-p f dir)
1241 (setf (cvs-fileinfo->marked f)
1242 (not (if (eq arg 'toggle) (cvs-fileinfo->marked f) arg)))
316e1d5b Stefan Monnier2000-11-06 07:17:33 +00001243 t)) ;Tell cookie to redisplay this cookie.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001244 cvs-cookies
1245 (cvs-fileinfo->dir fi))
1246 ;; not a directory: just do the obvious
1247 (setf (cvs-fileinfo->marked fi)
1248 (not (if (eq arg 'toggle) (cvs-fileinfo->marked fi) arg)))
1249 (ewoc-invalidate cvs-cookies tin)
1250 (cvs-mode-next-line 1))))
1251
6dfa5acf
SM
Stefan Monnier2004-04-14 17:36:09 +00001252(defalias 'cvs-mouse-toggle-mark 'cvs-mode-toggle-mark)
1253(defun cvs-mode-toggle-mark (e)
1254 "Toggle the mark of the entry at point."
1255 (interactive (list last-input-event))
44946a4c Stefan Monnier2000-08-16 20:27:39 +00001256 (save-excursion
6dfa5acf Stefan Monnier2004-04-14 17:36:09 +00001257 (posn-set-point (event-end e))
44946a4c Stefan Monnier2000-08-16 20:27:39 +00001258 (cvs-mode-mark 'toggle)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001259
1260(defun-cvs-mode cvs-mode-unmark ()
1261 "Unmark the fileinfo on the current line."
1262 (interactive)
1263 (cvs-mode-mark t))
1264
1265(defun-cvs-mode cvs-mode-mark-all-files ()
1266 "Mark all files."
1267 (interactive)
1268 (ewoc-map (lambda (cookie)
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +00001269 (unless (eq (cvs-fileinfo->type cookie) 'DIRCHANGE)
1270 (setf (cvs-fileinfo->marked cookie) t)))
1271 cvs-cookies))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001272
be0add30
SM
Stefan Monnier2001-04-13 15:18:11 +00001273(defun-cvs-mode (cvs-mode-mark-on-state . SIMPLE) (state)
1274 "Mark all files in state STATE."
1275 (interactive
1276 (list
1277 (let ((default
1278 (condition-case nil
1279 (downcase
1280 (symbol-name
1281 (cvs-fileinfo->type
1282 (cvs-mode-marked nil nil :read-only t :one t :noquery t))))
1283 (error nil))))
1284 (intern
1285 (upcase
1286 (completing-read
1287 (concat
1288 "Mark files in state" (if default (concat " [" default "]")) ": ")
1289 (mapcar (lambda (x)
1290 (list (downcase (symbol-name (car x)))))
1291 cvs-states)
1292 nil t nil nil default))))))
1293 (ewoc-map (lambda (fi)
1294 (when (eq (cvs-fileinfo->type fi) state)
1295 (setf (cvs-fileinfo->marked fi) t)))
1296 cvs-cookies))
1297
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001298(defun-cvs-mode cvs-mode-mark-matching-files (regex)
1299 "Mark all files matching REGEX."
1300 (interactive "sMark files matching: ")
1301 (ewoc-map (lambda (cookie)
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +00001302 (when (and (not (eq (cvs-fileinfo->type cookie) 'DIRCHANGE))
1303 (string-match regex (cvs-fileinfo->file cookie)))
1304 (setf (cvs-fileinfo->marked cookie) t)))
1305 cvs-cookies))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001306
1307(defun-cvs-mode cvs-mode-unmark-all-files ()
1308 "Unmark all files.
1309Directories are also unmarked, but that doesn't matter, since
1310they should always be unmarked."
1311 (interactive)
1312 (ewoc-map (lambda (cookie)
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +00001313 (setf (cvs-fileinfo->marked cookie) nil)
1314 t)
1315 cvs-cookies))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001316
1317(defun-cvs-mode cvs-mode-unmark-up ()
1318 "Unmark the file on the previous line."
1319 (interactive)
44946a4c Stefan Monnier2000-08-16 20:27:39 +00001320 (let ((tin (ewoc-goto-prev cvs-cookies 1)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001321 (when tin
1322 (setf (cvs-fileinfo->marked (ewoc-data tin)) nil)
d3ffebbc
TTN
Thien-Thi Nguyen2003-09-29 14:40:28 +00001323 (ewoc-invalidate cvs-cookies tin)))
1324 (cvs-move-to-goal-column))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001325
1326(defconst cvs-ignore-marks-alternatives
1327 '(("toggle-marks" . "/TM")
1328 ("force-marks" . "/FM")
1329 ("ignore-marks" . "/IM")))
1330
1331(cvs-prefix-define cvs-ignore-marks-modif
1332 "Prefix to decide whether to ignore marks or not."
1333 "active"
1334 (mapcar 'cdr cvs-ignore-marks-alternatives)
1335 (cvs-qtypedesc-create
1336 (lambda (str) (cdr (assoc str cvs-ignore-marks-alternatives)))
b47e5116 Stefan Monnier2001-03-07 00:20:30 +00001337 (lambda (obj) (car (rassoc obj cvs-ignore-marks-alternatives)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001338 (lambda () cvs-ignore-marks-alternatives)
1339 nil t))
027b73ac Sam Steingold2000-08-03 18:11:47 +00001340
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001341(defun-cvs-mode cvs-mode-toggle-marks (arg)
1342 "Toggle whether the next CVS command uses marks.
1343See `cvs-prefix-set' for further description of the behavior.
1344\\[universal-argument] 1 selects `force-marks',
1345\\[universal-argument] 2 selects `ignore-marks',
1346\\[universal-argument] 3 selects `toggle-marks'."
1347 (interactive "P")
1348 (cvs-prefix-set 'cvs-ignore-marks-modif arg))
027b73ac Sam Steingold2000-08-03 18:11:47 +00001349
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001350(defun cvs-ignore-marks-p (cmd &optional read-only)
1351 (let ((default (if (member cmd cvs-invert-ignore-marks)
1352 (not cvs-default-ignore-marks)
1353 cvs-default-ignore-marks))
1354 (modif (cvs-prefix-get 'cvs-ignore-marks-modif read-only)))
1355 (cond
1356 ((equal modif "/IM") t)
1357 ((equal modif "/TM") (not default))
1358 ((equal modif "/FM") nil)
1359 (t default))))
1360
1361(defun cvs-mode-mark-get-modif (cmd)
1362 (if (cvs-ignore-marks-p cmd 'read-only) "/IM" "/FM"))
1363
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001364(defun cvs-get-marked (&optional ignore-marks ignore-contents)
1365 "Return a list of all selected fileinfos.
1366If there are any marked tins, and IGNORE-MARKS is nil, return them.
1367Otherwise, if the cursor selects a directory, and IGNORE-CONTENTS is
1368nil, return all files in it, else return just the directory.
1369Otherwise return (a list containing) the file the cursor points to, or
f009f3bc Juanma Barranquero2004-05-09 01:54:01 +00001370an empty list if it doesn't point to a file at all."
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001371 (let ((fis nil))
96190aa1
SM
Stefan Monnier2000-08-09 15:28:06 +00001372 (dolist (fi (if (and (boundp 'cvs-minor-current-files)
1373 (consp cvs-minor-current-files))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001374 (mapcar
1375 (lambda (f)
96190aa1
SM
Stefan Monnier2000-08-09 15:28:06 +00001376 (if (cvs-fileinfo-p f) f
1377 (let ((f (file-relative-name f)))
1378 (if (file-directory-p f)
1379 (cvs-create-fileinfo
1380 'DIRCHANGE (file-name-as-directory f) "." "")
1381 (let ((dir (file-name-directory f))
1382 (file (file-name-nondirectory f)))
1383 (cvs-create-fileinfo
1384 'UNKNOWN (or dir "") file ""))))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001385 cvs-minor-current-files)
1386 (or (and (not ignore-marks)
316e1d5b Stefan Monnier2000-11-06 07:17:33 +00001387 (ewoc-collect cvs-cookies 'cvs-fileinfo->marked))
44946a4c Stefan Monnier2000-08-16 20:27:39 +00001388 (list (ewoc-data (ewoc-locate cvs-cookies))))))
027b73ac Sam Steingold2000-08-03 18:11:47 +00001389
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001390 (if (or ignore-contents (not (eq (cvs-fileinfo->type fi) 'DIRCHANGE)))
1391 (push fi fis)
1392 ;; If a directory is selected, return members, if any.
1393 (setq fis
802cf66c
SM
Stefan Monnier2000-12-11 03:20:29 +00001394 (append (ewoc-collect
1395 cvs-cookies 'cvs-dir-member-p (cvs-fileinfo->dir fi))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001396 fis))))
1397 (nreverse fis)))
1398
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -04001399(cl-defun cvs-mode-marked (filter &optional cmd
5983b317 Juanma Barranquero2014-03-12 05:00:03 +01001400 &key read-only one file noquery)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001401 "Get the list of marked FIS.
1402CMD is used to determine whether to use the marks or not.
1403Only files for which FILTER is applicable are returned.
1404If READ-ONLY is non-nil, the current toggling is left intact.
1405If ONE is non-nil, marks are ignored and a single FI is returned.
1406If FILE is non-nil, directory entries won't be selected."
802cf66c Stefan Monnier2000-12-11 03:20:29 +00001407 (unless cmd (setq cmd (symbol-name filter)))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001408 (let* ((fis (cvs-get-marked (or one (cvs-ignore-marks-p cmd read-only))
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +00001409 (and (not file)
1410 (cvs-applicable-p 'DIRCHANGE filter))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001411 (force (cvs-prefix-get 'cvs-force-command))
1412 (fis (car (cvs-partition
1413 (lambda (fi) (cvs-applicable-p fi (and (not force) filter)))
1414 fis))))
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +00001415 (when (and (or (null fis) (and one (cdr fis))) (not noquery))
1416 (message (if (null fis)
1417 "`%s' is not applicable to any of the selected files."
1418 "`%s' is only applicable to a single file.") cmd)
802cf66c Stefan Monnier2000-12-11 03:20:29 +00001419 (sit-for 1)
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +00001420 (setq fis (list (cvs-insert-file
1421 (read-file-name (format "File to %s: " cmd))))))
1422 (if one (car fis) fis)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001423
1424(defun cvs-enabledp (filter)
1425 "Determine whether FILTER applies to at least one of the selected files."
598dd5ff Stefan Monnier2000-11-09 23:55:05 +00001426 (ignore-errors (cvs-mode-marked filter nil :read-only t :noquery t)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001427
1428(defun cvs-mode-files (&rest -cvs-mode-files-args)
1429 (cvs-mode!
1430 (lambda ()
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00001431 (mapcar 'cvs-fileinfo->full-name
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001432 (apply 'cvs-mode-marked -cvs-mode-files-args)))))
1433
be0add30
SM
Stefan Monnier2001-04-13 15:18:11 +00001434;;
1435;; Interface between Log-Edit and PCL-CVS
1436;;
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001437
1438(defun cvs-mode-commit-setup ()
1439 "Run `cvs-mode-commit' with setup."
1440 (interactive)
1441 (cvs-mode-commit 'force))
1442
98a68b08
SM
Stefan Monnier2001-10-30 04:41:28 +00001443(defcustom cvs-mode-commit-hook nil
1444 "Hook run after setting up the commit buffer."
1445 :type 'hook
00821115
MR
Markus Rost2002-11-18 20:56:45 +00001446 :options '(cvs-mode-diff)
1447 :group 'pcl-cvs)
98a68b08 Stefan Monnier2001-10-30 04:41:28 +00001448
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001449(defun cvs-mode-commit (setup)
1450 "Check in all marked files, or the current file.
1451The user will be asked for a log message in a buffer.
1452The buffer's mode and name is determined by the \"message\" setting
1453 of `cvs-buffer-name-alist'.
ca98cd37 Stefan Monnier2000-12-10 21:20:56 +00001454The POSTPROC specified there (typically `log-edit') is then called,
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001455 passing it the SETUP argument."
1456 (interactive "P")
1457 ;; It seems that the save-excursion that happens if I use the better
1458 ;; form of `(cvs-mode! (lambda ...))' screws up a couple things which
ca98cd37 Stefan Monnier2000-12-10 21:20:56 +00001459 ;; end up being rather annoying (like log-edit-mode's message being
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001460 ;; displayed in the wrong minibuffer).
1461 (cvs-mode!)
ca98cd37 Stefan Monnier2000-12-10 21:20:56 +00001462 (let ((buf (cvs-temp-buffer "message" 'normal 'nosetup))
dedffa6a Gerd Moellmann2000-08-06 09:18:02 +00001463 (setupfun (or (nth 2 (cdr (assoc "message" cvs-buffer-name-alist)))
ca98cd37 Stefan Monnier2000-12-10 21:20:56 +00001464 'log-edit)))
11ee8d90 Juanma Barranquero2009-09-25 04:35:14 +00001465 (funcall setupfun 'cvs-do-commit setup
43202f8a
DN
Dan Nicolaescu2007-12-02 17:56:03 +00001466 '((log-edit-listfun . cvs-commit-filelist)
1467 (log-edit-diff-function . cvs-mode-diff)) buf)
ca98cd37 Stefan Monnier2000-12-10 21:20:56 +00001468 (set (make-local-variable 'cvs-minor-wrap-function) 'cvs-commit-minor-wrap)
98a68b08 Stefan Monnier2001-10-30 04:41:28 +00001469 (run-hooks 'cvs-mode-commit-hook)))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001470
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -04001471(defun cvs-commit-minor-wrap (_buf f)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001472 (let ((cvs-ignore-marks-modif (cvs-mode-mark-get-modif "commit")))
1473 (funcall f)))
1474
598dd5ff
SM
Stefan Monnier2000-11-09 23:55:05 +00001475(defun cvs-commit-filelist ()
1476 (cvs-mode-files 'commit nil :read-only t :file t :noquery t))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001477
1478(defun cvs-do-commit (flags)
1479 "Do the actual commit, using the current buffer as the log message."
1480 (interactive (list (cvs-flags-query 'cvs-commit-flags "cvs commit flags")))
027b73ac Sam Steingold2000-08-03 18:11:47 +00001481 (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001482 (cvs-mode!)
1483 ;;(pop-to-buffer cvs-buffer)
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -04001484 (cvs-mode-do "commit" `("-m" ,msg ,@flags) 'commit)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001485
1486
6b2e4334
SM
Stefan Monnier2002-09-03 01:40:29 +00001487;;;; Editing existing commit log messages.
1488
1489(defun cvs-edit-log-text-at-point ()
1490 (save-excursion
1491 (end-of-line)
1492 (when (re-search-backward "^revision " nil t)
1493 (forward-line 1)
1494 (if (looking-at "date:") (forward-line 1))
1495 (if (looking-at "branches:") (forward-line 1))
1496 (buffer-substring
1497 (point)
1498 (if (re-search-forward
1499 "^\\(-\\{28\\}\\|=\\{77\\}\\|revision [.0-9]+\\)$"
1500 nil t)
1501 (match-beginning 0)
1502 (point))))))
1503
6a26cf4a Stefan Monnier2003-05-12 18:16:43 +00001504(defvar cvs-edit-log-revision)
bad3da7a
SM
Stefan Monnier2005-10-15 12:04:34 +00001505(defvar cvs-edit-log-files) (put 'cvs-edit-log-files 'permanent-local t)
1506(defun cvs-mode-edit-log (file rev &optional text)
6b2e4334
SM
Stefan Monnier2002-09-03 01:40:29 +00001507 "Edit the log message at point.
1508This is best called from a `log-view-mode' buffer."
1509 (interactive
1510 (list
bad3da7a
SM
Stefan Monnier2005-10-15 12:04:34 +00001511 (or (cvs-mode! (lambda ()
1512 (car (cvs-mode-files nil nil
1513 :read-only t :file t :noquery t))))
1514 (read-string "File name: "))
6b2e4334
SM
Stefan Monnier2002-09-03 01:40:29 +00001515 (or (cvs-mode! (lambda () (cvs-prefix-get 'cvs-branch-prefix)))
1516 (read-string "Revision to edit: "))
1517 (cvs-edit-log-text-at-point)))
1518 ;; It seems that the save-excursion that happens if I use the better
1519 ;; form of `(cvs-mode! (lambda ...))' screws up a couple things which
1520 ;; end up being rather annoying (like log-edit-mode's message being
1521 ;; displayed in the wrong minibuffer).
1522 (cvs-mode!)
1523 (let ((buf (cvs-temp-buffer "message" 'normal 'nosetup))
6b2e4334
SM
Stefan Monnier2002-09-03 01:40:29 +00001524 (setupfun (or (nth 2 (cdr (assoc "message" cvs-buffer-name-alist)))
1525 'log-edit)))
bad3da7a
SM
Stefan Monnier2005-10-15 12:04:34 +00001526 (with-current-buffer buf
1527 ;; Set the filename before, so log-edit can correctly setup its
1528 ;; log-edit-initial-files variable.
1529 (set (make-local-variable 'cvs-edit-log-files) (list file)))
11ee8d90 Juanma Barranquero2009-09-25 04:35:14 +00001530 (funcall setupfun 'cvs-do-edit-log nil
43202f8a
DN
Dan Nicolaescu2007-12-02 17:56:03 +00001531 '((log-edit-listfun . cvs-edit-log-filelist)
1532 (log-edit-diff-function . cvs-mode-diff))
1533 buf)
6b2e4334
SM
Stefan Monnier2002-09-03 01:40:29 +00001534 (when text (erase-buffer) (insert text))
1535 (set (make-local-variable 'cvs-edit-log-revision) rev)
bad3da7a
SM
Stefan Monnier2005-10-15 12:04:34 +00001536 (set (make-local-variable 'cvs-minor-wrap-function)
1537 'cvs-edit-log-minor-wrap)
6b2e4334
SM
Stefan Monnier2002-09-03 01:40:29 +00001538 ;; (run-hooks 'cvs-mode-commit-hook)
1539 ))
1540
1541(defun cvs-edit-log-minor-wrap (buf f)
bad3da7a
SM
Stefan Monnier2005-10-15 12:04:34 +00001542 (let ((cvs-branch-prefix (with-current-buffer buf cvs-edit-log-revision))
1543 (cvs-minor-current-files
1544 (with-current-buffer buf cvs-edit-log-files))
1545 ;; FIXME: I need to force because the fileinfos are UNKNOWN
1546 (cvs-force-command "/F"))
6b2e4334
SM
Stefan Monnier2002-09-03 01:40:29 +00001547 (funcall f)))
1548
1549(defun cvs-edit-log-filelist ()
bad3da7a
SM
Stefan Monnier2005-10-15 12:04:34 +00001550 (if cvs-minor-wrap-function
1551 (cvs-mode-files nil nil :read-only t :file t :noquery t)
1552 cvs-edit-log-files))
6b2e4334
SM
Stefan Monnier2002-09-03 01:40:29 +00001553
1554(defun cvs-do-edit-log (rev)
1555 "Do the actual commit, using the current buffer as the log message."
1556 (interactive (list cvs-edit-log-revision))
1557 (let ((msg (buffer-substring-no-properties (point-min) (point-max))))
bad3da7a
SM
Stefan Monnier2005-10-15 12:04:34 +00001558 (cvs-mode!
1559 (lambda ()
1560 (cvs-mode-do "admin" (list (concat "-m" rev ":" msg)) nil)))))
6b2e4334
SM
Stefan Monnier2002-09-03 01:40:29 +00001561
1562
027b73ac Sam Steingold2000-08-03 18:11:47 +00001563;;;;
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001564;;;; CVS Mode commands
027b73ac Sam Steingold2000-08-03 18:11:47 +00001565;;;;
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001566
1567(defun-cvs-mode (cvs-mode-insert . NOARGS) (file)
883e7198
SM
Stefan Monnier2002-05-16 20:03:52 +00001568 "Insert an entry for a specific file into the current listing.
1569This is typically used if the file is up-to-date (or has been added
1570outside of PCL-CVS) and one wants to do some operation on it."
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001571 (interactive
be0add30
SM
Stefan Monnier2001-04-13 15:18:11 +00001572 (list (read-file-name
1573 "File to insert: "
1574 ;; Can't use ignore-errors here because interactive
1575 ;; specs aren't byte-compiled.
1576 (condition-case nil
1577 (file-name-as-directory
1578 (expand-file-name
1579 (cvs-fileinfo->dir
1580 (cvs-mode-marked nil nil :read-only t :one t :noquery t))))
1581 (error nil)))))
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +00001582 (cvs-insert-file file))
1583
1584(defun cvs-insert-file (file)
1585 "Insert FILE (and its contents if it's a dir) and return its FI."
6dc7d3d5
SM
Stefan Monnier2000-06-12 04:53:34 +00001586 (let ((file (file-relative-name (directory-file-name file))) last)
1587 (dolist (fi (cvs-fileinfo-from-entries file))
3c7fafc7
SM
Stefan Monnier2000-10-15 05:18:48 +00001588 (setq last (cvs-addto-collection cvs-cookies fi last)))
1589 ;; There should have been at least one entry.
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +00001590 (goto-char (ewoc-location last))
1591 (ewoc-data last)))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001592
274d02f7
SM
Stefan Monnier2001-01-29 20:23:47 +00001593(defun cvs-mark-fis-dead (fis)
1594 ;; Helper function, introduced because of the need for macro-expansion.
1595 (dolist (fi fis)
1596 (setf (cvs-fileinfo->type fi) 'DEAD)))
1597
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001598(defun-cvs-mode (cvs-mode-add . SIMPLE) (flags)
1599 "Add marked files to the cvs repository.
1600With prefix argument, prompt for cvs flags."
1601 (interactive (list (cvs-flags-query 'cvs-add-flags "cvs add flags")))
1602 (let ((fis (cvs-mode-marked 'add))
1603 (needdesc nil) (dirs nil))
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -04001604 ;; Find directories and look for fis needing a description.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001605 (dolist (fi fis)
1606 (cond
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00001607 ((file-directory-p (cvs-fileinfo->full-name fi)) (push fi dirs))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001608 ((eq (cvs-fileinfo->type fi) 'UNKNOWN) (setq needdesc t))))
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -04001609 ;; Prompt for description if necessary.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001610 (let* ((msg (if (and needdesc
1611 (or current-prefix-arg (not cvs-add-default-message)))
1612 (read-from-minibuffer "Enter description: ")
1613 (or cvs-add-default-message "")))
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -04001614 (flags `("-m" ,msg ,@flags))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001615 (postproc
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -04001616 ;; Setup postprocessing for the directory entries.
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001617 (when dirs
cc5da1ec
SM
Stefan Monnier2013-10-07 23:47:24 -04001618 (lambda ()
1619 (cvs-run-process (list "-n" "update")
1620 dirs
1621 (lambda () (cvs-parse-process t)))
1622 (cvs-mark-fis-dead dirs)))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001623 (cvs-mode-run "add" flags fis :postproc postproc))))
1624
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001625(defun-cvs-mode (cvs-mode-diff . DOUBLE) (flags)
1626 "Diff the selected files against the repository.
1627This command compares the files in your working area against the
e01c13fe
SM
Stefan Monnier2012-09-29 23:44:35 -04001628revision which they are based upon.
1629See also `cvs-diff-ignore-marks'."
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001630 (interactive
1631 (list (cvs-add-branch-prefix
1632 (cvs-add-secondary-branch-prefix
1633 (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))))
1634 (cvs-mode-do "diff" flags 'diff
1635 :show t)) ;; :ignore-exit t
1636
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001637(defun-cvs-mode (cvs-mode-diff-head . SIMPLE) (flags)
1638 "Diff the selected files against the head of the current branch.
5983b317 Juanma Barranquero2014-03-12 05:00:03 +01001639See `cvs-mode-diff' for more info."
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001640 (interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
1641 (cvs-mode-diff-1 (cons "-rHEAD" flags)))
1642
9ff78fed
JL
Juri Linkov2004-07-02 04:32:54 +00001643(defun-cvs-mode (cvs-mode-diff-repository . SIMPLE) (flags)
1644 "Diff the files for changes in the repository since last co/update/commit.
5983b317 Juanma Barranquero2014-03-12 05:00:03 +01001645See `cvs-mode-diff' for more info."
9ff78fed
JL
Juri Linkov2004-07-02 04:32:54 +00001646 (interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
1647 (cvs-mode-diff-1 (cons "-rBASE" (cons "-rHEAD" flags))))
1648
a9b10468
KS
Kim F. Storm2004-06-10 08:29:32 +00001649(defun-cvs-mode (cvs-mode-diff-yesterday . SIMPLE) (flags)
1650 "Diff the selected files against yesterday's head of the current branch.
5983b317 Juanma Barranquero2014-03-12 05:00:03 +01001651See `cvs-mode-diff' for more info."
a9b10468
KS
Kim F. Storm2004-06-10 08:29:32 +00001652 (interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
1653 (cvs-mode-diff-1 (cons "-Dyesterday" flags)))
1654
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001655(defun-cvs-mode (cvs-mode-diff-vendor . SIMPLE) (flags)
1656 "Diff the selected files against the head of the vendor branch.
5983b317 Juanma Barranquero2014-03-12 05:00:03 +01001657See `cvs-mode-diff' for more info."
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001658 (interactive (list (cvs-flags-query 'cvs-diff-flags "cvs diff flags")))
1659 (cvs-mode-diff-1 (cons (concat "-r" cvs-vendor-branch) flags)))
1660
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001661;; sadly, this is not provided by cvs, so we have to roll our own
1662(defun-cvs-mode (cvs-mode-diff-backup . SIMPLE) (flags)
1663 "Diff the files against the backup file.
1664This command can be used on files that are marked with \"Merged\"
1665or \"Conflict\" in the *cvs* buffer."
1666 (interactive (list (cvs-flags-query 'cvs-diff-flags "diff flags")))
3afbc435 Pavel Janík2001-07-16 07:46:48 +00001667 (unless (listp flags) (error "flags should be a list of strings"))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001668 (save-some-buffers)
6a26cf4a Stefan Monnier2003-05-12 18:16:43 +00001669 (let* ((marked (cvs-get-marked (cvs-ignore-marks-p "diff")))
598dd5ff Stefan Monnier2000-11-09 23:55:05 +00001670 (fis (car (cvs-partition 'cvs-fileinfo->backup-file marked))))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001671 (unless (consp fis)
316e1d5b Stefan Monnier2000-11-06 07:17:33 +00001672 (error "No files with a backup file selected!"))
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -04001673 (set-buffer (cvs-temp-buffer "diff"))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001674 (message "cvs diff backup...")
1675 (cvs-execute-single-file-list fis 'cvs-diff-backup-extractor
1676 cvs-diff-program flags))
1677 (message "cvs diff backup... Done."))
1678
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001679(defun cvs-diff-backup-extractor (fileinfo)
1680 "Return the filename and the name of the backup file as a list.
1681Signal an error if there is no backup file."
1682 (let ((backup-file (cvs-fileinfo->backup-file fileinfo)))
1683 (unless backup-file
2231c2bc
SM
Stefan Monnier2005-04-26 20:37:31 +00001684 (error "%s has no backup file" (cvs-fileinfo->full-name fileinfo)))
1685 (list backup-file (cvs-fileinfo->full-name fileinfo))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001686
1687;;
1688;; Emerge support
1689;;
1690(defun cvs-emerge-diff (b1 b2) (emerge-buffers b1 b2 b1))
1691(defun cvs-emerge-merge (b1 b2 base out)
1692 (emerge-buffers-with-ancestor b1 b2 base (find-file-noselect out)))
1693
1694;;
1695;; Ediff support
027b73ac Sam Steingold2000-08-03 18:11:47 +00001696;;
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001697
1698(defvar ediff-after-quit-destination-buffer)
6a26cf4a Stefan Monnier2003-05-12 18:16:43 +00001699(defvar ediff-after-quit-hook-internal)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001700(defvar cvs-transient-buffers)
1701(defun cvs-ediff-startup-hook ()
1702 (add-hook 'ediff-after-quit-hook-internal
1703 `(lambda ()
1704 (cvs-ediff-exit-hook
1705 ',ediff-after-quit-destination-buffer ',cvs-transient-buffers))
1706 nil 'local))
1707
1708(defun cvs-ediff-exit-hook (cvs-buf tmp-bufs)
1709 ;; kill the temp buffers (and their associated windows)
1710 (dolist (tb tmp-bufs)
1711 (when (and tb (buffer-live-p tb) (not (buffer-modified-p tb)))
1712 (let ((win (get-buffer-window tb t)))
a7996e05 Stefan Monnier2000-09-29 03:14:36 +00001713 (kill-buffer tb)
eed914af Stefan Monnier2000-10-05 22:45:59 +00001714 (when (window-live-p win) (ignore-errors (delete-window win))))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001715 ;; switch back to the *cvs* buffer
1716 (when (and cvs-buf (buffer-live-p cvs-buf)
1717 (not (get-buffer-window cvs-buf t)))
1718 (ignore-errors (switch-to-buffer cvs-buf))))
1719
1720(defun cvs-ediff-diff (b1 b2)
1721 (let ((ediff-after-quit-destination-buffer (current-buffer))
1722 (startup-hook '(cvs-ediff-startup-hook)))
a7996e05 Stefan Monnier2000-09-29 03:14:36 +00001723 (ediff-buffers b1 b2 startup-hook 'ediff-revision)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001724
1725(defun cvs-ediff-merge (b1 b2 base out)
1726 (let ((ediff-after-quit-destination-buffer (current-buffer))
1727 (startup-hook '(cvs-ediff-startup-hook)))
1728 (ediff-merge-buffers-with-ancestor
1729 b1 b2 base startup-hook
1730 'ediff-merge-revisions-with-ancestor
1731 out)))
1732
1733;;
1734;; Interactive merge/diff support.
1735;;
1736
1737(defun cvs-retrieve-revision (fileinfo rev)
1738 "Retrieve the given REVision of the file in FILEINFO into a new buffer."
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00001739 (let* ((file (cvs-fileinfo->full-name fileinfo))
eed914af
SM
Stefan Monnier2000-10-05 22:45:59 +00001740 (buffile (concat file "." rev)))
1741 (or (find-buffer-visiting buffile)
1742 (with-current-buffer (create-file-buffer buffile)
1743 (message "Retrieving revision %s..." rev)
906cbe45
SM
Stefan Monnier2003-03-16 01:09:05 +00001744 ;; Discard stderr output to work around the CVS+SSH+libc
1745 ;; problem when stdout and stderr are the same.
608f2671
SM
Stefan Monnier2006-06-14 15:38:10 +00001746 (let ((res
1747 (let ((coding-system-for-read 'binary))
62b84d36 Stefan Monnier2007-09-15 02:22:12 +00001748 (apply 'process-file cvs-program nil '(t nil) nil
608f2671
SM
Stefan Monnier2006-06-14 15:38:10 +00001749 "-q" "update" "-p"
1750 ;; If `rev' is HEAD, don't pass it at all:
1751 ;; the default behavior is to get the head
1752 ;; of the current branch whereas "-r HEAD"
1753 ;; stupidly gives you the head of the trunk.
1754 (append (unless (equal rev "HEAD") (list "-r" rev))
1755 (list file))))))
eed914af
SM
Stefan Monnier2000-10-05 22:45:59 +00001756 (when (and res (not (and (equal 0 res))))
1757 (error "Something went wrong retrieving revision %s: %s" rev res))
608f2671
SM
Stefan Monnier2006-06-14 15:38:10 +00001758 ;; Figure out the encoding used and decode the byte-sequence
1759 ;; into a sequence of chars.
1760 (decode-coding-inserted-region
1761 (point-min) (point-max) file t nil nil t)
3c5471b8
SM
Stefan Monnier2006-11-17 02:58:35 +00001762 ;; Set buffer-file-coding-system.
1763 (after-insert-file-set-coding (buffer-size) t)
eed914af
SM
Stefan Monnier2000-10-05 22:45:59 +00001764 (set-buffer-modified-p nil)
1765 (let ((buffer-file-name (expand-file-name file)))
1766 (after-find-file))
dc5d230c Stefan Monnier2012-06-23 11:38:23 -04001767 (setq buffer-read-only t)
eed914af
SM
Stefan Monnier2000-10-05 22:45:59 +00001768 (message "Retrieving revision %s... Done" rev)
1769 (current-buffer))))))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001770
6dc7d3d5
SM
Stefan Monnier2000-06-12 04:53:34 +00001771;; FIXME: The user should be able to specify ancestor/head/backup and we should
1772;; provide sensible defaults when merge info is unavailable (rather than rely
1773;; on smerge-ediff). Also provide sane defaults for need-merge files.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001774(defun-cvs-mode cvs-mode-imerge ()
1775 "Merge interactively appropriate revisions of the selected file."
1776 (interactive)
1777 (let ((fi (cvs-mode-marked 'merge nil :one t :file t)))
1778 (let ((merge (cvs-fileinfo->merge fi))
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00001779 (file (cvs-fileinfo->full-name fi))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001780 (backup-file (cvs-fileinfo->backup-file fi)))
1781 (if (not (and merge backup-file))
1782 (let ((buf (find-file-noselect file)))
1783 (message "Missing merge info or backup file, using VC.")
6dc7d3d5
SM
Stefan Monnier2000-06-12 04:53:34 +00001784 (with-current-buffer buf
1785 (smerge-ediff)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001786 (let* ((ancestor-buf (cvs-retrieve-revision fi (car merge)))
1787 (head-buf (cvs-retrieve-revision fi (cdr merge)))
1788 (backup-buf (let ((auto-mode-alist nil))
1789 (find-file-noselect backup-file)))
1790 ;; this binding is used by cvs-ediff-startup-hook
1791 (cvs-transient-buffers (list ancestor-buf backup-buf head-buf)))
1792 (with-current-buffer backup-buf
1793 (let ((buffer-file-name (expand-file-name file)))
1794 (after-find-file)))
1795 (funcall (cdr cvs-idiff-imerge-handlers)
1796 backup-buf head-buf ancestor-buf file))))))
1797
1798(cvs-flags-define cvs-idiff-version
1799 (list "BASE" cvs-vendor-branch cvs-vendor-branch "BASE" "BASE")
1800 "version: " cvs-qtypedesc-tag)
1801
1802(defun-cvs-mode (cvs-mode-idiff . NOARGS) (&optional rev1 rev2)
1803 "Diff interactively current file to revisions."
1804 (interactive
1805 (let* ((rev1 (cvs-prefix-get 'cvs-branch-prefix))
1806 (rev2 (and rev1 (cvs-prefix-get 'cvs-secondary-branch-prefix))))
1807 (list (or rev1 (cvs-flags-query 'cvs-idiff-version))
1808 rev2)))
1809 (let ((fi (cvs-mode-marked 'diff "idiff" :one t :file t)))
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00001810 (let* ((file (cvs-fileinfo->full-name fi))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001811 (rev1-buf (cvs-retrieve-revision fi (or rev1 "BASE")))
1812 (rev2-buf (if rev2 (cvs-retrieve-revision fi rev2)))
1813 ;; this binding is used by cvs-ediff-startup-hook
1814 (cvs-transient-buffers (list rev1-buf rev2-buf)))
316e1d5b
SM
Stefan Monnier2000-11-06 07:17:33 +00001815 (funcall (car cvs-idiff-imerge-handlers)
1816 rev1-buf (or rev2-buf (find-file-noselect file))))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001817
1818(defun-cvs-mode (cvs-mode-idiff-other . NOARGS) ()
1819 "Diff interactively current file to revisions."
1820 (interactive)
1821 (let* ((rev1 (cvs-prefix-get 'cvs-branch-prefix))
1822 (rev2 (and rev1 (cvs-prefix-get 'cvs-secondary-branch-prefix)))
1823 (fis (cvs-mode-marked 'diff "idiff" :file t)))
1824 (when (> (length fis) 2)
3afbc435 Pavel Janík2001-07-16 07:46:48 +00001825 (error "idiff-other cannot be applied to more than 2 files at a time"))
44946a4c Stefan Monnier2000-08-16 20:27:39 +00001826 (let* ((fi1 (car fis))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001827 (rev1-buf (if rev1 (cvs-retrieve-revision fi1 rev1)
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00001828 (find-file-noselect (cvs-fileinfo->full-name fi1))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001829 rev2-buf)
1830 (if (cdr fis)
dedffa6a Gerd Moellmann2000-08-06 09:18:02 +00001831 (let ((fi2 (nth 1 fis)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001832 (setq rev2-buf
1833 (if rev2 (cvs-retrieve-revision fi2 rev2)
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00001834 (find-file-noselect (cvs-fileinfo->full-name fi2)))))
3afbc435 Pavel Janík2001-07-16 07:46:48 +00001835 (error "idiff-other doesn't know what other file/buffer to use"))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001836 (let* (;; this binding is used by cvs-ediff-startup-hook
1837 (cvs-transient-buffers (list rev1-buf rev2-buf)))
1838 (funcall (car cvs-idiff-imerge-handlers)
1839 rev1-buf rev2-buf)))))
1840
1841
cb3430a1 Stefan Monnier2000-03-22 02:57:23 +00001842(defun cvs-is-within-p (fis dir)
f009f3bc Juanma Barranquero2004-05-09 01:54:01 +00001843 "Non-nil if buffer is inside one of FIS (in DIR)."
cb3430a1
SM
Stefan Monnier2000-03-22 02:57:23 +00001844 (when (stringp buffer-file-name)
1845 (setq buffer-file-name (expand-file-name buffer-file-name))
1846 (let (ret)
1847 (dolist (fi (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." ""))))
121b8917 Glenn Morris2012-04-16 19:57:09 -04001848 (when (string-prefix-p
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00001849 (expand-file-name (cvs-fileinfo->full-name fi) dir)
cb3430a1
SM
Stefan Monnier2000-03-22 02:57:23 +00001850 buffer-file-name)
1851 (setq ret t)))
1852 ret)))
1853
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -04001854(cl-defun cvs-mode-run (cmd flags fis
cc5da1ec
SM
Stefan Monnier2013-10-07 23:47:24 -04001855 &key (buf (cvs-temp-buffer))
1856 dont-change-disc cvsargs postproc)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001857 "Generic cvs-mode-<foo> function.
1858Executes `cvs CVSARGS CMD FLAGS FIS'.
1859BUF is the buffer to be used for cvs' output.
1860DONT-CHANGE-DISC non-nil indicates that the command will not change the
1861 contents of files. This is only used by the parser.
cc5da1ec
SM
Stefan Monnier2013-10-07 23:47:24 -04001862POSTPROC is a function of no argument to be evaluated at the very end (after
1863 parsing if applicable)."
1864 (unless postproc (setq postproc #'ignore))
cb3430a1
SM
Stefan Monnier2000-03-22 02:57:23 +00001865 (let ((def-dir default-directory))
1866 ;; Save the relevant buffers
1867 (save-some-buffers nil (lambda () (cvs-is-within-p fis def-dir))))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001868 (unless (listp flags) (error "flags should be a list of strings"))
30c91af1
SM
Stefan Monnier2002-11-13 20:19:38 +00001869 ;; Some w32 versions of CVS don't like an explicit . too much.
1870 (when (and (car fis) (null (cdr fis))
1871 (eq (cvs-fileinfo->type (car fis)) 'DIRCHANGE)
1872 ;; (equal (cvs-fileinfo->file (car fis)) ".")
1873 (equal (cvs-fileinfo->dir (car fis)) ""))
1874 (setq fis nil))
6a26cf4a Stefan Monnier2003-05-12 18:16:43 +00001875 (let* ((single-dir (or (not (listp cvs-execute-single-dir))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001876 (member cmd cvs-execute-single-dir)))
1877 (parse (member cmd cvs-parse-known-commands))
1878 (args (append cvsargs (list cmd) flags))
dedffa6a Gerd Moellmann2000-08-06 09:18:02 +00001879 (after-mode (nth 2 (cdr (assoc cmd cvs-buffer-name-alist)))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001880 (cvs-cleanup-collection cvs-cookies ;cleanup remaining messages
1881 (eq cvs-auto-remove-handled 'delayed) nil t)
1882 (when (fboundp after-mode)
cc5da1ec
SM
Stefan Monnier2013-10-07 23:47:24 -04001883 (setq postproc (let ((pp postproc))
1884 (lambda () (funcall pp) (funcall after-mode)))))
a399e814
SM
Stefan Monnier2002-06-24 22:49:38 +00001885 (when parse
1886 (let ((old-fis
1887 (when (member cmd '("status" "update")) ;FIXME: Yuck!!
1888 ;; absence of `cvs update' output has a specific meaning.
cc5da1ec
SM
Stefan Monnier2013-10-07 23:47:24 -04001889 (or fis (list (cvs-create-fileinfo 'DIRCHANGE "" "." "")))))
1890 (pp postproc))
1891 (setq postproc (lambda ()
1892 (cvs-parse-process dont-change-disc nil old-fis)
1893 (funcall pp)))))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001894 (with-current-buffer buf
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001895 (let ((inhibit-read-only t)) (erase-buffer))
1896 (message "Running cvs %s ..." cmd)
1897 (cvs-run-process args fis postproc single-dir))))
1898
1899
f58e0fd5 Stefan Monnier2012-07-10 07:51:54 -04001900(cl-defun cvs-mode-do (cmd flags filter
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -04001901 &key show dont-change-disc cvsargs postproc)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001902 "Generic cvs-mode-<foo> function.
1903Executes `cvs CVSARGS CMD FLAGS' on the selected files.
1904FILTER is passed to `cvs-applicable-p' to only apply the command to
1905 files for which it makes sense.
1906SHOW indicates that CMD should be not be run in the default temp buffer and
5983b317 Juanma Barranquero2014-03-12 05:00:03 +01001907 should be shown to the user. The buffer and mode to be used are determined
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001908 by `cvs-buffer-name-alist'.
1909DONT-CHANGE-DISC non-nil indicates that the command will not change the
1910 contents of files. This is only used by the parser."
1911 (cvs-mode-run cmd flags (cvs-mode-marked filter cmd)
1912 :buf (cvs-temp-buffer (when show cmd))
1913 :dont-change-disc dont-change-disc
1914 :cvsargs cvsargs
1915 :postproc postproc))
1916
1917(defun-cvs-mode (cvs-mode-status . SIMPLE) (flags)
1918 "Show cvs status for all marked files.
1919With prefix argument, prompt for cvs flags."
1920 (interactive (list (cvs-flags-query 'cvs-status-flags "cvs status flags")))
1921 (cvs-mode-do "status" flags nil :dont-change-disc t :show t
1922 :postproc (when (eq cvs-auto-remove-handled 'status)
cc5da1ec
SM
Stefan Monnier2013-10-07 23:47:24 -04001923 (let ((buf (current-buffer)))
1924 (lambda () (with-current-buffer buf
1925 (cvs-mode-remove-handled)))))))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001926
cecedb36
GM
Glenn Morris2013-10-29 23:28:15 -07001927(autoload 'cvs-status-cvstrees "cvs-status")
1928
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001929(defun-cvs-mode (cvs-mode-tree . SIMPLE) (flags)
1930 "Call cvstree using the file under the point as a keyfile."
1931 (interactive (list (cvs-flags-query 'cvs-status-flags "cvs status flags")))
1932 (cvs-mode-run "status" (cons "-v" flags) (cvs-mode-marked nil "status")
1933 :buf (cvs-temp-buffer "tree")
1934 :dont-change-disc t
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -04001935 :postproc #'cvs-status-cvstrees))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001936
1937;; cvs log
1938
1939(defun-cvs-mode (cvs-mode-log . NOARGS) (flags)
1940 "Display the cvs log of all selected files.
1941With prefix argument, prompt for cvs flags."
1942 (interactive (list (cvs-add-branch-prefix
1943 (cvs-flags-query 'cvs-log-flags "cvs log flags"))))
1944 (cvs-mode-do "log" flags nil :show t))
1945
1946
1947(defun-cvs-mode (cvs-mode-update . NOARGS) (flags)
1948 "Update all marked files.
1949With a prefix argument, prompt for cvs flags."
1950 (interactive
1951 (list (cvs-add-branch-prefix
1952 (cvs-add-secondary-branch-prefix
1953 (cvs-flags-query 'cvs-update-flags "cvs update flags")
1954 "-j") "-j")))
1955 (cvs-mode-do "update" flags 'update))
1956
1957
1958(defun-cvs-mode (cvs-mode-examine . NOARGS) (flags)
1959 "Re-examine all marked files.
1960With a prefix argument, prompt for cvs flags."
1961 (interactive
1962 (list (cvs-add-branch-prefix
1963 (cvs-add-secondary-branch-prefix
1964 (cvs-flags-query 'cvs-update-flags "cvs -n update flags")
1965 "-j") "-j")))
1966 (cvs-mode-do "update" flags nil :cvsargs '("-n") :dont-change-disc t))
1967
1968
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -04001969(defun-cvs-mode cvs-mode-ignore ()
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001970 "Arrange so that CVS ignores the selected files.
1971This command ignores files that are not flagged as `Unknown'."
1972 (interactive)
1973 (dolist (fi (cvs-mode-marked 'ignore))
98ccf24e Xue Fuqiao2013-09-20 13:39:53 +08001974 (vc-cvs-append-to-ignore (cvs-fileinfo->dir fi) (cvs-fileinfo->file fi)
1d2b9bba Stefan Monnier2003-05-14 15:02:05 +00001975 (eq (cvs-fileinfo->subtype fi) 'NEW-DIR))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001976 (setf (cvs-fileinfo->type fi) 'DEAD))
1977 (cvs-cleanup-collection cvs-cookies nil nil nil))
1978
a22359a7
GM
Glenn Morris2014-01-27 19:39:50 -05001979(define-obsolete-function-alias 'cvs-append-to-ignore 'vc-cvs-append-to-ignore
1980 "24.4")
1981
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00001982
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00001983(defun cvs-mode-find-file-other-window (e)
1984 "Select a buffer containing the file in another window."
1985 (interactive (list last-input-event))
1986 (cvs-mode-find-file e t))
1987
1988
be0add30
SM
Stefan Monnier2001-04-13 15:18:11 +00001989(defun cvs-mode-display-file (e)
1990 "Show a buffer containing the file in another window."
1991 (interactive (list last-input-event))
1992 (cvs-mode-find-file e 'dont-select))
1993
1994
d12757b7
KS
Kim F. Storm2004-10-15 23:38:04 +00001995(defun cvs-mode-view-file (e)
1996 "View the file."
1997 (interactive (list last-input-event))
1998 (cvs-mode-find-file e nil t))
1999
2000
2001(defun cvs-mode-view-file-other-window (e)
5983b317 Juanma Barranquero2014-03-12 05:00:03 +01002002 "View the file in another window."
d12757b7
KS
Kim F. Storm2004-10-15 23:38:04 +00002003 (interactive (list last-input-event))
2004 (cvs-mode-find-file e t t))
2005
2006
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002007(defun cvs-find-modif (fi)
2008 (with-temp-buffer
62b84d36 Stefan Monnier2007-09-15 02:22:12 +00002009 (process-file cvs-program nil (current-buffer) nil
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002010 "-f" "diff" (cvs-fileinfo->file fi))
2011 (goto-char (point-min))
2012 (if (re-search-forward "^\\([0-9]+\\)" nil t)
2013 (string-to-number (match-string 1))
2014 1)))
2015
2016
d12757b7 Kim F. Storm2004-10-15 23:38:04 +00002017(defun cvs-mode-find-file (e &optional other view)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002018 "Select a buffer containing the file.
2019With a prefix, opens the buffer in an OTHER window."
2020 (interactive (list last-input-event current-prefix-arg))
61454605 Stefan Monnier2003-05-01 00:46:41 +00002021 ;; If the event moves point, check that it moves it to a valid location.
6dfa5acf Stefan Monnier2004-04-14 17:36:09 +00002022 (when (and (/= (point) (progn (posn-set-point (event-end e)) (point)))
7b33268a
SS
Sam Steingold2003-05-09 15:59:02 +00002023 (not (memq (get-text-property (1- (line-end-position))
2024 'font-lock-face)
94d5c876 Miles Bader2005-06-10 09:13:25 +00002025 '(cvs-header cvs-filename))))
61454605 Stefan Monnier2003-05-01 00:46:41 +00002026 (error "Not a file name"))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002027 (cvs-mode!
2028 (lambda (&optional rev)
2029 (interactive (list (cvs-prefix-get 'cvs-branch-prefix)))
2030 (let* ((cvs-buf (current-buffer))
2031 (fi (cvs-mode-marked nil nil :one t)))
2032 (if (eq (cvs-fileinfo->type fi) 'DIRCHANGE)
2033 (let ((odir default-directory))
2034 (setq default-directory
2035 (cvs-expand-dir-name (cvs-fileinfo->dir fi)))
be0add30
SM
Stefan Monnier2001-04-13 15:18:11 +00002036 (cond ((eq other 'dont-select)
2037 (display-buffer (find-file-noselect default-directory)))
2038 (other (dired-other-window default-directory))
2039 (t (dired default-directory)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002040 (set-buffer cvs-buf)
2041 (setq default-directory odir))
2042 (let ((buf (if rev (cvs-retrieve-revision fi rev)
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00002043 (find-file-noselect (cvs-fileinfo->full-name fi)))))
be0add30 Stefan Monnier2001-04-13 15:18:11 +00002044 (funcall (cond ((eq other 'dont-select) 'display-buffer)
d12757b7
KS
Kim F. Storm2004-10-15 23:38:04 +00002045 (other
2046 (if view 'view-buffer-other-window
2047 'switch-to-buffer-other-window))
2048 (t (if view 'view-buffer 'switch-to-buffer)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002049 buf)
2050 (when (and cvs-find-file-and-jump (cvs-applicable-p fi 'diff-base))
9477096c
GM
Glenn Morris2009-09-10 06:23:06 +00002051 (save-restriction
2052 (widen)
2053 (goto-char (point-min))
2054 (forward-line (1- (cvs-find-modif fi)))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002055 buf))))))
2056
2057
2058(defun-cvs-mode (cvs-mode-undo . SIMPLE) (flags)
2059 "Undo local changes to all marked files.
2060The file is removed and `cvs update FILE' is run."
2061 ;;"With prefix argument, prompt for cvs FLAGS."
2062 (interactive (list nil));; (cvs-flags-query 'cvs-undo-flags "undo flags")
2063 (if current-prefix-arg (call-interactively 'cvs-mode-revert-to-rev)
2064 (let* ((fis (cvs-do-removal 'undo "update" 'all))
6b2e4334
SM
Stefan Monnier2002-09-03 01:40:29 +00002065 (removedp (lambda (fi)
2066 (or (eq (cvs-fileinfo->type fi) 'REMOVED)
2067 (and (eq (cvs-fileinfo->type fi) 'CONFLICT)
2068 (eq (cvs-fileinfo->subtype fi) 'REMOVED)))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002069 (fis-split (cvs-partition removedp fis))
2070 (fis-removed (car fis-split))
2071 (fis-other (cdr fis-split)))
2072 (if (null fis-other)
2073 (when fis-removed (cvs-mode-run "add" nil fis-removed))
2074 (cvs-mode-run "update" flags fis-other
2075 :postproc
2076 (when fis-removed
cc5da1ec
SM
Stefan Monnier2013-10-07 23:47:24 -04002077 (let ((buf (current-buffer)))
2078 (lambda ()
2079 (with-current-buffer buf
2080 (cvs-mode-run "add" nil fis-removed))))))))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002081
2082
2083(defun-cvs-mode (cvs-mode-revert-to-rev . NOARGS) (rev)
2084 "Revert the selected files to an old revision."
2085 (interactive
2086 (list (or (cvs-prefix-get 'cvs-branch-prefix)
2087 (let ((current-prefix-arg '(4)))
2088 (cvs-flags-query 'cvs-idiff-version)))))
2089 (let* ((fis (cvs-mode-marked 'revert "revert" :file t))
2090 (tag (concat "tmp_pcl_tag_" (make-temp-name "")))
cc5da1ec
SM
Stefan Monnier2013-10-07 23:47:24 -04002091 (buf (current-buffer))
2092 (untag (lambda ()
2093 (with-current-buffer buf
2094 (cvs-mode-run "tag" (list "-d" tag) fis))))
2095 (update (lambda ()
2096 (with-current-buffer buf
2097 (cvs-mode-run "update" (list "-j" tag "-j" rev) fis
2098 :postproc untag)))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002099 (cvs-mode-run "tag" (list tag) fis :postproc update)))
2100
2101
2102(defun-cvs-mode cvs-mode-delete-lock ()
2103 "Delete the lock file that CVS is waiting for.
2104Note that this can be dangerous. You should only do this
2105if you are convinced that the process that created the lock is dead."
2106 (interactive)
2107 (let* ((default-directory (cvs-expand-dir-name cvs-lock-file))
2108 (locks (directory-files default-directory nil cvs-lock-file-regexp)))
2109 (cond
3afbc435 Pavel Janík2001-07-16 07:46:48 +00002110 ((not locks) (error "No lock files found"))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002111 ((yes-or-no-p (concat "Really delete locks in " cvs-lock-file "? "))
2112 (dolist (lock locks)
2113 (cond ((file-directory-p lock) (delete-directory lock))
2114 ((file-exists-p lock) (delete-file lock))))))))
2115
2116
2117(defun-cvs-mode cvs-mode-remove-handled ()
2118 "Remove all lines that are handled.
2119Empty directories are removed."
2120 (interactive)
2121 (cvs-cleanup-collection cvs-cookies
1c851e98 Stefan Monnier2013-01-08 12:34:35 -05002122 'all (or cvs-auto-remove-directories 'handled) t))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002123
2124
2125(defun-cvs-mode cvs-mode-acknowledge ()
2126 "Remove all marked files from the buffer."
2127 (interactive)
2128 (dolist (fi (cvs-get-marked (cvs-ignore-marks-p "acknowledge") t))
2129 (setf (cvs-fileinfo->type fi) 'DEAD))
2130 (cvs-cleanup-collection cvs-cookies nil nil nil))
2131
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002132(defun cvs-do-removal (filter &optional cmd all)
2133 "Remove files.
2134Returns a list of FIS that should be `cvs remove'd."
2135 (let* ((files (cvs-mode-marked filter cmd :file t :read-only t))
598dd5ff
SM
Stefan Monnier2000-11-09 23:55:05 +00002136 (fis (cdr (cvs-partition (lambda (fi)
2137 (eq (cvs-fileinfo->type fi) 'UNKNOWN))
2138 (cvs-mode-marked filter cmd))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002139 (silent (or (not cvs-confirm-removals)
2140 (cvs-every (lambda (fi)
2141 (or (not (file-exists-p
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00002142 (cvs-fileinfo->full-name fi)))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00002143 (cvs-applicable-p fi 'safe-rm)))
598dd5ff
SM
Stefan Monnier2000-11-09 23:55:05 +00002144 files)))
2145 (tmpbuf (cvs-temp-buffer)))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00002146 (when (and (not silent) (equal cvs-confirm-removals 'list))
598dd5ff Stefan Monnier2000-11-09 23:55:05 +00002147 (with-current-buffer tmpbuf
3f1045d5 Stefan Monnier2002-09-13 19:09:45 +00002148 (let ((inhibit-read-only t))
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00002149 (cvs-insert-strings (mapcar 'cvs-fileinfo->full-name fis))
3f1045d5
SM
Stefan Monnier2002-09-13 19:09:45 +00002150 (cvs-pop-to-buffer-same-frame (current-buffer))
2151 (shrink-window-if-larger-than-buffer))))
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00002152 (if (not (or silent
598dd5ff Stefan Monnier2000-11-09 23:55:05 +00002153 (unwind-protect
d3ffebbc Thien-Thi Nguyen2003-09-29 14:40:28 +00002154 (yes-or-no-p
9ceda1bb
MY
Masatake YAMATO2003-09-19 18:43:16 +00002155 (let ((nfiles (length files))
2156 (verb (if (eq filter 'undo) "Undo" "Delete")))
bb61abb8 Masatake YAMATO2003-08-31 02:11:21 +00002157 (if (= 1 nfiles)
d3ffebbc Thien-Thi Nguyen2003-09-29 14:40:28 +00002158 (format "%s file: \"%s\" ? "
9ceda1bb Masatake YAMATO2003-09-19 18:43:16 +00002159 verb
bb61abb8 Masatake YAMATO2003-08-31 02:11:21 +00002160 (cvs-fileinfo->file (car files)))
d3ffebbc Thien-Thi Nguyen2003-09-29 14:40:28 +00002161 (format "%s %d files? "
9ceda1bb
MY
Masatake YAMATO2003-09-19 18:43:16 +00002162 verb
2163 nfiles))))
598dd5ff Stefan Monnier2000-11-09 23:55:05 +00002164 (cvs-bury-buffer tmpbuf cvs-buffer))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002165 (progn (message "Aborting") nil)
2166 (dolist (fi files)
2167 (let* ((type (cvs-fileinfo->type fi))
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00002168 (file (cvs-fileinfo->full-name fi)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002169 (when (or all (eq type 'UNKNOWN))
2170 (when (file-exists-p file) (delete-file file))
2171 (unless all (setf (cvs-fileinfo->type fi) 'DEAD) t))))
2172 fis)))
2173
2174(defun-cvs-mode (cvs-mode-remove . SIMPLE) (flags)
2175 "Remove all marked files.
2176With prefix argument, prompt for cvs flags."
2177 (interactive (list (cvs-flags-query 'cvs-remove-flags "cvs remove flags")))
2178 (let ((fis (cvs-do-removal 'remove)))
2179 (if fis (cvs-mode-run "remove" (cons "-f" flags) fis)
2180 (cvs-cleanup-collection cvs-cookies nil nil nil))))
2181
2182
2183(defvar cvs-tag-name "")
2184(defun-cvs-mode (cvs-mode-tag . SIMPLE) (tag &optional flags)
2185 "Run `cvs tag TAG' on all selected files.
7b004f77
SM
Stefan Monnier2003-03-19 14:34:24 +00002186With prefix argument, prompt for cvs flags.
2187By default this can only be used on directories.
2188Use \\[cvs-mode-force-command] or change `cvs-force-dir-tag' if you need
2189to use it on individual files."
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002190 (interactive
2191 (list (setq cvs-tag-name
2192 (cvs-query-read cvs-tag-name "Tag name: " cvs-qtypedesc-tag))
2193 (cvs-flags-query 'cvs-tag-flags "tag flags")))
2194 (cvs-mode-do "tag" (append flags (list tag))
2195 (when cvs-force-dir-tag 'tag)))
2196
2197(defun-cvs-mode (cvs-mode-untag . SIMPLE) (tag &optional flags)
2198 "Run `cvs tag -d TAG' on all selected files.
2199With prefix argument, prompt for cvs flags."
2200 (interactive
2201 (list (setq cvs-tag-name
cc5da1ec
SM
Stefan Monnier2013-10-07 23:47:24 -04002202 (cvs-query-read cvs-tag-name "Tag to delete: "
2203 cvs-qtypedesc-tag))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002204 (cvs-flags-query 'cvs-tag-flags "tag flags")))
2205 (cvs-mode-do "tag" (append '("-d") flags (list tag))
2206 (when cvs-force-dir-tag 'tag)))
027b73ac Sam Steingold2000-08-03 18:11:47 +00002207
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002208
2209;; Byte compile files.
2210
2211(defun-cvs-mode cvs-mode-byte-compile-files ()
5983b317 Juanma Barranquero2014-03-12 05:00:03 +01002212 "Run byte-compile-file on all selected files with '.el' extension."
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002213 (interactive)
2214 (let ((marked (cvs-get-marked (cvs-ignore-marks-p "byte-compile"))))
2215 (dolist (fi marked)
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00002216 (let ((filename (cvs-fileinfo->full-name fi)))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002217 (when (string-match "\\.el\\'" filename)
2218 (byte-compile-file filename))))))
2219
2220;; ChangeLog support.
cc5da1ec Stefan Monnier2013-10-07 23:47:24 -04002221(defvar add-log-buffer-file-name-function)
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00002222
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002223(defun-cvs-mode cvs-mode-add-change-log-entry-other-window ()
2224 "Add a ChangeLog entry in the ChangeLog of the current directory."
2225 (interactive)
fd071fdf
SM
Stefan Monnier2007-09-08 03:11:43 +00002226 ;; Require `add-log' explicitly, because if it gets autoloaded when we call
2227 ;; add-change-log-entry-other-window below, the
2228 ;; add-log-buffer-file-name-function ends up unbound when we leave the `let'.
2229 (require 'add-log)
883e7198 Stefan Monnier2002-05-16 20:03:52 +00002230 (dolist (fi (cvs-mode-marked nil nil))
cd07ee90 Richard M. Stallman2004-03-12 10:12:14 +00002231 (let* ((default-directory (cvs-expand-dir-name (cvs-fileinfo->dir fi)))
fd071fdf
SM
Stefan Monnier2007-09-08 03:11:43 +00002232 (add-log-buffer-file-name-function
2233 (lambda ()
2234 (let ((file (expand-file-name (cvs-fileinfo->file fi))))
2235 (if (file-directory-p file)
2236 ;; Be careful to use a directory name, otherwise add-log
2237 ;; starts looking for a ChangeLog file in the
2238 ;; parent dir.
2239 (file-name-as-directory file)
2240 file)))))
883e7198
SM
Stefan Monnier2002-05-16 20:03:52 +00002241 (kill-local-variable 'change-log-default-name)
2242 (save-excursion (add-change-log-entry-other-window)))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002243
2244;; interactive commands to set optional flags
2245
2246(defun cvs-mode-set-flags (flag)
2247 "Ask for new setting of cvs-FLAG-flags."
2248 (interactive
2249 (list (completing-read
2250 "Which flag: "
883e7198
SM
Stefan Monnier2002-05-16 20:03:52 +00002251 '("cvs" "diff" "update" "status" "log" "tag" ;"rtag"
2252 "commit" "remove" "undo" "checkout")
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002253 nil t)))
2254 (let* ((sym (intern (concat "cvs-" flag "-flags"))))
2255 (let ((current-prefix-arg '(16)))
2256 (cvs-flags-query sym (concat flag " flags")))))
2257
2258\f
2259;;;;
2260;;;; Utilities for the *cvs* buffer
2261;;;;
2262
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002263(defun cvs-dir-member-p (fileinfo dir)
2264 "Return true if FILEINFO represents a file in directory DIR."
2265 (and (not (eq (cvs-fileinfo->type fileinfo) 'DIRCHANGE))
121b8917 Glenn Morris2012-04-16 19:57:09 -04002266 (string-prefix-p dir (cvs-fileinfo->dir fileinfo))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002267
2268(defun cvs-execute-single-file (fi extractor program constant-args)
2269 "Internal function for `cvs-execute-single-file-list'."
73eff599
SM
Stefan Monnier2000-12-18 03:17:46 +00002270 (let* ((arg-list (funcall extractor fi))
2271 (inhibit-read-only t))
027b73ac Sam Steingold2000-08-03 18:11:47 +00002272
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002273 ;; Execute the command unless extractor returned t.
2274 (when (listp arg-list)
2275 (let* ((args (append constant-args arg-list)))
027b73ac Sam Steingold2000-08-03 18:11:47 +00002276
73eff599 Stefan Monnier2000-12-18 03:17:46 +00002277 (insert (format "=== %s %s\n\n"
ad4fed11 Richard M. Stallman2007-08-12 18:11:57 +00002278 program (split-string-and-unquote args)))
027b73ac Sam Steingold2000-08-03 18:11:47 +00002279
5b467bf4 Stefan Monnier2000-03-11 03:51:31 +00002280 ;; FIXME: return the exit status?
62b84d36 Stefan Monnier2007-09-15 02:22:12 +00002281 (apply 'process-file program nil t t args)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002282 (goto-char (point-max))))))
2283
2284;; FIXME: make this run in the background ala cvs-run-process...
2285(defun cvs-execute-single-file-list (fis extractor program constant-args)
2286 "Run PROGRAM on all elements on FIS.
73eff599
SM
Stefan Monnier2000-12-18 03:17:46 +00002287CONSTANT-ARGS is a list of strings to pass as arguments to PROGRAM.
2288The arguments given to the program will be CONSTANT-ARGS followed by
2289the list that EXTRACTOR returns.
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002290
2291EXTRACTOR will be called once for each file on FIS. It is given
2292one argument, the cvs-fileinfo. It can return t, which means ignore
2293this file, or a list of arguments to send to the program."
2294 (dolist (fi fis)
2295 (cvs-execute-single-file fi extractor program constant-args)))
2296
2297\f
2298(defun cvs-revert-if-needed (fis)
2299 (dolist (fileinfo fis)
2231c2bc Stefan Monnier2005-04-26 20:37:31 +00002300 (let* ((file (cvs-fileinfo->full-name fileinfo))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002301 (buffer (find-buffer-visiting file)))
2302 ;; For a revert to happen the user must be editing the file...
2303 (unless (or (null buffer)
77fdc5c3 Stefan Monnier2007-11-20 04:04:45 +00002304 (memq (cvs-fileinfo->type fileinfo) '(MESSAGE UNKNOWN))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002305 ;; FIXME: check whether revert is really needed.
2306 ;; `(verify-visited-file-modtime buffer)' doesn't cut it
2307 ;; because it only looks at the time stamp (it ignores
2308 ;; read-write changes) which is not changed by `commit'.
2309 (buffer-modified-p buffer))
2310 (with-current-buffer buffer
a7996e05
SM
Stefan Monnier2000-09-29 03:14:36 +00002311 (ignore-errors
2312 (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)
2313 ;; `preserve-modes' avoids changing the (minor) modes. But we
2314 ;; do want to reset the mode for VC, so we do it explicitly.
2315 (vc-find-file-hook)
2316 (when (eq (cvs-fileinfo->type fileinfo) 'CONFLICT)
28e4e2b4 Dan Nicolaescu2008-01-16 06:22:59 +00002317 (smerge-start-session))))))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002318
2319\f
2320(defun cvs-change-cvsroot (newroot)
5983b317 Juanma Barranquero2014-03-12 05:00:03 +01002321 "Change the CVSROOT."
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002322 (interactive "DNew repository: ")
2323 (if (or (file-directory-p (expand-file-name "CVSROOT" newroot))
2324 (y-or-n-p (concat "Warning: no CVSROOT found inside repository."
e1a2960c Romain Francoise2006-08-13 17:05:12 +00002325 " Change cvs-cvsroot anyhow? ")))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002326 (setq cvs-cvsroot newroot)))
2327
2328;;;;
2329;;;; useful global settings
2330;;;;
2331
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002332;;
2333;; Hook to allow calling PCL-CVS by visiting the /CVS subdirectory
2334;;
2335
2336;;;###autoload
eed914af Stefan Monnier2000-10-05 22:45:59 +00002337(defcustom cvs-dired-action 'cvs-quickdir
6dc7d3d5
SM
Stefan Monnier2000-06-12 04:53:34 +00002338 "The action to be performed when opening a CVS directory.
2339Sensible values are `cvs-examine', `cvs-status' and `cvs-quickdir'."
2340 :group 'pcl-cvs
2341 :type '(choice (const cvs-examine) (const cvs-status) (const cvs-quickdir)))
2342
2343;;;###autoload
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002344(defcustom cvs-dired-use-hook '(4)
2345 "Whether or not opening a CVS directory should run PCL-CVS.
7feaa747 Juanma Barranquero2007-05-16 11:25:46 +00002346A value of nil means never do it.
5983b317 Juanma Barranquero2014-03-12 05:00:03 +01002347`always' means to always do it unless a prefix argument is given to the
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002348 command that prompted the opening of the directory.
2349Anything else means to do it only if the prefix arg is equal to this value."
2350 :group 'pcl-cvs
2351 :type '(choice (const :tag "Never" nil)
2352 (const :tag "Always" always)
2353 (const :tag "Prefix" (4))))
2354
2355;;;###autoload
b15b5618 Stefan Monnier2000-05-10 22:28:36 +00002356(progn (defun cvs-dired-noselect (dir)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002357 "Run `cvs-examine' if DIR is a CVS administrative directory.
2358The exact behavior is determined also by `cvs-dired-use-hook'."
2359 (when (stringp dir)
2360 (setq dir (directory-file-name dir))
2361 (when (and (string= "CVS" (file-name-nondirectory dir))
2362 (file-readable-p (expand-file-name "Entries" dir))
2363 cvs-dired-use-hook
2364 (if (eq cvs-dired-use-hook 'always)
2365 (not current-prefix-arg)
2366 (equal current-prefix-arg cvs-dired-use-hook)))
2367 (save-excursion
6dc7d3d5 Stefan Monnier2000-06-12 04:53:34 +00002368 (funcall cvs-dired-action (file-name-directory dir) t t))))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002369
2370;;
2371;; hook into VC
2372;;
2373
d15c2aaa
SM
Stefan Monnier2000-10-08 19:11:34 +00002374(add-hook 'vc-post-command-functions 'cvs-vc-command-advice)
2375
b6e9189c Stefan Monnier2007-07-31 15:23:27 +00002376(defun cvs-vc-command-advice (command files flags)
d15c2aaa Stefan Monnier2000-10-08 19:11:34 +00002377 (when (and (equal command "cvs")
db750be7
SM
Stefan Monnier2002-06-18 21:50:30 +00002378 (progn
2379 (while (and (stringp (car flags))
2380 (string-match "\\`-" (car flags)))
2381 (pop flags))
2382 ;; don't parse output we don't understand.
61454605
SM
Stefan Monnier2003-05-01 00:46:41 +00002383 (member (car flags) cvs-parse-known-commands))
2384 ;; Don't parse "update -p" output.
2385 (not (and (member (car flags) '("update" "checkout"))
2386 (let ((found-p nil))
2387 (dolist (flag flags found-p)
2388 (if (equal flag "-p") (setq found-p t)))))))
498ecdde Stefan Monnier2002-06-25 00:11:28 +00002389 (save-current-buffer
d15c2aaa
SM
Stefan Monnier2000-10-08 19:11:34 +00002390 (let ((buffer (current-buffer))
2391 (dir default-directory)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002392 (cvs-from-vc t))
2393 (dolist (cvs-buf (buffer-list))
2394 (set-buffer cvs-buf)
2395 ;; look for a corresponding pcl-cvs buffer
2396 (when (and (eq major-mode 'cvs-mode)
121b8917 Glenn Morris2012-04-16 19:57:09 -04002397 (string-prefix-p default-directory dir))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002398 (let ((subdir (substring dir (length default-directory))))
2399 (set-buffer buffer)
2400 (set (make-local-variable 'cvs-buffer) cvs-buf)
498ecdde
SM
Stefan Monnier2002-06-25 00:11:28 +00002401 ;; `cvs -q add file' produces no useful output :-(
2402 (when (and (equal (car flags) "add")
2403 (goto-char (point-min))
2404 (looking-at ".*to add this file permanently\n\\'"))
dae2bd56 Sam Steingold2007-08-22 15:48:22 +00002405 (dolist (file (if (listp files) files (list files)))
b6e9189c
SM
Stefan Monnier2007-07-31 15:23:27 +00002406 (insert "cvs add: scheduling file `"
2407 (file-name-nondirectory file)
2408 "' for addition\n")))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002409 ;; VC never (?) does `cvs -n update' so dcd=nil
2410 ;; should probably always be the right choice.
2411 (cvs-parse-process nil subdir))))))))
2412
2413;;
2414;; Hook into write-buffer
2415;;
2416
2417(defun cvs-mark-buffer-changed ()
2418 (let* ((file (expand-file-name buffer-file-name))
2419 (version (and (fboundp 'vc-backend)
2420 (eq (vc-backend file) 'CVS)
ac3f4c6f Eric S. Raymond2007-10-10 18:52:45 +00002421 (vc-working-revision file))))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002422 (when version
2423 (save-excursion
2424 (dolist (cvs-buf (buffer-list))
2425 (set-buffer cvs-buf)
2426 ;; look for a corresponding pcl-cvs buffer
2427 (when (and (eq major-mode 'cvs-mode)
121b8917 Glenn Morris2012-04-16 19:57:09 -04002428 (string-prefix-p default-directory file))
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002429 (let* ((file (substring file (length default-directory)))
2430 (fi (cvs-create-fileinfo
2431 (if (string= "0" version)
2432 'ADDED 'MODIFIED)
2433 (or (file-name-directory file) "")
2434 (file-name-nondirectory file)
2435 "cvs-mark-buffer-changed")))
2436 (cvs-addto-collection cvs-cookies fi))))))))
2437
2438(add-hook 'after-save-hook 'cvs-mark-buffer-changed)
2439
e01c13fe
SM
Stefan Monnier2012-09-29 23:44:35 -04002440(defun cvs-insert-visited-file ()
2441 (let* ((file (expand-file-name buffer-file-name))
2442 (version (and (fboundp 'vc-backend)
2443 (eq (vc-backend file) 'CVS)
2444 (vc-working-revision file))))
2445 (when version
2446 (save-current-buffer
2447 (dolist (cvs-buf (buffer-list))
2448 (set-buffer cvs-buf)
2449 ;; look for a corresponding pcl-cvs buffer
2450 (when (and (eq major-mode 'cvs-mode)
2451 (string-prefix-p default-directory file))
2452 (cvs-insert-file file)))))))
2453
2454(add-hook 'find-file-hook 'cvs-insert-visited-file 'append)
5b467bf4
SM
Stefan Monnier2000-03-11 03:51:31 +00002455\f
2456(provide 'pcvs)
2457
2458;;; pcvs.el ends here