|
0
|
1 ;;;
|
|
|
2 ;;;#ident "@(#)OrigId: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp "
|
|
|
3 ;;;
|
|
142
|
4 ;;;#ident "@(#)cvs/contrib/pcl-cvs:$Name: r20-2b5 $:$Id: pcl-cvs.el,v 1.4 1997/05/09 03:28:08 steve Exp $"
|
|
0
|
5 ;;;
|
|
|
6 ;;; pcl-cvs.el -- A Front-end to CVS 1.3 or later.
|
|
142
|
7 ;;; Release 1.05-CVS-$Name: r20-2b5 $.
|
|
0
|
8 ;;; Copyright (C) 1991, 1992, 1993 Per Cederqvist
|
|
|
9
|
|
|
10 ;;; This program is free software; you can redistribute it and/or modify
|
|
|
11 ;;; it under the terms of the GNU General Public License as published by
|
|
|
12 ;;; the Free Software Foundation; either version 2 of the License, or
|
|
|
13 ;;; (at your option) any later version.
|
|
|
14 ;;;
|
|
|
15 ;;; This program is distributed in the hope that it will be useful,
|
|
|
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
18 ;;; GNU General Public License for more details.
|
|
|
19 ;;;
|
|
|
20 ;;; You should have received a copy of the GNU General Public License
|
|
|
21 ;;; along with this program; if not, write to the Free Software
|
|
76
|
22 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
23 ;;; 02111-1307, USA.
|
|
0
|
24
|
|
|
25 ;;; See below for installation instructions.
|
|
|
26
|
|
|
27 ;;; There is an TeXinfo file that describes this package. You should read it
|
|
|
28 ;;; to get the most from this package.
|
|
|
29
|
|
|
30 ;;; Mail questions and bug reports regarding this version (as included in
|
|
|
31 ;;; CVS-1.7 or newer) to the pcl-cvs support team at <pcl-cvs@cyclic.com>.
|
|
|
32
|
|
|
33 ;;; Don't try to use this with CVS 1.2 or earlier. It won't work. Get CVS 1.7
|
|
|
34 ;;; or newer. Use the version of RCS best suited for the version of CVS you're
|
|
|
35 ;;; using.
|
|
|
36
|
|
76
|
37 (require 'cookie) ; from ELIB-1.0
|
|
0
|
38 (require 'add-log) ; for all the ChangeLog goodies
|
|
|
39
|
|
|
40 ;;; -------------------------------------------------------
|
|
|
41 ;;; START OF THINGS TO CHECK WHEN INSTALLING
|
|
|
42
|
|
|
43 ;; also use $GNU here, since may folks might install CVS as a GNU package
|
|
|
44 ;;
|
|
76
|
45 (defun cvs-find-program (program)
|
|
|
46 (let ((path (list (getenv "LOCAL")
|
|
|
47 (getenv "GNU")
|
|
|
48 "/usr/local/bin"
|
|
|
49 "/usr/bin"
|
|
|
50 "/bin")))
|
|
|
51 (while path
|
|
|
52 (if (stringp (car path))
|
|
|
53 (let ((abs-program (expand-file-name program (car path))))
|
|
|
54 (if (file-executable-p abs-program)
|
|
|
55 (setq path nil
|
|
|
56 program abs-program))))
|
|
|
57 (setq path (cdr path)))
|
|
|
58 program))
|
|
|
59
|
|
|
60 (defvar cvs-program (cvs-find-program "cvs")
|
|
0
|
61 "*Full path to the cvs executable.")
|
|
|
62
|
|
|
63 ;; SunOS-4.1.1_U1 has "diff.c 1.12 88/08/04 SMI; from UCB 4.6 86/04/03"
|
|
|
64 ;;
|
|
76
|
65 (defvar cvs-diff-program (cvs-find-program "diff")
|
|
0
|
66 "*Full path to the best diff program you've got.
|
|
|
67 NOTE: there are some nasty bugs in the context diff variants of some vendor
|
|
|
68 versions, such as the one in SunOS-4.1.1_U1")
|
|
|
69
|
|
|
70 (defvar cvs-rmdir-program "/bin/rmdir"
|
|
|
71 "*Full path to the rmdir program. Typically /bin/rmdir.")
|
|
|
72
|
|
|
73 (defvar cvs-shell "/bin/sh"
|
|
|
74 "*Full path to a shell that can do redirection on stdout.")
|
|
|
75
|
|
|
76 ;;; Options to control various features:
|
|
|
77
|
|
|
78 (defvar cvs-changelog-full-paragraphs t
|
|
|
79 "If non-nil, include full ChangeLog paragraphs in the CVS log.
|
|
|
80 This may be set in the ``local variables'' section of a ChangeLog, to
|
|
|
81 indicate the policy for that ChangeLog.
|
|
|
82
|
|
|
83 A ChangeLog paragraph is a bunch of log text containing no blank lines;
|
|
|
84 a paragraph usually describes a set of changes with a single purpose,
|
|
|
85 but perhaps spanning several functions in several files. Changes in
|
|
|
86 different paragraphs are unrelated.
|
|
|
87
|
|
|
88 You could argue that the CVS log entry for a file should contain the
|
|
|
89 full ChangeLog paragraph mentioning the change to the file, even though
|
|
|
90 it may mention other files, because that gives you the full context you
|
|
|
91 need to understand the change. This is the behaviour you get when this
|
|
|
92 variable is set to t.
|
|
|
93
|
|
|
94 On the other hand, you could argue that the CVS log entry for a change
|
|
|
95 should contain only the text for the changes which occurred in that
|
|
|
96 file, because the CVS log is per-file. This is the behaviour you get
|
|
|
97 when this variable is set to nil.")
|
|
|
98
|
|
|
99 (defvar cvs-cvsroot-required nil
|
|
|
100 "*Specifies whether CVS needs to be told where the repository is.
|
|
|
101
|
|
|
102 In CVS 1.3, if your CVSROOT environment variable is not set, and you
|
|
|
103 do not set the `cvs-cvsroot' lisp variable, CVS will have no idea
|
|
|
104 where to find the repository, and refuse to run. CVS 1.4 and later
|
|
|
105 store the repository path with the working directories, so most
|
|
|
106 operations don't need to be told where the repository is.
|
|
|
107
|
|
|
108 If you work with multiple repositories with CVS 1.4, it's probably
|
|
|
109 advisable to leave your CVSROOT environment variable unset, set this
|
|
|
110 variable to nil, and let CVS figure out where the repository is for
|
|
|
111 itself.")
|
|
|
112
|
|
|
113 (defvar cvs-cvsroot nil
|
|
|
114 "*Specifies where the (current) cvs master repository is.
|
|
|
115 Overrides the $CVSROOT variable by sending \" -d dir\" to all cvs commands.
|
|
|
116 This switch is useful if you have multiple CVS repositories, and are not using
|
|
|
117 a modern version of CVS that stores the current repository in CVS/Root.")
|
|
|
118
|
|
|
119 ;; Uncomment the following line if you are running on 18.57 or earlier.
|
|
|
120 ;(setq delete-exited-processes nil)
|
|
|
121 ;; Emacs version 18.57 and earlier is likely to crash if
|
|
|
122 ;; delete-exited-processes is t, since the sentinel uses lots of
|
|
|
123 ;; memory, and 18.57 forgets to GCPROT a variable if
|
|
|
124 ;; delete-exited-processes is t.
|
|
|
125
|
|
|
126 ;;; END OF THINGS TO CHECK WHEN INSTALLING
|
|
|
127 ;;; --------------------------------------------------------
|
|
|
128
|
|
142
|
129 (defconst pcl-cvs-version "1.05-CVS-$Name: r20-2b5 $"
|
|
0
|
130 "A string denoting the current release version of pcl-cvs.")
|
|
|
131
|
|
|
132 ;; You are NOT allowed to disable this message by default. However, you
|
|
|
133 ;; are encouraged to inform your users that by adding
|
|
|
134 ;; (setq cvs-inhibit-copyright-message t)
|
|
|
135 ;; to their .emacs they can get rid of it. Just don't add that line
|
|
|
136 ;; to your default.el!
|
|
|
137 (defvar cvs-inhibit-copyright-message nil
|
|
|
138 "*Non-nil means don't display a Copyright message in the ``*cvs*'' buffer.")
|
|
|
139
|
|
|
140 (defconst cvs-startup-message
|
|
|
141 (if cvs-inhibit-copyright-message
|
|
142
|
142 "PCL-CVS release 1.05-CVS-$Name: r20-2b5 $"
|
|
|
143 "PCL-CVS release 1.05 from CVS release $Name: r20-2b5 $.
|
|
0
|
144 Copyright (C) 1992, 1993 Per Cederqvist
|
|
|
145 Pcl-cvs comes with absolutely no warranty; for details consult the manual.
|
|
|
146 This is free software, and you are welcome to redistribute it under certain
|
|
|
147 conditions; again, consult the TeXinfo manual for details.")
|
|
|
148 "*Startup message for CVS.")
|
|
|
149
|
|
|
150 (defconst pcl-cvs-bugs-address "pcl-cvs-auto-bugs@cyclic.com"
|
|
|
151 "The destination address used for the default bug report form.")
|
|
|
152
|
|
|
153 (defvar cvs-stdout-file nil
|
|
|
154 "Name of the file that holds the output that CVS sends to stdout.
|
|
|
155 This variable is buffer local.")
|
|
|
156
|
|
|
157 (defvar cvs-lock-file nil
|
|
|
158 "Full path to a lock file that CVS is waiting for (or was waiting for).")
|
|
|
159
|
|
|
160 (defvar cvs-bakprefix ".#"
|
|
|
161 "The prefix that CVS prepends to files when rcsmerge'ing.")
|
|
|
162
|
|
|
163 (defvar cvs-erase-input-buffer nil
|
|
|
164 "*Non-nil if input buffers should be cleared before asking for new info.")
|
|
|
165
|
|
|
166 (defvar cvs-auto-remove-handled nil
|
|
|
167 "*Non-nil if cvs-mode-remove-handled should be called automatically.
|
|
|
168 If this is set to any non-nil value, entries that do not need to be checked in
|
|
|
169 will be removed from the *cvs* buffer after every cvs-mode-commit command.")
|
|
|
170
|
|
|
171 (defvar cvs-auto-remove-handled-directories nil
|
|
|
172 "*Non-nil if cvs-mode-remove-handled and cvs-update should automatically
|
|
|
173 remove empty directories.
|
|
|
174 If this is set to any non-nil value, directories that do not contain any files
|
|
|
175 to be checked in will be removed from the *cvs* buffer.")
|
|
|
176
|
|
|
177 (defvar cvs-sort-ignore-file t
|
|
|
178 "*Non-nil if cvs-mode-ignore should sort the .cvsignore automatically.")
|
|
|
179
|
|
|
180 (defvar cvs-auto-revert-after-commit t
|
|
|
181 "*Non-nil if committed buffers should be automatically reverted.")
|
|
|
182
|
|
|
183 (defconst cvs-cursor-column 14
|
|
|
184 "Column to position cursor in in cvs-mode.
|
|
|
185 Column 0 is left-most column.")
|
|
|
186
|
|
|
187 (defvar cvs-mode-map nil
|
|
|
188 "Keymap for the cvs mode.")
|
|
|
189
|
|
|
190 (defvar cvs-edit-mode-map nil
|
|
|
191 "Keymap for the cvs edit mode (used when editing cvs log messages).")
|
|
|
192
|
|
|
193 (defvar cvs-buffer-name "*cvs*"
|
|
|
194 "Name of the cvs buffer.")
|
|
|
195
|
|
|
196 (defvar cvs-commit-prompt-buffer "*cvs-commit-message*"
|
|
|
197 "Name of buffer in which the user is prompted for a log message when
|
|
|
198 committing files.")
|
|
|
199
|
|
|
200 (defvar cvs-commit-buffer-require-final-newline t
|
|
|
201 "*t says silently put a newline at the end of commit log messages.
|
|
|
202 Non-nil but not t says ask user whether to add a newline in each such case.
|
|
|
203 nil means don't add newlines.")
|
|
|
204
|
|
|
205 (defvar cvs-temp-buffer-name "*cvs-tmp*"
|
|
|
206 "*Name of the cvs temporary buffer.
|
|
|
207 Output from cvs is placed here by synchronous commands.")
|
|
|
208
|
|
|
209 (defvar cvs-diff-ignore-marks nil
|
|
|
210 "*Non-nil if cvs-diff and cvs-mode-diff-backup should ignore any marked files.
|
|
|
211 Normally they run diff on the files that are marked (with cvs-mode-mark),
|
|
|
212 or the file under the cursor if no files are marked. If this variable
|
|
|
213 is set to a non-nil value they will always run diff on the file on the
|
|
|
214 current line.")
|
|
|
215
|
|
|
216 ;;; (setq cvs-status-flags '("-v"))
|
|
|
217 (defvar cvs-status-flags '("-v")
|
|
|
218 "*List of flags to pass to ``cvs status''. Default is \"-v\".")
|
|
|
219
|
|
|
220 ;;; (setq cvs-log-flags nil)
|
|
|
221 (defvar cvs-log-flags nil
|
|
|
222 "*List of flags to pass to ``cvs log''. Default is none.")
|
|
|
223
|
|
|
224 ;;; (setq cvs-tag-flags nil)
|
|
|
225 (defvar cvs-tag-flags nil
|
|
|
226 "*List of extra flags to pass to ``cvs tag''. Default is none.")
|
|
|
227
|
|
|
228 ;;; (setq cvs-rtag-flags nil)
|
|
|
229 (defvar cvs-rtag-flags nil
|
|
|
230 "*List of extra flags to pass to ``cvs rtag''. Default is none.")
|
|
|
231
|
|
|
232 ;;; (setq cvs-diff-flags '("-u"))
|
|
|
233 (defvar cvs-diff-flags '("-u")
|
|
|
234 "*List of flags to use as flags to pass to ``diff'' and ``cvs diff''.
|
|
|
235 Used by cvs-mode-diff-cvs and cvs-mode-diff-backup. Default is \"-u\".
|
|
|
236
|
|
|
237 Set this to \"-u\" to get a Unidiff format, or \"-c\" to get context diffs.")
|
|
|
238
|
|
|
239 ;;; (setq cvs-update-optional-flags nil)
|
|
|
240 (defvar cvs-update-optional-flags nil
|
|
|
241 "*List of strings to use as optional flags to pass to ``cvs update''. Used
|
|
|
242 by cvs-do-update, called by cvs-update, cvs-update-other-window,
|
|
|
243 cvs-mode-update-no-prompt, and cvs-examine. Default is none.
|
|
|
244
|
|
|
245 For example set this to \"-j VENDOR_PREV_RELEASE -j VENDOR_TOP_RELEASE\" to
|
|
|
246 perform an update after a new vendor release has been imported.
|
|
|
247
|
|
|
248 To restrict the update to the current working directory, set this to \"-l\".")
|
|
|
249
|
|
|
250 (defvar cvs-update-prog-output-skip-regexp "$"
|
|
|
251 "*A regexp that matches the end of the output from all cvs update programs.
|
|
|
252 That is, output from any programs that are run by CVS (by the flag -u in the
|
|
|
253 `modules' file - see cvs(5)) when `cvs update' is performed should terminate
|
|
|
254 with a line that this regexp matches. It is enough that some part of the line
|
|
|
255 is matched.
|
|
|
256
|
|
|
257 The default (a single $) fits programs without output.")
|
|
|
258
|
|
|
259 ;;; --------------------------------------------------------
|
|
|
260 ;;; The variables below are used internally by pcl-cvs. You should
|
|
|
261 ;;; never change them.
|
|
|
262
|
|
|
263 (defvar cvs-buffers-to-delete nil
|
|
|
264 "List of temporary buffers that should be discarded as soon as possible.
|
|
|
265 Due to a bug in emacs 18.57 the sentinel can't discard them reliably.")
|
|
|
266
|
|
|
267 (defvar cvs-update-running nil
|
|
|
268 "This is set to nil when no process is running, and to
|
|
|
269 the process when a cvs update process is running.")
|
|
|
270
|
|
|
271 (defvar cvs-cookie-handle nil
|
|
|
272 "Handle for the cookie structure that is displayed in the *cvs* buffer.")
|
|
|
273
|
|
|
274 (defvar cvs-commit-list nil
|
|
|
275 "Used internally by pcl-cvs.")
|
|
|
276
|
|
|
277 ;;; The cvs data structure:
|
|
|
278 ;;;
|
|
|
279 ;;; When the `cvs update' is ready we parse the output. Every file
|
|
|
280 ;;; that is affected in some way is added as a cookie of fileinfo
|
|
|
281 ;;; (as defined below).
|
|
|
282 ;;;
|
|
|
283
|
|
|
284 ;;; cvs-fileinfo
|
|
|
285
|
|
|
286 ;;; Constructor:
|
|
|
287
|
|
|
288 (defun cvs-create-fileinfo (type
|
|
|
289 dir
|
|
|
290 file-name
|
|
|
291 full-log)
|
|
|
292 "Create a fileinfo from all parameters.
|
|
|
293 Arguments: TYPE DIR FILE-NAME FULL-LOG.
|
|
|
294 A fileinfo is a vector with the following fields:
|
|
|
295
|
|
|
296 [0] handled True if this file doesn't require further action.
|
|
|
297 [1] marked t/nil
|
|
|
298 [2] type One of
|
|
|
299 UPDATED - file copied from repository
|
|
|
300 PATCHED - file update with patch from repository
|
|
|
301 MODIFIED - modified by you, unchanged in
|
|
|
302 repository
|
|
|
303 ADDED - added by you, not yet committed
|
|
|
304 REMOVED - removed by you, not yet committed
|
|
|
305 CVS-REMOVED- removed, since file no longer exists
|
|
|
306 in the repository.
|
|
|
307 MERGED - successful merge
|
|
|
308 CONFLICT - conflict when merging (if pcl-cvs did it)
|
|
|
309 REM-CONFLICT-removed in repository, but altered
|
|
|
310 locally.
|
|
|
311 MOD-CONFLICT-removed locally, changed in repository.
|
|
|
312 REM-EXIST - removed locally, but still exists.
|
|
|
313 DIRCHANGE - A change of directory.
|
|
|
314 UNKNOWN - An unknown file.
|
|
|
315 UNKNOWN-DIR- An unknown directory.
|
|
|
316 MOVE-AWAY - A file that is in the way.
|
|
|
317 REPOS-MISSING- The directory has vanished from the
|
|
|
318 repository.
|
|
|
319 MESSAGE - This is a special fileinfo that is used
|
|
|
320 to display a text that should be in
|
|
|
321 full-log.
|
|
|
322 [3] dir Directory the file resides in. Should not end with slash.
|
|
|
323 [4] file-name The file name.
|
|
|
324 [5] backup-file The name of a backup file created during a merge.
|
|
|
325 Only valid for MERGED and CONFLICT files.
|
|
|
326 [6] base-revision The revision that the working file was based on.
|
|
|
327 Only valid for MERGED and CONFLICT files.
|
|
|
328 [7] head-revision The revision that the newly merged changes came from
|
|
|
329 Only valid for MERGED and CONFLICT files.
|
|
|
330 [8] backup-revision The revision of the cvs backup file (original working rev.)
|
|
|
331 Only valid for MERGED and CONFLICT files.
|
|
|
332 [9] cvs-diff-buffer A buffer that contains a 'cvs diff file'.
|
|
|
333 [10] vendor-diff-buffer A buffer that contains a 'diff base-file head-file'.
|
|
|
334 [11] backup-diff-buffer A buffer that contains a 'diff file backup-file'.
|
|
|
335 [12] full-log The output from cvs, unparsed.
|
|
|
336 [13] mod-time Modification time of file used for *-diff-buffer."
|
|
|
337
|
|
|
338 (cons
|
|
|
339 'CVS-FILEINFO
|
|
|
340 (vector nil nil type dir file-name nil nil nil nil nil nil nil full-log nil nil)))
|
|
|
341
|
|
|
342 ;;; Selectors:
|
|
|
343
|
|
|
344 (defun cvs-fileinfo->handled (cvs-fileinfo)
|
|
|
345 "Get the `handled' field from CVS-FILEINFO."
|
|
|
346 (elt (cdr cvs-fileinfo) 0))
|
|
|
347
|
|
|
348 (defun cvs-fileinfo->marked (cvs-fileinfo)
|
|
|
349 "Check if CVS-FILEINFO is marked."
|
|
|
350 (elt (cdr cvs-fileinfo) 1))
|
|
|
351
|
|
|
352 (defun cvs-fileinfo->type (cvs-fileinfo)
|
|
|
353 "Get type from CVS-FILEINFO.
|
|
|
354 Type is one of UPDATED, PATCHED, MODIFIED, ADDED, REMOVED, CVS-REMOVED, MERGED,
|
|
|
355 CONFLICT, REM-CONFLICT, MOD-CONFLICT, REM-EXIST, DIRCHANGE, UNKNOWN,
|
|
|
356 UNKNOWN-DIR, MOVE-AWAY, REPOS-MISSING or MESSAGE."
|
|
|
357 (elt (cdr cvs-fileinfo) 2))
|
|
|
358
|
|
|
359 (defun cvs-fileinfo->dir (cvs-fileinfo)
|
|
|
360 "Get dir from CVS-FILEINFO.
|
|
|
361 The directory name does not end with a slash."
|
|
|
362 (elt (cdr cvs-fileinfo) 3))
|
|
|
363
|
|
|
364 (defun cvs-fileinfo->file-name (cvs-fileinfo)
|
|
|
365 "Get file-name from CVS-FILEINFO."
|
|
|
366 (elt (cdr cvs-fileinfo) 4))
|
|
|
367
|
|
|
368 (defun cvs-fileinfo->backup-file (cvs-fileinfo)
|
|
|
369 "Get backup-file from CVS-FILEINFO."
|
|
|
370 (elt (cdr cvs-fileinfo) 5))
|
|
|
371
|
|
|
372 (defun cvs-fileinfo->base-revision (cvs-fileinfo)
|
|
|
373 "Get the base revision from CVS-FILEINFO."
|
|
|
374 (elt (cdr cvs-fileinfo) 6))
|
|
|
375
|
|
|
376 (defun cvs-fileinfo->head-revision (cvs-fileinfo)
|
|
|
377 "Get the head revision from CVS-FILEINFO."
|
|
|
378 (elt (cdr cvs-fileinfo) 7))
|
|
|
379
|
|
|
380 (defun cvs-fileinfo->backup-revision (cvs-fileinfo)
|
|
|
381 "Get the backup revision from CVS-FILEINFO."
|
|
|
382 (elt (cdr cvs-fileinfo) 8))
|
|
|
383
|
|
|
384 (defun cvs-fileinfo->cvs-diff-buffer (cvs-fileinfo)
|
|
|
385 "Get cvs-diff-buffer from CVS-FILEINFO."
|
|
|
386 (elt (cdr cvs-fileinfo) 9))
|
|
|
387
|
|
|
388 (defun cvs-fileinfo->vendor-diff-buffer (cvs-fileinfo)
|
|
|
389 "Get backup-diff-buffer from CVS-FILEINFO."
|
|
|
390 (elt (cdr cvs-fileinfo) 10))
|
|
|
391
|
|
|
392 (defun cvs-fileinfo->backup-diff-buffer (cvs-fileinfo)
|
|
|
393 "Get backup-diff-buffer from CVS-FILEINFO."
|
|
|
394 (elt (cdr cvs-fileinfo) 11))
|
|
|
395
|
|
|
396 (defun cvs-fileinfo->full-log (cvs-fileinfo)
|
|
|
397 "Get full-log from CVS-FILEINFO."
|
|
|
398 (elt (cdr cvs-fileinfo) 12))
|
|
|
399
|
|
|
400 (defun cvs-fileinfo->mod-time (cvs-fileinfo)
|
|
|
401 "Get mod-time from CVS-FILEINFO."
|
|
|
402 (elt (cdr cvs-fileinfo) 13))
|
|
|
403
|
|
|
404 ;;; Modifiers:
|
|
|
405
|
|
|
406 (defun cvs-set-fileinfo->handled (cvs-fileinfo newval)
|
|
|
407 "Set handled in CVS-FILEINFO to NEWVAL."
|
|
|
408 (aset (cdr cvs-fileinfo) 0 newval))
|
|
|
409
|
|
|
410 (defun cvs-set-fileinfo->marked (cvs-fileinfo newval)
|
|
|
411 "Set marked in CVS-FILEINFO to NEWVAL."
|
|
|
412 (aset (cdr cvs-fileinfo) 1 newval))
|
|
|
413
|
|
|
414 (defun cvs-set-fileinfo->type (cvs-fileinfo newval)
|
|
|
415 "Set type in CVS-FILEINFO to NEWVAL."
|
|
|
416 (aset (cdr cvs-fileinfo) 2 newval))
|
|
|
417
|
|
|
418 (defun cvs-set-fileinfo->dir (cvs-fileinfo newval)
|
|
|
419 "Set dir in CVS-FILEINFO to NEWVAL.
|
|
|
420 The directory should now end with a slash."
|
|
|
421 (aset (cdr cvs-fileinfo) 3 newval))
|
|
|
422
|
|
|
423 (defun cvs-set-fileinfo->file-name (cvs-fileinfo newval)
|
|
|
424 "Set file-name in CVS-FILEINFO to NEWVAL."
|
|
|
425 (aset (cdr cvs-fileinfo) 4 newval))
|
|
|
426
|
|
|
427 (defun cvs-set-fileinfo->backup-file (cvs-fileinfo newval)
|
|
|
428 "Set backup-file in CVS-FILEINFO to NEWVAL."
|
|
|
429 (aset (cdr cvs-fileinfo) 5 newval))
|
|
|
430
|
|
|
431 (defun cvs-set-fileinfo->base-revision (cvs-fileinfo newval)
|
|
|
432 "Set base-revision in CVS-FILEINFO to NEWVAL."
|
|
|
433 (aset (cdr cvs-fileinfo) 6 newval))
|
|
|
434
|
|
|
435 (defun cvs-set-fileinfo->head-revision (cvs-fileinfo newval)
|
|
|
436 "Set head-revision in CVS-FILEINFO to NEWVAL."
|
|
|
437 (aset (cdr cvs-fileinfo) 7 newval))
|
|
|
438
|
|
|
439 (defun cvs-set-fileinfo->backup-revision (cvs-fileinfo newval)
|
|
|
440 "Set backup-revision in CVS-FILEINFO to NEWVAL."
|
|
|
441 (aset (cdr cvs-fileinfo) 8 newval))
|
|
|
442
|
|
|
443 (defun cvs-set-fileinfo->cvs-diff-buffer (cvs-fileinfo newval)
|
|
|
444 "Set cvs-diff-buffer in CVS-FILEINFO to NEWVAL."
|
|
|
445 (aset (cdr cvs-fileinfo) 9 newval))
|
|
|
446
|
|
|
447 (defun cvs-set-fileinfo->vendor-diff-buffer (cvs-fileinfo newval)
|
|
|
448 "Set vendor-diff-buffer in CVS-FILEINFO to NEWVAL."
|
|
|
449 (aset (cdr cvs-fileinfo) 10 newval))
|
|
|
450
|
|
|
451 (defun cvs-set-fileinfo->backup-diff-buffer (cvs-fileinfo newval)
|
|
|
452 "Set backup-diff-buffer in CVS-FILEINFO to NEWVAL."
|
|
|
453 (aset (cdr cvs-fileinfo) 11 newval))
|
|
|
454
|
|
|
455 (defun cvs-set-fileinfo->full-log (cvs-fileinfo newval)
|
|
|
456 "Set full-log in CVS-FILEINFO to NEWVAL."
|
|
|
457 (aset (cdr cvs-fileinfo) 12 newval))
|
|
|
458
|
|
|
459 (defun cvs-set-fileinfo->mod-time (cvs-fileinfo newval)
|
|
|
460 "Set full-log in CVS-FILEINFO to NEWVAL."
|
|
|
461 (aset (cdr cvs-fileinfo) 13 newval))
|
|
|
462
|
|
|
463 ;;; Predicate:
|
|
|
464
|
|
|
465 (defun cvs-fileinfo-p (object)
|
|
|
466 "Return t if OBJECT is a cvs-fileinfo."
|
|
|
467 (eq (car-safe object) 'CVS-FILEINFO))
|
|
|
468
|
|
|
469 ;;;; End of types.
|
|
|
470
|
|
|
471 ;;----------
|
|
|
472 (defun cvs-use-temp-buffer ()
|
|
|
473 "Display a temporary buffer in another window and select it.
|
|
|
474 The selected window will not be changed. The temporary buffer will
|
|
|
475 be erased and writable."
|
|
|
476
|
|
|
477 (let ((dir default-directory))
|
|
|
478 (display-buffer (get-buffer-create cvs-temp-buffer-name))
|
|
|
479 (set-buffer cvs-temp-buffer-name)
|
|
|
480 (setq buffer-read-only nil)
|
|
|
481 (setq default-directory dir)
|
|
|
482 (erase-buffer)))
|
|
|
483
|
|
|
484 ;;----------
|
|
|
485 (defun cvs-examine (directory &optional local)
|
|
|
486 "Run a 'cvs -n update' in the current working directory.
|
|
|
487 That is, check what needs to be done, but don't change the disc.
|
|
|
488 Feed the output to a *cvs* buffer and run cvs-mode on it.
|
|
|
489 If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run.
|
|
|
490 WARNING: this doesn't work very well yet...."
|
|
|
491
|
|
|
492 ;; TODO: this should do everything cvs-update does...
|
|
|
493 ;; for example, for CONFLICT files, it should setup fileinfo appropriately
|
|
|
494
|
|
|
495 (interactive (list (read-file-name "CVS Update (directory): "
|
|
|
496 nil default-directory nil)
|
|
|
497 current-prefix-arg))
|
|
|
498 (cvs-do-update directory local 'noupdate))
|
|
|
499
|
|
|
500 ;;----------
|
|
|
501 ;;;###autoload
|
|
|
502 (defun cvs-update (directory &optional local)
|
|
|
503 "Run a 'cvs update' in the current working directory. Feed the
|
|
|
504 output to a *cvs* buffer and run cvs-mode on it.
|
|
|
505 If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run."
|
|
|
506
|
|
|
507 (interactive (list (read-file-name "CVS Update (directory): "
|
|
|
508 nil default-directory nil)
|
|
|
509 current-prefix-arg))
|
|
142
|
510 ;; If the previous prompt was in a dialog box, the save-some-buffers
|
|
|
511 ;; call in cvs-do-update will lose.
|
|
|
512 (let ((use-dialog-box nil))
|
|
|
513 (cvs-do-update directory local nil))
|
|
0
|
514 (switch-to-buffer cvs-buffer-name))
|
|
|
515
|
|
|
516 ;;----------
|
|
|
517 ;;;###autoload
|
|
|
518 (defun cvs-update-other-window (directory &optional local)
|
|
|
519 "Run a 'cvs update' in the current working directory. Feed the
|
|
|
520 output to a *cvs* buffer, display it in the other window, and run
|
|
|
521 cvs-mode on it.
|
|
|
522
|
|
|
523 If optional prefix argument LOCAL is non-nil, 'cvs update -l' is run."
|
|
|
524
|
|
|
525 (interactive (list (read-file-name "CVS Update other window (directory): "
|
|
|
526 nil default-directory nil)
|
|
|
527 current-prefix-arg))
|
|
|
528 (cvs-do-update directory local nil)
|
|
|
529 (switch-to-buffer-other-window cvs-buffer-name))
|
|
|
530
|
|
|
531 ;;----------
|
|
|
532 (defun cvs-filter (predicate list &rest extra-args)
|
|
|
533 "Apply PREDICATE to each element on LIST.
|
|
|
534 Args: PREDICATE LIST &rest EXTRA-ARGS.
|
|
|
535
|
|
|
536 Return a new list consisting of those elements that PREDICATE
|
|
|
537 returns non-nil for.
|
|
|
538
|
|
|
539 If more than two arguments are given the remaining args are
|
|
|
540 passed to PREDICATE."
|
|
|
541
|
|
|
542 ;; Avoid recursion - this should work for LONG lists also!
|
|
|
543 (let* ((head (cons 'dummy-header nil))
|
|
|
544 (tail head))
|
|
|
545 (while list
|
|
|
546 (if (apply predicate (car list) extra-args)
|
|
|
547 (setq tail (setcdr tail (list (car list)))))
|
|
|
548 (setq list (cdr list)))
|
|
|
549 (cdr head)))
|
|
|
550
|
|
|
551 ;;----------
|
|
|
552 (defun cvs-mode-update-no-prompt ()
|
|
|
553 "Run cvs update in current directory."
|
|
|
554
|
|
|
555 (interactive)
|
|
|
556 (cvs-do-update default-directory nil nil))
|
|
|
557
|
|
|
558 ;;----------
|
|
|
559 (defun cvs-do-update (directory local dont-change-disc)
|
|
|
560 "Do a 'cvs update' in DIRECTORY.
|
|
|
561 Args: DIRECTORY LOCAL DONT-CHANGE-DISC.
|
|
|
562
|
|
|
563 If LOCAL is non-nil 'cvs update -l' is executed.
|
|
|
564 If DONT-CHANGE-DISC is non-nil 'cvs -n update' is executed.
|
|
|
565 Both LOCAL and DONT-CHANGE-DISC may be non-nil simultaneously.
|
|
|
566
|
|
|
567 *Note*: DONT-CHANGE-DISC does not yet work. The parser gets confused."
|
|
|
568
|
|
|
569 (save-some-buffers)
|
|
|
570 ;; Ensure that it is safe to do an update. If not, ask user
|
|
|
571 ;; for confirmation.
|
|
|
572 (if (and (boundp 'cvs-cookie-handle) (collection-buffer cvs-cookie-handle))
|
|
|
573 (if (collection-collect-tin
|
|
|
574 cvs-cookie-handle
|
|
|
575 '(lambda (cookie) (eq (cvs-fileinfo->type cookie) 'CONFLICT)))
|
|
|
576 (if (not
|
|
|
577 (yes-or-no-p
|
|
|
578 "Only update if conflicts have been resolved. Continue? "))
|
|
|
579 (error "Update aborted by user request."))))
|
|
|
580 (if (not (file-exists-p cvs-program))
|
|
|
581 (error "%s: file not found (check setting of cvs-program)"
|
|
|
582 cvs-program))
|
|
|
583 (let* ((this-dir (file-name-as-directory (expand-file-name directory)))
|
|
|
584 (update-buffer (generate-new-buffer
|
|
|
585 (concat " " (file-name-nondirectory
|
|
|
586 (substring this-dir 0 -1))
|
|
|
587 "-update")))
|
|
|
588 (temp-name (make-temp-name
|
|
|
589 (concat (file-name-as-directory
|
|
|
590 (or (getenv "TMPDIR") "/tmp"))
|
|
|
591 "pcl-cvs.")))
|
|
|
592 (args nil))
|
|
|
593
|
|
|
594 ;; Check that this-dir exists and is a directory that is under CVS contr.
|
|
|
595
|
|
|
596 (if (not (file-directory-p this-dir))
|
|
|
597 (error "%s is not a directory." this-dir))
|
|
|
598 (if (not (file-directory-p (concat this-dir "CVS")))
|
|
|
599 (error "%s does not contain CVS controlled files." this-dir))
|
|
|
600 (if (file-readable-p (concat this-dir "CVS/Root"))
|
|
|
601 (save-excursion ; read CVS/Root into cvs-cvsroot
|
|
|
602 (find-file (concat this-dir "CVS/Root"))
|
|
|
603 (goto-char (point-min))
|
|
|
604 (setq cvs-cvsroot (buffer-substring (point)
|
|
|
605 (progn (end-of-line) (point))))
|
|
|
606 (if (not cvs-cvsroot)
|
|
|
607 (error "Invalid contents of %sCVS/Root" this-dir))
|
|
|
608 (kill-buffer (current-buffer)))
|
|
|
609 (if (and cvs-cvsroot-required
|
|
|
610 (not (or (getenv "CVSROOT") cvs-cvsroot)))
|
|
|
611 (error "Both cvs-cvsroot and environment variable CVSROOT are unset, and no CVS/Root.")))
|
|
|
612
|
|
|
613 ;; Check that at most one `cvs update' is run at any time.
|
|
|
614
|
|
|
615 (if (and cvs-update-running (process-status cvs-update-running)
|
|
|
616 (or (eq (process-status cvs-update-running) 'run)
|
|
|
617 (eq (process-status cvs-update-running) 'stop)))
|
|
|
618 (error "Can't run two `cvs update' simultaneously."))
|
|
|
619
|
|
|
620 (if (not (listp cvs-update-optional-flags))
|
|
|
621 (error "cvs-update-optional-flags should be set using cvs-set-update-optional-flags"))
|
|
|
622
|
|
|
623 ;; Generate "-d /master -n update -l".
|
|
|
624 (setq args (concat (if cvs-cvsroot (concat " -d " cvs-cvsroot))
|
|
|
625 (if dont-change-disc " -n ")
|
|
|
626 " update "
|
|
|
627 (if local " -l ")
|
|
|
628 (if cvs-update-optional-flags
|
|
|
629 (mapconcat 'identity
|
|
|
630 (copy-sequence cvs-update-optional-flags)
|
|
|
631 " "))))
|
|
|
632
|
|
|
633 ;; Set up the buffer that receives the stderr output from "cvs update".
|
|
|
634 (set-buffer update-buffer)
|
|
|
635 (setq default-directory this-dir)
|
|
|
636 (make-local-variable 'cvs-stdout-file)
|
|
|
637 (setq cvs-stdout-file temp-name)
|
|
|
638
|
|
|
639 (setq cvs-update-running
|
|
|
640 (let ((process-connection-type nil)) ; Use a pipe, not a pty.
|
|
|
641 (start-process "cvs" update-buffer cvs-shell "-c"
|
|
|
642 (concat cvs-program " " args " > " temp-name))))
|
|
|
643
|
|
|
644 (setq mode-line-process
|
|
|
645 (concat ": "
|
|
|
646 (symbol-name (process-status cvs-update-running))))
|
|
|
647 ; XEmacs change
|
|
|
648 (redraw-modeline) ; Update the mode line.
|
|
|
649 (set-process-sentinel cvs-update-running 'cvs-sentinel)
|
|
|
650 (set-process-filter cvs-update-running 'cvs-update-filter)
|
|
|
651 (set-marker (process-mark cvs-update-running) (point-min))
|
|
|
652
|
|
|
653 (save-excursion
|
|
|
654 (set-buffer (get-buffer-create cvs-buffer-name))
|
|
|
655 (setq buffer-read-only nil)
|
|
|
656 (erase-buffer)
|
|
|
657 (cvs-mode))
|
|
|
658
|
|
|
659 (setq cvs-cookie-handle
|
|
|
660 (collection-create
|
|
|
661 cvs-buffer-name 'cvs-pp
|
|
|
662 cvs-startup-message ;See comment above cvs-startup-message.
|
|
|
663 "---------- End -----"))
|
|
|
664
|
|
|
665 (cookie-enter-first
|
|
|
666 cvs-cookie-handle
|
|
|
667 (cvs-create-fileinfo
|
|
|
668 'MESSAGE nil nil (concat "\n Running `cvs " args "' in " this-dir
|
|
|
669 "...\n")))
|
|
|
670
|
|
|
671 (save-excursion
|
|
|
672 (set-buffer cvs-buffer-name)
|
|
|
673 (setq mode-line-process
|
|
|
674 (concat ": "
|
|
|
675 (symbol-name (process-status cvs-update-running))))
|
|
|
676 ; XEmacs change
|
|
|
677 (redraw-modeline) ; Update the mode line.
|
|
|
678 (setq buffer-read-only t))
|
|
|
679
|
|
|
680 ;; Work around a bug in emacs 18.57 and earlier.
|
|
|
681 (setq cvs-buffers-to-delete
|
|
|
682 (cvs-delete-unused-temporary-buffers cvs-buffers-to-delete)))
|
|
|
683
|
|
|
684 ;; The following line is said to improve display updates on some
|
|
|
685 ;; emacses. It shouldn't be needed, but it does no harm.
|
|
|
686 (sit-for 0))
|
|
|
687
|
|
|
688 ;;----------
|
|
|
689 (defun cvs-delete-unused-temporary-buffers (list)
|
|
|
690 "Delete all buffers on LIST that is not visible.
|
|
|
691 Return a list of all buffers that still is alive."
|
|
|
692
|
|
|
693 (cond
|
|
|
694 ((null list) nil)
|
|
|
695 ((get-buffer-window (car list))
|
|
|
696 (cons (car list)
|
|
|
697 (cvs-delete-unused-temporary-buffers (cdr list))))
|
|
|
698 (t
|
|
|
699 (kill-buffer (car list))
|
|
|
700 (cvs-delete-unused-temporary-buffers (cdr list)))))
|
|
|
701
|
|
|
702 ;;----------
|
|
|
703 (put 'cvs-mode 'mode-class 'special)
|
|
|
704
|
|
|
705 ;;----------
|
|
|
706 (defun cvs-mode ()
|
|
|
707 "\\<cvs-mode-map>Mode used for pcl-cvs, a front-end to CVS.
|
|
|
708
|
|
|
709 To get to the \"*cvs*\" buffer you should use ``\\[execute-extended-command] cvs-update''.
|
|
|
710
|
|
|
711 Full documentation is in the Texinfo file. Here are the most useful commands:
|
|
|
712
|
|
|
713 \\[cvs-mode-previous-line] Move up. \\[cvs-mode-next-line] Move down.
|
|
|
714 \\[cvs-mode-commit] Commit file. \\[cvs-mode-update-no-prompt] Re-update directory.
|
|
|
715 \\[cvs-mode-mark] Mark file/dir. \\[cvs-mode-unmark] Unmark file/dir.
|
|
|
716 \\[cvs-mode-mark-all-files] Mark all files. \\[cvs-mode-unmark-all-files] Unmark all files.
|
|
|
717 \\[cvs-mode-find-file] Edit file/run Dired. \\[cvs-mode-find-file-other-window] Find file or run Dired in other window.
|
|
|
718 \\[cvs-mode-ignore] Add file to ./.cvsignore. \\[cvs-mode-add-change-log-entry-other-window] Write ChangeLog in other window.
|
|
|
719 \\[cvs-mode-add] Add to repository. \\[cvs-mode-remove-file] Remove file.
|
|
|
720 \\[cvs-mode-diff-cvs] Diff with base revision. \\[cvs-mode-diff-backup] Diff backup file.
|
|
|
721 \\[cvs-mode-ediff] Ediff base rev & backup. \\[cvs-mode-diff-vendor] Show merge from vendor branch.
|
|
|
722 \\[cvs-mode-emerge] Emerge base rev & backup. \\[cvs-mode-diff-backup] Diff backup file.
|
|
|
723 \\[cvs-mode-acknowledge] Delete line from buffer. \\[cvs-mode-remove-handled] Remove processed entries.
|
|
|
724 \\[cvs-mode-log] Run ``cvs log''. \\[cvs-mode-status] Run ``cvs status''.
|
|
|
725 \\[cvs-mode-tag] Run ``cvs tag''. \\[cvs-mode-rtag] Run ``cvs rtag''.
|
|
|
726 \\[cvs-mode-changelog-commit] Like \\[cvs-mode-commit], but get default log text from ChangeLog.
|
|
|
727 \\[cvs-mode-undo-local-changes] Revert the last checked in version - discard your changes to the file.
|
|
|
728
|
|
|
729 Entry to this mode runs cvs-mode-hook.
|
|
142
|
730 This description is updated for release 1.05-CVS-$Name: r20-2b5 $ of pcl-cvs.
|
|
0
|
731
|
|
|
732 All bindings:
|
|
|
733 \\{cvs-mode-map}"
|
|
|
734
|
|
|
735 (interactive)
|
|
|
736 (setq major-mode 'cvs-mode)
|
|
|
737 (setq mode-name "CVS")
|
|
|
738 (setq mode-line-process nil)
|
|
|
739 ;; for older v18 emacs
|
|
|
740 ;;(buffer-flush-undo (current-buffer))
|
|
|
741 (buffer-disable-undo (current-buffer))
|
|
|
742 (make-local-variable 'goal-column)
|
|
|
743 (setq goal-column cvs-cursor-column)
|
|
|
744 (use-local-map cvs-mode-map)
|
|
|
745 (run-hooks 'cvs-mode-hook))
|
|
|
746
|
|
|
747 ;;----------
|
|
|
748 (defun cvs-sentinel (proc msg)
|
|
|
749 "Sentinel for the cvs update process.
|
|
|
750 This is responsible for parsing the output from the cvs update when
|
|
|
751 it is finished."
|
|
|
752
|
|
|
753 (cond
|
|
|
754 ((null (buffer-name (process-buffer proc)))
|
|
|
755 ;; buffer killed
|
|
|
756 (set-process-buffer proc nil))
|
|
|
757 ((memq (process-status proc) '(signal exit))
|
|
|
758 (let* ((obuf (current-buffer))
|
|
|
759 (omax (point-max))
|
|
|
760 (opoint (point)))
|
|
|
761 ;; save-excursion isn't the right thing if
|
|
|
762 ;; process-buffer is current-buffer
|
|
|
763 (unwind-protect
|
|
|
764 (progn
|
|
|
765 (set-buffer (process-buffer proc))
|
|
|
766 (setq mode-line-process
|
|
|
767 (concat ": "
|
|
|
768 (symbol-name (process-status proc))))
|
|
|
769 (let* ((out-file cvs-stdout-file)
|
|
|
770 (stdout-buffer (find-file-noselect out-file)))
|
|
|
771 (save-excursion
|
|
|
772 (set-buffer stdout-buffer)
|
|
|
773 (rename-buffer (concat " "
|
|
|
774 (file-name-nondirectory out-file)) t))
|
|
|
775 (cvs-parse-update stdout-buffer (process-buffer proc))
|
|
|
776 (setq cvs-buffers-to-delete
|
|
|
777 (cons (process-buffer proc)
|
|
|
778 (cons stdout-buffer
|
|
|
779 cvs-buffers-to-delete)))
|
|
|
780 (delete-file out-file)))
|
|
|
781 (message "CVS update process has completed.") ; XEmacs
|
|
|
782 (set-buffer-modified-p (buffer-modified-p))
|
|
|
783 (setq cvs-update-running nil))
|
|
|
784 (if (equal obuf (process-buffer proc))
|
|
|
785 nil
|
|
|
786 (set-buffer (process-buffer proc))
|
|
|
787 (if (< opoint omax)
|
|
|
788 (goto-char opoint))
|
|
|
789 (set-buffer obuf))))))
|
|
|
790
|
|
|
791 ;;----------
|
|
|
792 (defun cvs-update-filter (proc string)
|
|
|
793 "Filter function for pcl-cvs.
|
|
|
794 This function gets the output that CVS sends to stderr. It inserts it
|
|
|
795 into (process-buffer proc) but it also checks if CVS is waiting for a
|
|
|
796 lock file. If so, it inserts a message cookie in the *cvs* buffer."
|
|
|
797
|
|
|
798 (let ((old-buffer (current-buffer))
|
|
|
799 (data (match-data)))
|
|
|
800 (unwind-protect
|
|
|
801 (progn
|
|
|
802 (set-buffer (process-buffer proc))
|
|
|
803 (save-excursion
|
|
|
804 ;; Insert the text, moving the process-marker.
|
|
|
805 (goto-char (process-mark proc))
|
|
|
806 (insert string)
|
|
|
807 (set-marker (process-mark proc) (point))
|
|
|
808 ;; Delete any old lock message
|
|
|
809 (if (tin-nth cvs-cookie-handle 1)
|
|
|
810 (tin-delete cvs-cookie-handle
|
|
|
811 (tin-nth cvs-cookie-handle 1)))
|
|
|
812 ;; Check if CVS is waiting for a lock.
|
|
|
813 (beginning-of-line 0) ;Move to beginning of last
|
|
|
814 ;complete line.
|
|
|
815 (cond
|
|
|
816 ((looking-at
|
|
|
817 "^cvs \\(update\\|server\\): \\[..:..:..\\] waiting for \\(.*\\)lock in \\(.*\\)$")
|
|
|
818 (setq cvs-lock-file (buffer-substring (match-beginning 3)
|
|
|
819 (match-end 3)))
|
|
|
820 (cookie-enter-last
|
|
|
821 cvs-cookie-handle
|
|
|
822 (cvs-create-fileinfo
|
|
|
823 'MESSAGE nil nil
|
|
|
824 (concat "\tWaiting for "
|
|
|
825 (buffer-substring (match-beginning 2)
|
|
|
826 (match-end 2))
|
|
|
827 "lock in " cvs-lock-file
|
|
|
828 ".\n\t (type M-x cvs-delete-lock to delete it)")))))))
|
|
|
829 (store-match-data data)
|
|
|
830 (set-buffer old-buffer))))
|
|
|
831
|
|
|
832 ;;----------
|
|
|
833 (defun cvs-delete-lock ()
|
|
|
834 "Delete the lock file that CVS is waiting for.
|
|
|
835 Note that this can be dangerous. You should only do this
|
|
|
836 if you are convinced that the process that created the lock is dead."
|
|
|
837
|
|
|
838 (interactive)
|
|
|
839 (cond
|
|
|
840 ((not (or (file-exists-p
|
|
|
841 (concat (file-name-as-directory cvs-lock-file) "#cvs.lock"))
|
|
|
842 (cvs-filter (function cvs-lock-file-p)
|
|
|
843 (directory-files cvs-lock-file))))
|
|
|
844 (error "No lock files found."))
|
|
|
845 ((yes-or-no-p (concat "Really delete locks in " cvs-lock-file "? "))
|
|
|
846 ;; Re-read the directory -- the locks might have disappeared.
|
|
|
847 (let ((locks (cvs-filter (function cvs-lock-file-p)
|
|
|
848 (directory-files cvs-lock-file))))
|
|
|
849 (while locks
|
|
|
850 (delete-file (concat (file-name-as-directory cvs-lock-file)
|
|
|
851 (car locks)))
|
|
|
852 (setq locks (cdr locks)))
|
|
|
853 (cvs-remove-directory
|
|
|
854 (concat (file-name-as-directory cvs-lock-file) "#cvs.lock"))))))
|
|
|
855
|
|
|
856 ;;----------
|
|
|
857 (defun cvs-remove-directory (dir)
|
|
|
858 "Remove a directory."
|
|
|
859
|
|
|
860 (if (file-directory-p dir)
|
|
|
861 (call-process cvs-rmdir-program nil nil nil dir)
|
|
|
862 (error "Not a directory: %s" dir))
|
|
|
863 (if (file-exists-p dir)
|
|
|
864 (error "Could not remove directory %s" dir)))
|
|
|
865
|
|
|
866 ;;----------
|
|
|
867 (defun cvs-lock-file-p (file)
|
|
|
868 "Return true if FILE looks like a CVS lock file."
|
|
|
869
|
|
|
870 (or
|
|
|
871 (string-match "^#cvs.tfl.[0-9]+$" file)
|
|
|
872 (string-match "^#cvs.rfl.[0-9]+$" file)
|
|
|
873 (string-match "^#cvs.wfl.[0-9]+$" file)))
|
|
|
874
|
|
|
875 ;;----------
|
|
|
876 (defun cvs-quote-multiword-string (str)
|
|
|
877 "Return STR surrounded in single quotes if it contains whitespace."
|
|
|
878 (cond ((string-match "[ \t\n]" str)
|
|
|
879 (concat "'" str "'"))
|
|
|
880 (t
|
|
|
881 str)))
|
|
|
882
|
|
|
883 ;;----------
|
|
|
884 ;; this should be in subr.el or some similar place....
|
|
|
885 (defun parse-string (str &optional regexp)
|
|
|
886 "Explode the string STR into a list of words ala strtok(3). Optional REGEXP
|
|
|
887 defines regexp matching word separator, which defaults to \"[ \\t\\n]+\"."
|
|
|
888 (let (str-list ; new list
|
|
|
889 str-token ; "index" of next token
|
|
|
890 (str-start 0) ; "index" of current token
|
|
|
891 (str-sep (if regexp
|
|
|
892 regexp
|
|
|
893 "[ \t\n]+")))
|
|
|
894 (while (setq str-token (string-match str-sep str str-start))
|
|
|
895 (setq str-list
|
|
|
896 (nconc str-list
|
|
|
897 (list (substring str str-start str-token))))
|
|
|
898 (setq str-start (match-end 0)))
|
|
|
899 ;; tag on the remainder as the final item
|
|
|
900 (if (not (>= str-start (length str)))
|
|
|
901 (setq str-list
|
|
|
902 (nconc str-list
|
|
|
903 (list (substring str str-start)))))
|
|
|
904 str-list))
|
|
|
905
|
|
|
906 ;;----------
|
|
|
907 (defun cvs-make-list (str)
|
|
|
908 "Return list of words made from the string STR."
|
|
|
909 (cond ((string-match "[ \t\n]+" str)
|
|
|
910 (let ((new-str (parse-string str "[ \t\n]+")))
|
|
|
911 ;; this is ugly, but assume if the first element is empty, there are
|
|
|
912 ;; no more elements.
|
|
|
913 (cond ((string= (car new-str) "")
|
|
|
914 nil)
|
|
|
915 (t
|
|
|
916 new-str))))
|
|
|
917 ((string= str "")
|
|
|
918 nil)
|
|
|
919 (t
|
|
|
920 (list str))))
|
|
|
921
|
|
|
922 ;;----------
|
|
|
923 (defun cvs-skip-line (stdout stderr regexp &optional arg)
|
|
|
924 "Like forward-line, but check that the skipped line matches REGEXP.
|
|
|
925 Args: STDOUT STDERR REGEXP &optional ARG.
|
|
|
926
|
|
|
927 If it doesn't match REGEXP a bug report is generated and displayed.
|
|
|
928 STDOUT and STDERR is only used to do that.
|
|
|
929
|
|
|
930 If optional ARG, a number, is given the ARGth parenthesized expression
|
|
|
931 in the REGEXP is returned as a string.
|
|
|
932 Point should be in column 1 when this function is called."
|
|
|
933
|
|
|
934 (cond
|
|
|
935 ((looking-at regexp)
|
|
|
936 (forward-line 1)
|
|
|
937 (if arg
|
|
|
938 (buffer-substring (match-beginning arg)
|
|
|
939 (match-end arg))))
|
|
|
940 (t
|
|
|
941 (cvs-parse-error stdout
|
|
|
942 stderr
|
|
|
943 (if (eq (current-buffer) stdout)
|
|
|
944 'STDOUT
|
|
|
945 'STDERR)
|
|
|
946 (point)
|
|
|
947 regexp))))
|
|
|
948
|
|
|
949 ;;----------
|
|
|
950 (defun cvs-get-current-dir (root-dir dirname)
|
|
|
951 "Return current working directory, suitable for cvs-parse-update.
|
|
|
952 Args: ROOT-DIR DIRNAME.
|
|
|
953
|
|
|
954 Concatenates ROOT-DIR and DIRNAME to form an absolute path."
|
|
|
955
|
|
|
956 (if (string= "." dirname)
|
|
|
957 (substring root-dir 0 -1)
|
|
|
958 (concat root-dir dirname)))
|
|
|
959
|
|
|
960 ;;----------
|
|
|
961 (defun cvs-compare-fileinfos (a b)
|
|
|
962 "Compare fileinfo A with fileinfo B and return t if A is `less'."
|
|
|
963
|
|
|
964 (cond
|
|
|
965 ;; Sort acording to directories.
|
|
|
966 ((string< (cvs-fileinfo->dir a) (cvs-fileinfo->dir b)) t)
|
|
|
967 ((not (string= (cvs-fileinfo->dir a) (cvs-fileinfo->dir b))) nil)
|
|
|
968 ;; The DIRCHANGE entry is always first within the directory.
|
|
|
969 ((and (eq (cvs-fileinfo->type a) 'DIRCHANGE)
|
|
|
970 (not (eq (cvs-fileinfo->type b) 'DIRCHANGE))) t)
|
|
|
971 ((and (eq (cvs-fileinfo->type b) 'DIRCHANGE)
|
|
|
972 (not (eq (cvs-fileinfo->type a) 'DIRCHANGE))) nil)
|
|
|
973 ;; All files are sorted by file name.
|
|
|
974 ((string< (cvs-fileinfo->file-name a) (cvs-fileinfo->file-name b)))))
|
|
|
975
|
|
|
976 ;;----------
|
|
|
977 (defun cvs-parse-error (stdout-buffer stderr-buffer err-buf pos &optional indicator)
|
|
|
978 "Handle a parse error when parsing the output from cvs.
|
|
|
979 Args: STDOUT-BUFFER STDERR-BUFFER ERR-BUF POS &optional INDICATOR.
|
|
|
980
|
|
|
981 ERR-BUF should be 'STDOUT or 'STDERR."
|
|
|
982
|
|
|
983 (setq pos (1- pos))
|
|
|
984 (set-buffer cvs-buffer-name)
|
|
|
985 (setq buffer-read-only nil)
|
|
|
986 (erase-buffer)
|
|
|
987 (insert "To: " pcl-cvs-bugs-address "\n")
|
|
|
988 (insert "Subject: pcl-cvs release" pcl-cvs-version " parse error.\n")
|
|
|
989 (insert (concat mail-header-separator "\n"))
|
|
|
990 (insert "This bug report is automatically generated by pcl-cvs\n")
|
|
|
991 (insert "because it doesn't understand some output from CVS. Below\n")
|
|
|
992 (insert "is detailed information about the error. Please send\n")
|
|
|
993 (insert "this, together with any information you think might be\n")
|
|
|
994 (insert "useful for me to fix the bug, to the address above. But\n")
|
|
|
995 (insert "please check the \"known problems\" section of the\n")
|
|
|
996 (insert "documentation first. Note that this buffer contains\n")
|
|
|
997 (insert "information that you might consider confidential. You\n")
|
|
|
998 (insert "are encouraged to read through it before sending it.\n")
|
|
|
999 (insert "\n")
|
|
|
1000 (insert "Press C-c C-c to send this email.\n\n")
|
|
|
1001 (insert "Please state the version of these programs you are using:\n\n")
|
|
|
1002 (insert "RCS: \ndiff: \n\n")
|
|
|
1003
|
|
|
1004 (let* ((stdout (save-excursion (set-buffer stdout-buffer) (buffer-string)))
|
|
|
1005 (stderr (save-excursion (set-buffer stderr-buffer) (buffer-string)))
|
|
|
1006 (errstr (if (eq err-buf 'STDOUT) stdout stderr))
|
|
|
1007 (errline-end (string-match "\n" errstr pos))
|
|
|
1008 (errline (substring errstr pos errline-end)))
|
|
|
1009 (insert (format "Offending line (%d chars): >" (- errline-end pos)))
|
|
|
1010 (insert errline)
|
|
|
1011 (insert "<\n")
|
|
|
1012 (insert "Sent to " (symbol-name err-buf) " at pos " (format "%d\n" pos))
|
|
|
1013 (if indicator
|
|
|
1014 (insert "Optional args: \"" indicator "\".\n"))
|
|
|
1015 (insert "\nEmacs-version: " (emacs-version) "\n")
|
|
|
1016 (insert "Pcl-cvs Version: "
|
|
|
1017 "@(#)OrigId: pcl-cvs.el,v 1.93 1993/05/31 22:44:00 ceder Exp\n")
|
|
|
1018 (insert "CVS Version: "
|
|
142
|
1019 "@(#)lisp/pcl-cvs:$Name: r20-2b5 $:$Id: pcl-cvs.el,v 1.4 1997/05/09 03:28:08 steve Exp $\n\n")
|
|
0
|
1020 (insert (format "--- Contents of stdout buffer (%d chars) ---\n"
|
|
|
1021 (length stdout)))
|
|
|
1022 (insert stdout)
|
|
|
1023 (insert "--- End of stdout buffer ---\n")
|
|
|
1024 (insert (format "--- Contents of stderr buffer (%d chars) ---\n"
|
|
|
1025 (length stderr)))
|
|
|
1026 (insert stderr)
|
|
|
1027 (insert "--- End of stderr buffer ---\n")
|
|
|
1028 (insert "\nEnd of bug report.\n")
|
|
|
1029 (require 'sendmail)
|
|
|
1030 (mail-mode)
|
|
|
1031 (error "CVS parse error - please report this bug.")))
|
|
|
1032
|
|
|
1033 ;;----------
|
|
|
1034 (defun cvs-parse-update (stdout-buffer stderr-buffer)
|
|
|
1035 "Parse the output from `cvs update'.
|
|
|
1036
|
|
|
1037 Args: STDOUT-BUFFER STDERR-BUFFER.
|
|
|
1038
|
|
|
1039 This functions parses the from `cvs update' (which should be
|
|
|
1040 separated in its stdout- and stderr-components) and prints a
|
|
|
1041 pretty representation of it in the *cvs* buffer.
|
|
|
1042
|
|
|
1043 Signals an error if unexpected output was detected in the buffer."
|
|
|
1044
|
|
|
1045 (let* ((head (cons 'dummy nil))
|
|
|
1046 (tail (cvs-parse-stderr stdout-buffer stderr-buffer
|
|
|
1047 head default-directory))
|
|
|
1048 (root-dir default-directory))
|
|
|
1049 (cvs-parse-stdout stdout-buffer stderr-buffer tail root-dir)
|
|
|
1050 (setq head (sort (cdr head) (function cvs-compare-fileinfos)))
|
|
|
1051 (collection-clear cvs-cookie-handle)
|
|
|
1052 (collection-append-cookies cvs-cookie-handle head)
|
|
|
1053 (cvs-remove-stdout-shadows)
|
|
|
1054 (if cvs-auto-remove-handled-directories
|
|
|
1055 (cvs-remove-empty-directories))
|
|
|
1056 (set-buffer cvs-buffer-name)
|
|
|
1057 (cvs-mode)
|
|
|
1058 ;; XEmacs - tedium should let you know when it's ended...
|
|
|
1059 (if (pos-visible-in-window-p (point-min))
|
|
|
1060 nil ; assume that the user will see it...
|
|
|
1061 (ding t 'ready)
|
|
|
1062 (message "CVS update is ready."))
|
|
|
1063 (goto-char (point-min))
|
|
|
1064 (tin-goto-previous cvs-cookie-handle (point-min) 1)
|
|
|
1065 (setq default-directory root-dir)))
|
|
|
1066
|
|
|
1067 ;;----------
|
|
|
1068 (defun cvs-remove-stdout-shadows ()
|
|
|
1069 "Remove entries in the *cvs* buffer that comes from both stdout and stderr.
|
|
|
1070 If there is two entries for a single file the second one should be
|
|
|
1071 deleted. (Remember that sort uses a stable sort algorithm, so one can
|
|
|
1072 be sure that the stderr entry is always first)."
|
|
|
1073
|
|
|
1074 (collection-filter-tins cvs-cookie-handle
|
|
|
1075 (function
|
|
|
1076 (lambda (tin)
|
|
|
1077 (not (cvs-shadow-entry-p tin))))))
|
|
|
1078
|
|
|
1079 ;;----------
|
|
|
1080 (defun cvs-shadow-entry-p (tin)
|
|
|
1081 "Return non-nil if TIN is a shadow entry.
|
|
|
1082 Args: TIN.
|
|
|
1083
|
|
|
1084 A TIN is a shadow entry if the previous tin contains the same file."
|
|
|
1085
|
|
|
1086 (let* ((previous-tin (tin-previous cvs-cookie-handle tin))
|
|
|
1087 (curr (tin-cookie cvs-cookie-handle tin))
|
|
|
1088 (prev (and previous-tin
|
|
|
1089 (tin-cookie cvs-cookie-handle previous-tin))))
|
|
|
1090 (and
|
|
|
1091 prev curr
|
|
|
1092 (string= (cvs-fileinfo->file-name prev)
|
|
|
1093 (cvs-fileinfo->file-name curr))
|
|
|
1094 (string= (cvs-fileinfo->dir prev)
|
|
|
1095 (cvs-fileinfo->dir curr))
|
|
|
1096 (or
|
|
|
1097 (and (eq (cvs-fileinfo->type prev) 'CONFLICT)
|
|
|
1098 (eq (cvs-fileinfo->type curr) 'CONFLICT))
|
|
|
1099 (and (eq (cvs-fileinfo->type prev) 'MERGED)
|
|
|
1100 (eq (cvs-fileinfo->type curr) 'MODIFIED))
|
|
|
1101 (and (eq (cvs-fileinfo->type prev) 'REM-EXIST)
|
|
|
1102 (eq (cvs-fileinfo->type curr) 'REMOVED))))))
|
|
|
1103
|
|
|
1104 ;;----------
|
|
|
1105 (defun cvs-find-backup-file (filename &optional dirname)
|
|
|
1106 "Look for a backup file for FILENAME, optionally in directory DIRNAME, and if
|
|
|
1107 there is one, return the name of the first file found as a string."
|
|
|
1108
|
|
|
1109 (if (eq dirname nil)
|
|
|
1110 (setq dirname default-directory))
|
|
|
1111 (car (directory-files dirname nil (concat "^\\" cvs-bakprefix filename
|
|
|
1112 "\\."))))
|
|
|
1113
|
|
|
1114 ;;----------
|
|
|
1115 (defun cvs-find-backup-revision (filename)
|
|
|
1116 "Take FILENAME as the name of a cvs backup file and return the revision of
|
|
|
1117 that file as a string."
|
|
|
1118
|
|
|
1119 (substring filename
|
|
|
1120 (+ 1 (string-match "\\.\\([0-9.]+\\)$" filename))))
|
|
|
1121
|
|
|
1122 ;;----------
|
|
|
1123 (defun cvs-parse-stderr (stdout-buffer stderr-buffer head dir)
|
|
|
1124 "Parse the output from CVS that is written to stderr.
|
|
|
1125 Args: STDOUT-BUFFER STDERR-BUFFER HEAD DIR
|
|
|
1126
|
|
|
1127 STDOUT-BUFFER holds the output that cvs sent to stdout. It is only
|
|
|
1128 used to create a bug report in case there is a parse error.
|
|
|
1129 STDERR-BUFFER is the buffer that holds the output to parse.
|
|
|
1130 HEAD is a cons-cell, the head of the list that is built.
|
|
|
1131 DIR is the directory the `cvs update' was run in.
|
|
|
1132
|
|
|
1133 This function returns the last cons-cell in the list that is built."
|
|
|
1134
|
|
|
1135 (save-window-excursion
|
|
|
1136 (set-buffer stderr-buffer)
|
|
|
1137 (goto-char (point-min))
|
|
|
1138 (let ((current-dir dir)
|
|
|
1139 (root-dir dir))
|
|
|
1140
|
|
|
1141 (while (< (point) (point-max))
|
|
|
1142 (cond
|
|
|
1143
|
|
|
1144 ;; CVS is descending a subdirectory.
|
|
|
1145
|
|
|
1146 ((looking-at
|
|
|
1147 "^cvs \\(server\\|update\\): Updating \\(.*\\)$")
|
|
|
1148 (setq current-dir
|
|
|
1149 (cvs-get-current-dir
|
|
|
1150 root-dir
|
|
|
1151 (buffer-substring (match-beginning 2) (match-end 2))))
|
|
|
1152 (setcdr head (list (cvs-create-fileinfo
|
|
|
1153 'DIRCHANGE
|
|
|
1154 current-dir
|
|
|
1155 "." ; the old version had nil here???
|
|
|
1156 (buffer-substring (match-beginning 0)
|
|
|
1157 (match-end 0)))))
|
|
|
1158 (setq head (cdr head))
|
|
|
1159 (forward-line 1))
|
|
|
1160
|
|
|
1161 ;; File removed, since it is removed (by third party) in repository.
|
|
|
1162
|
|
|
1163 ((or (looking-at
|
|
|
1164 "^cvs \\(update\\|server\\): warning: \\(.*\\) is not (any longer) pertinent")
|
|
|
1165 (looking-at
|
|
|
1166 "^cvs \\(update\\|server\\): \\(.*\\) is no longer in the repository"))
|
|
|
1167
|
|
|
1168 (setcdr head (list (cvs-create-fileinfo
|
|
|
1169 'CVS-REMOVED
|
|
|
1170 current-dir
|
|
|
1171 (file-name-nondirectory
|
|
|
1172 (buffer-substring (match-beginning 2)
|
|
|
1173 (match-end 2)))
|
|
|
1174 (buffer-substring (match-beginning 0)
|
|
|
1175 (match-end 0)))))
|
|
|
1176 (setq head (cdr head))
|
|
|
1177 (forward-line 1))
|
|
|
1178
|
|
|
1179 ;; File removed by you, but recreated by cvs. Ignored. Will say
|
|
|
1180 ;; "Updated" on the next line.
|
|
|
1181
|
|
|
1182 ((looking-at
|
|
|
1183 "^cvs \\(update\\|server\\): warning: .* was lost$")
|
|
|
1184 (forward-line 1))
|
|
|
1185
|
|
|
1186 ;; File unknown for some reason.
|
|
|
1187 ;; FIXME: is it really a good idea to add this as unknown here?
|
|
|
1188
|
|
|
1189 ((looking-at
|
|
|
1190 "cvs \\(update\\|server\\): nothing known about \\(.*\\)$")
|
|
|
1191 (let ((filename (buffer-substring (match-beginning 2)
|
|
|
1192 (match-end 2))))
|
|
|
1193 (if (file-directory-p filename)
|
|
|
1194 (setcdr head (list (cvs-create-fileinfo
|
|
|
1195 'UNKNOWN-DIR
|
|
|
1196 current-dir
|
|
|
1197 "."
|
|
|
1198 (buffer-substring (match-beginning 0)
|
|
|
1199 (match-end 0)))))
|
|
|
1200 (setcdr head (list (cvs-create-fileinfo
|
|
|
1201 'UNKNOWN
|
|
|
1202 current-dir
|
|
|
1203 (file-name-nondirectory filename)
|
|
|
1204 (buffer-substring (match-beginning 0)
|
|
|
1205 (match-end 0)))))))
|
|
|
1206 (setq head (cdr head))
|
|
|
1207 (forward-line 1))
|
|
|
1208
|
|
|
1209 ;; A file that has been created by you, but added to the cvs
|
|
|
1210 ;; repository by another.
|
|
|
1211
|
|
|
1212 ((looking-at
|
|
|
1213 "^cvs \\(update\\|server\\): move away \\(.*\\); it is in the way$")
|
|
|
1214 (setcdr head (list (cvs-create-fileinfo
|
|
|
1215 'MOVE-AWAY
|
|
|
1216 current-dir
|
|
|
1217 (file-name-nondirectory
|
|
|
1218 (buffer-substring (match-beginning 2)
|
|
|
1219 (match-end 2)))
|
|
|
1220 (buffer-substring (match-beginning 0)
|
|
|
1221 (match-end 0)))))
|
|
|
1222 (setq head (cdr head))
|
|
|
1223 (forward-line 1))
|
|
|
1224
|
|
|
1225 ;; Cvs waits for a lock. Ignore.
|
|
|
1226
|
|
|
1227 ((looking-at
|
|
|
1228 "^cvs \\(update\\|server\\): \\[..:..:..\\] waiting for .*lock in ")
|
|
|
1229 (forward-line 1))
|
|
76
|
1230 ((looking-at
|
|
|
1231 "^cvs \\(update\\|server\\): \\[..:..:..\\] obtained lock in ")
|
|
|
1232 (forward-line 1))
|
|
0
|
1233
|
|
|
1234 ;; File removed in repository, but edited by you.
|
|
|
1235
|
|
|
1236 ((looking-at
|
|
|
1237 "^cvs \\(update\\|server\\): conflict: \\(.*\\) is modified but no longer in the repository$")
|
|
|
1238 (setcdr head (list
|
|
|
1239 (cvs-create-fileinfo
|
|
|
1240 'REM-CONFLICT
|
|
|
1241 current-dir
|
|
|
1242 (file-name-nondirectory
|
|
|
1243 (buffer-substring (match-beginning 2)
|
|
|
1244 (match-end 2)))
|
|
|
1245 (buffer-substring (match-beginning 0)
|
|
|
1246 (match-end 0)))))
|
|
|
1247 (setq head (cdr head))
|
|
|
1248 (forward-line 1))
|
|
|
1249
|
|
|
1250 ;; File removed in repository, but edited by someone else.
|
|
|
1251
|
|
|
1252 ((looking-at
|
|
|
1253 "^cvs \\(update\\|server\\): conflict: removed \\(.*\\) was modified by second party")
|
|
|
1254 (setcdr head
|
|
|
1255 (list
|
|
|
1256 (cvs-create-fileinfo
|
|
|
1257 'MOD-CONFLICT
|
|
|
1258 current-dir
|
|
|
1259 (buffer-substring (match-beginning 1)
|
|
|
1260 (match-end 1))
|
|
|
1261 (buffer-substring (match-beginning 0)
|
|
|
1262 (match-end 0)))))
|
|
|
1263 (setq head (cdr head))
|
|
|
1264 (forward-line 1))
|
|
|
1265
|
|
|
1266 ;; File removed in repository, but not in local directory.
|
|
|
1267
|
|
|
1268 ((looking-at
|
|
|
1269 "^cvs \\(update\\|server\\): \\(.*\\) should be removed and is still there")
|
|
|
1270 (setcdr head
|
|
|
1271 (list
|
|
|
1272 (cvs-create-fileinfo
|
|
|
1273 'REM-EXIST
|
|
|
1274 current-dir
|
|
|
1275 (buffer-substring (match-beginning 2)
|
|
|
1276 (match-end 2))
|
|
|
1277 (buffer-substring (match-beginning 0)
|
|
|
1278 (match-end 0)))))
|
|
|
1279 (setq head (cdr head))
|
|
|
1280 (forward-line 1))
|
|
|
1281
|
|
|
1282 ;; Error searching for repository
|
|
|
1283
|
|
|
1284 ((looking-at
|
|
|
1285 "^cvs \\(update\\|server\\): in directory ")
|
|
|
1286 (let ((start (point)))
|
|
|
1287 (forward-line 1)
|
|
|
1288 (cvs-skip-line stdout-buffer stderr-buffer
|
|
|
1289 (regexp-quote "cvs [update aborted]: there is no repository "))
|
|
|
1290 (setcdr head (list (cvs-create-fileinfo
|
|
|
1291 'REPOS-MISSING
|
|
|
1292 current-dir
|
|
|
1293 nil
|
|
|
1294 (buffer-substring start (point)))))
|
|
|
1295 (setq head (cdr head))))
|
|
|
1296
|
|
|
1297 ;; Silly warning from attempted conflict resolution. Ignored.
|
|
|
1298 ;; FIXME: Should it be?
|
|
|
1299 ;; eg.: "cvs update: cannot find revision APC-web-update in file .cvsignore"
|
|
|
1300 ;;
|
|
|
1301 ((looking-at
|
|
|
1302 "^cvs \\(update\\|server\\): cannot find revision \\(.*\\) in file \\(.*\\)$")
|
|
|
1303 (forward-line 1)
|
|
|
1304 (message "%s" (buffer-substring (match-beginning 0) (match-end 0))))
|
|
|
1305
|
|
|
1306 ;; CVS has decided to merge someone elses changes into this document.
|
|
|
1307 ;; About to start an rcsmerge operation...
|
|
|
1308 ;;
|
|
|
1309 ((looking-at
|
|
|
1310 "^RCS file: ")
|
|
|
1311
|
|
|
1312 ;; skip the "RCS file:" line...
|
|
|
1313 (forward-line 1)
|
|
|
1314
|
|
|
1315 (let ((complex-start (point))
|
|
|
1316 base-revision ; the first revision retrieved to merge from
|
|
|
1317 head-revision ; the second revision retrieved to merge from
|
|
|
1318 filename ; the name of the file being merged
|
|
|
1319 backup-file ; the name of the backup of the working file
|
|
|
1320 backup-revision) ; the revision of the original working file
|
|
|
1321
|
|
|
1322 (setq base-revision
|
|
|
1323 (cvs-skip-line stdout-buffer stderr-buffer
|
|
|
1324 "^retrieving revision \\(.*\\)$"
|
|
|
1325 1))
|
|
|
1326 (setq head-revision
|
|
|
1327 (cvs-skip-line stdout-buffer stderr-buffer
|
|
|
1328 "^retrieving revision \\(.*\\)$"
|
|
|
1329 1))
|
|
|
1330 (setq filename
|
|
|
1331 (cvs-skip-line stdout-buffer stderr-buffer
|
|
|
1332 "^Merging differences between [0-9.]+ and [0-9.]+ into \\(.*\\)$"
|
|
|
1333 1))
|
|
|
1334 (setq backup-file
|
|
|
1335 (cvs-find-backup-file filename current-dir))
|
|
|
1336 (setq backup-revision
|
|
|
1337 (cvs-find-backup-revision backup-file))
|
|
|
1338
|
|
|
1339 ;; Was there a conflict during the merge?
|
|
|
1340
|
|
|
1341 (cond
|
|
|
1342
|
|
|
1343 ;;;; From CVS-1.3 & RCS-5.6.0.1 with GNU-Diffutils-2.5:
|
|
|
1344 ;;;; "cvs update -j OLD-REV -j NEW-REV ."
|
|
|
1345 ;;
|
|
|
1346 ;; RCS file: /big/web-CVS/apc/cmd/Main/logout.sh,v
|
|
|
1347 ;; retrieving revision 1.1.1.1
|
|
|
1348 ;; retrieving revision 1.1.1.2
|
|
|
1349 ;; Merging differences between 1.1.1.1 and 1.1.1.2 into logout.sh
|
|
|
1350 ;; rcsmerge warning: overlaps during merge
|
|
|
1351
|
|
|
1352 ((looking-at
|
|
|
1353 ;; Allow both RCS 5.5 and 5.6. (5.6 prints "rcs" and " warning").
|
|
76
|
1354 "^\\(rcs\\)?merge[:]*\\( warning\\)?: \\(overlaps\\|conflicts\\) during merge$")
|
|
0
|
1355
|
|
|
1356 ;; Yes, this is a conflict.
|
|
|
1357 (cvs-skip-line stdout-buffer stderr-buffer
|
|
|
1358 "^\\(rcs\\)?merge[:]*\\( warning\\)?: \\(overlaps\\|conflicts\\) during merge$")
|
|
|
1359
|
|
|
1360 ;; this line doesn't seem to appear in all cases -- perhaps only
|
|
|
1361 ;; in "-j A -j B" usage, in which case this indicates ????
|
|
|
1362 (cvs-skip-line stdout-buffer stderr-buffer
|
|
|
1363 "^cvs \\(update\\|server\\): conflicts found in ")
|
|
|
1364
|
|
|
1365 (let ((fileinfo
|
|
|
1366 (cvs-create-fileinfo
|
|
|
1367 'CONFLICT current-dir
|
|
|
1368 filename
|
|
|
1369 (buffer-substring complex-start (point)))))
|
|
|
1370
|
|
|
1371 ;; squirrel away info about the files that were retrieved for merging
|
|
|
1372 (cvs-set-fileinfo->base-revision fileinfo base-revision)
|
|
|
1373 (cvs-set-fileinfo->head-revision fileinfo head-revision)
|
|
|
1374 (cvs-set-fileinfo->backup-revision fileinfo backup-revision)
|
|
|
1375 (cvs-set-fileinfo->backup-file fileinfo backup-file)
|
|
|
1376
|
|
|
1377 (setcdr head (list fileinfo))
|
|
|
1378 (setq head (cdr head))))
|
|
|
1379
|
|
|
1380 ;; Was it a conflict, and was RCS compiled without DIFF3_BIN, in
|
|
|
1381 ;; which case this is a failed conflict resolution?
|
|
|
1382
|
|
|
1383 ((looking-at
|
|
|
1384 ;; Allow both RCS 5.5 and 5.6. (5.6 prints "rcs" and " warning").
|
|
|
1385 "^\\(rcs\\)?merge\\( warning\\)?: overlaps or other problems during merge$")
|
|
|
1386
|
|
|
1387 (cvs-skip-line stdout-buffer stderr-buffer
|
|
|
1388 "^\\(rcs\\)?merge\\( warning\\)?: overlaps or other problems during merge$")
|
|
|
1389 (cvs-skip-line stdout-buffer stderr-buffer
|
|
|
1390 "^cvs update: could not merge ")
|
|
|
1391 (cvs-skip-line stdout-buffer stderr-buffer
|
|
|
1392 "^cvs update: restoring .* from backup file ")
|
|
|
1393 (let ((fileinfo
|
|
|
1394 (cvs-create-fileinfo
|
|
|
1395 'CONFLICT current-dir
|
|
|
1396 filename
|
|
|
1397 (buffer-substring complex-start (point)))))
|
|
|
1398 (setcdr head (list fileinfo))
|
|
|
1399 (setq head (cdr head))))
|
|
|
1400
|
|
|
1401 ;; Not a conflict; it must be a succesful merge.
|
|
|
1402
|
|
|
1403 (t
|
|
|
1404 (let ((fileinfo
|
|
|
1405 (cvs-create-fileinfo
|
|
|
1406 'MERGED current-dir
|
|
|
1407 filename
|
|
|
1408 (buffer-substring complex-start (point)))))
|
|
|
1409 (cvs-set-fileinfo->base-revision fileinfo base-revision)
|
|
|
1410 (cvs-set-fileinfo->head-revision fileinfo head-revision)
|
|
|
1411 (cvs-set-fileinfo->backup-revision fileinfo backup-revision)
|
|
|
1412 (cvs-set-fileinfo->backup-file fileinfo backup-file)
|
|
|
1413 (setcdr head (list fileinfo))
|
|
|
1414 (setq head (cdr head)))))))
|
|
|
1415
|
|
114
|
1416 ;; Patch failure message with CVS client.
|
|
|
1417 ;; Ignore, since a failed patch implies that the file proper
|
|
|
1418 ;; subsequently will be fetched from the server.
|
|
|
1419 ((looking-at
|
|
|
1420 "^[0-9]+ out of [0-9]+ hunks failed--saving rejects to ")
|
|
|
1421 (forward-line 1))
|
|
|
1422
|
|
0
|
1423 ;; Error messages from CVS (incomplete)
|
|
|
1424
|
|
|
1425 ((looking-at
|
|
|
1426 "^cvs \\(update\\|server\\): \\(invalid option .*\\)$")
|
|
|
1427 (error "Interface problem with CVS: %s"
|
|
|
1428 (buffer-substring (match-beginning 2) (match-end 2))))
|
|
|
1429
|
|
|
1430 ;; network errors
|
|
|
1431
|
|
|
1432 ;; Kerberos connection attempted but failed. This is not
|
|
|
1433 ;; really an error, as CVS will automatically fall back to
|
|
|
1434 ;; rsh. Plus it tries kerberos, if available, even when rsh
|
|
|
1435 ;; is what you really wanted.
|
|
|
1436
|
|
|
1437 ((looking-at
|
|
|
1438 "^cvs update: kerberos connect:.*$")
|
|
|
1439 (forward-line 1)
|
|
|
1440 (message "Remote CVS: %s"
|
|
|
1441 (buffer-substring (match-beginning 0) (match-end 0))))
|
|
|
1442
|
|
|
1443 ;; And when kerberos *does* fail, cvs prints out some stuff
|
|
|
1444 ;; as it tries rsh. Ignore that stuff too.
|
|
|
1445
|
|
|
1446 ((looking-at
|
|
|
1447 "^cvs update: trying to start server using rsh$")
|
|
|
1448 (forward-line 1))
|
|
|
1449
|
|
|
1450 ((looking-at
|
|
|
1451 "^\\([^:]*\\) Connection timed out")
|
|
|
1452 (error "Remote CVS: %s"
|
|
|
1453 (buffer-substring (match-beginning 0) (match-end 0))))
|
|
|
1454
|
|
|
1455 ((looking-at
|
|
|
1456 "^Permission denied.")
|
|
|
1457 (error "Remote CVS: %s"
|
|
|
1458 (buffer-substring (match-beginning 0) (match-end 0))))
|
|
|
1459
|
|
|
1460 ((looking-at
|
|
|
1461 "^cvs \\[update aborted\\]: premature end of file from server")
|
|
|
1462 (error "Remote CVS: %s"
|
|
|
1463 (buffer-substring (match-beginning 0) (match-end 0))))
|
|
|
1464
|
|
|
1465 ;; Empty line. Probably inserted by mistake by user (or developer :-)
|
|
|
1466 ;; Ignore.
|
|
|
1467
|
|
|
1468 ((looking-at
|
|
|
1469 "^$")
|
|
|
1470 (forward-line 1))
|
|
|
1471
|
|
|
1472 ;; top-level parser (cond) default clause
|
|
|
1473
|
|
|
1474 (t
|
|
|
1475 (cvs-skip-line stdout-buffer stderr-buffer
|
|
|
1476 "^UN-MATCHABLE-OUTPUT"))))))
|
|
|
1477
|
|
|
1478 ;; cause this function to return the head of the parser output list
|
|
|
1479 head)
|
|
|
1480
|
|
|
1481 ;;----------
|
|
|
1482 (defun cvs-parse-stdout (stdout-buffer stderr-buffer head root-dir)
|
|
|
1483 "Parse the output from CVS that is written to stderr.
|
|
|
1484 Args: STDOUT-BUFFER STDERR-BUFFER HEAD ROOT-DIR
|
|
|
1485
|
|
|
1486 STDOUT-BUFFER is the buffer that holds the output to parse.
|
|
|
1487 STDERR-BUFFER holds the output that cvs sent to stderr. It is only
|
|
|
1488 used to create a bug report in case there is a parse error.
|
|
|
1489
|
|
|
1490 HEAD is a cons-cell, the head of the list that is built.
|
|
|
1491 ROOT-DIR is the directory the `cvs update' was run in.
|
|
|
1492
|
|
|
1493 This function doesn't return anything particular."
|
|
|
1494
|
|
|
1495 (save-window-excursion
|
|
|
1496 (set-buffer stdout-buffer)
|
|
|
1497 (goto-char (point-min))
|
|
|
1498 (while (< (point) (point-max))
|
|
|
1499 (cond
|
|
|
1500
|
|
|
1501 ;; M: The file is modified by the user, and untouched in the repository.
|
|
|
1502 ;; A: The file is "cvs add"ed, but not "cvs ci"ed.
|
|
|
1503 ;; R: The file is "cvs remove"ed, but not "cvs ci"ed.
|
|
|
1504 ;; C: Conflict (only useful if a join was done and stderr has info...)
|
|
|
1505 ;; U: The file is copied from the repository.
|
|
|
1506 ;; ?: Unknown file or directory.
|
|
|
1507
|
|
|
1508 ((looking-at
|
|
|
1509 "^\\([MARCUP?]\\) \\(.*\\)$")
|
|
|
1510 (let*
|
|
|
1511 ((c (char-after (match-beginning 1)))
|
|
|
1512 (full-path (concat (file-name-as-directory root-dir)
|
|
|
1513 (buffer-substring (match-beginning 2)
|
|
|
1514 (match-end 2))))
|
|
|
1515 (isdir (file-directory-p full-path))
|
|
|
1516 (fileinfo (cvs-create-fileinfo
|
|
|
1517 (cond ((eq c ?M) 'MODIFIED)
|
|
|
1518 ((eq c ?A) 'ADDED)
|
|
|
1519 ((eq c ?R) 'REMOVED)
|
|
|
1520 ((eq c ?C) 'CONFLICT)
|
|
|
1521 ((eq c ?U) 'UPDATED)
|
|
|
1522 ((eq c ?P) 'PATCHED)
|
|
|
1523 ((eq c ??) (if isdir
|
|
|
1524 'UNKNOWN-DIR
|
|
|
1525 'UNKNOWN)))
|
|
|
1526 (substring (file-name-directory full-path) 0 -1)
|
|
|
1527 (file-name-nondirectory full-path)
|
|
|
1528 (buffer-substring (match-beginning 0) (match-end 0)))))
|
|
|
1529 ;; Updated and Patched files require no further action.
|
|
|
1530 (if (memq c '(?U ?P))
|
|
|
1531 (cvs-set-fileinfo->handled fileinfo t))
|
|
|
1532
|
|
|
1533 ;; Link this last on the list.
|
|
|
1534 (setcdr head (list fileinfo))
|
|
|
1535 (setq head (cdr head))
|
|
|
1536 (forward-line 1)))
|
|
|
1537
|
|
|
1538 ;; Executing a program because of the -u option in modules.
|
|
|
1539 ((looking-at
|
|
|
1540 "^cvs \\(update\\|server\\): Executing")
|
|
|
1541 ;; Skip by any output the program may generate to stdout.
|
|
|
1542 ;; Note that pcl-cvs will get seriously confused if the
|
|
|
1543 ;; program prints anything to stderr.
|
|
|
1544 (re-search-forward cvs-update-prog-output-skip-regexp)
|
|
|
1545 (forward-line 1))
|
|
|
1546
|
|
114
|
1547 ;; Patch informational message with CVS client.
|
|
|
1548 ;; Ignore, since this simply tells us that the patch in question
|
|
|
1549 ;; already has been applied to the file.
|
|
|
1550 ((looking-at
|
|
|
1551 "^.* already contains the differences between .* and ")
|
|
|
1552 (forward-line 1))
|
|
|
1553
|
|
0
|
1554 (t
|
|
|
1555 (cvs-parse-error stdout-buffer stderr-buffer 'STDOUT (point)
|
|
|
1556 "cvs-parse-stdout"))))))
|
|
|
1557
|
|
|
1558 ;;----------
|
|
|
1559 (defun cvs-pp (fileinfo)
|
|
|
1560 "Pretty print FILEINFO. Insert a printed representation in current buffer.
|
|
|
1561 For use by the cookie package."
|
|
|
1562
|
|
|
1563 (let ((a (cvs-fileinfo->type fileinfo))
|
|
|
1564 (s (if (cvs-fileinfo->marked fileinfo)
|
|
|
1565 "*" " "))
|
|
|
1566 (f (cvs-fileinfo->file-name fileinfo))
|
|
|
1567 (ci (if (cvs-fileinfo->handled fileinfo)
|
|
|
1568 " " "ci")))
|
|
|
1569 (insert
|
|
|
1570 (cond
|
|
|
1571 ((eq a 'UPDATED)
|
|
|
1572 (format "%s Updated %s" s f))
|
|
|
1573 ((eq a 'PATCHED)
|
|
|
1574 (format "%s Patched %s" s f))
|
|
|
1575 ((eq a 'MODIFIED)
|
|
|
1576 (format "%s Modified %s %s" s ci f))
|
|
|
1577 ((eq a 'MERGED)
|
|
|
1578 (format "%s Merged %s %s" s ci f))
|
|
|
1579 ((eq a 'CONFLICT)
|
|
|
1580 (format "%s Conflict %s" s f))
|
|
|
1581 ((eq a 'ADDED)
|
|
|
1582 (format "%s Added %s %s" s ci f))
|
|
|
1583 ((eq a 'REMOVED)
|
|
|
1584 (format "%s Removed %s %s" s ci f))
|
|
|
1585 ((eq a 'UNKNOWN)
|
|
|
1586 (format "%s Unknown %s" s f))
|
|
|
1587 ((eq a 'UNKNOWN-DIR)
|
|
|
1588 (format "%s Unknown dir %s" s f))
|
|
|
1589 ((eq a 'CVS-REMOVED)
|
|
|
1590 (format "%s Removed from repository: %s" s f))
|
|
|
1591 ((eq a 'REM-CONFLICT)
|
|
|
1592 (format "%s Conflict: Removed from repository, changed by you: %s" s f))
|
|
|
1593 ((eq a 'MOD-CONFLICT)
|
|
|
1594 (format "%s Conflict: Removed by you, changed in repository: %s" s f))
|
|
|
1595 ((eq a 'REM-EXIST)
|
|
|
1596 (format "%s Conflict: Removed by you, but still exists: %s" s f))
|
|
|
1597 ((eq a 'DIRCHANGE)
|
|
|
1598 (format "\nIn directory %s:" (cvs-fileinfo->dir fileinfo)))
|
|
|
1599 ((eq a 'MOVE-AWAY)
|
|
|
1600 (format "%s Move away %s - it is in the way" s f))
|
|
|
1601 ((eq a 'REPOS-MISSING)
|
|
|
1602 (format " This repository directory is missing! Remove this directory manually."))
|
|
|
1603 ((eq a 'MESSAGE)
|
|
|
1604 (cvs-fileinfo->full-log fileinfo))
|
|
|
1605 (t
|
|
|
1606 (format "%s Internal error! %s" s f))))))
|
|
|
1607
|
|
|
1608
|
|
|
1609 ;;; You can define your own keymap in .emacs. pcl-cvs.el won't overwrite it.
|
|
|
1610
|
|
|
1611 (if cvs-mode-map
|
|
|
1612 nil
|
|
|
1613 (setq cvs-mode-map (make-keymap))
|
|
|
1614 (suppress-keymap cvs-mode-map)
|
|
|
1615 (define-prefix-command 'cvs-mode-map-control-c-prefix)
|
|
|
1616 (define-key cvs-mode-map "\C-?" 'cvs-mode-unmark-up)
|
|
|
1617 (define-key cvs-mode-map "\C-k" 'cvs-mode-acknowledge)
|
|
|
1618 (define-key cvs-mode-map "\C-n" 'cvs-mode-next-line)
|
|
|
1619 (define-key cvs-mode-map "\C-p" 'cvs-mode-previous-line)
|
|
|
1620 ;; ^C- keys are used to set various flags to control CVS features
|
|
|
1621 (define-key cvs-mode-map "\C-c" 'cvs-mode-map-control-c-prefix)
|
|
76
|
1622 (define-key cvs-mode-map "\C-c\C-c" 'cvs-change-cvsroot)
|
|
|
1623 (define-key cvs-mode-map "\C-c\C-d" 'cvs-set-diff-flags)
|
|
|
1624 (define-key cvs-mode-map "\C-c\C-l" 'cvs-set-log-flags)
|
|
|
1625 (define-key cvs-mode-map "\C-c\C-s" 'cvs-set-status-flags)
|
|
|
1626 (define-key cvs-mode-map "\C-c\C-u" 'cvs-set-update-optional-flags)
|
|
0
|
1627 ;; M- keys are usually those that operate on modules
|
|
|
1628 (define-key cvs-mode-map "\M-\C-?" 'cvs-mode-unmark-all-files)
|
|
|
1629 (define-key cvs-mode-map "\M-C" 'cvs-mode-rcs2log) ; i.e. "Create a ChangeLog"
|
|
|
1630 (define-key cvs-mode-map "\M-a" 'cvs-mode-admin)
|
|
|
1631 (define-key cvs-mode-map "\M-c" 'cvs-mode-checkout)
|
|
|
1632 (define-key cvs-mode-map "\M-o" 'cvs-mode-checkout-other-window)
|
|
|
1633 (define-key cvs-mode-map "\M-p" 'cvs-mode-rdiff) ; i.e. "create a Patch"
|
|
|
1634 (define-key cvs-mode-map "\M-r" 'cvs-mode-release)
|
|
|
1635 (define-key cvs-mode-map "\M-t" 'cvs-mode-rtag)
|
|
|
1636 ;; keys that operate on files
|
|
|
1637 (define-key cvs-mode-map " " 'cvs-mode-next-line)
|
|
|
1638 (define-key cvs-mode-map "?" 'describe-mode)
|
|
|
1639 (define-key cvs-mode-map "A" 'cvs-mode-add-change-log-entry-other-window)
|
|
|
1640 (define-key cvs-mode-map "B" 'cvs-mode-byte-compile-files)
|
|
|
1641 (define-key cvs-mode-map "C" 'cvs-mode-changelog-commit)
|
|
|
1642 (define-key cvs-mode-map "E" 'cvs-mode-emerge)
|
|
|
1643 (define-key cvs-mode-map "G" 'cvs-update)
|
|
|
1644 (define-key cvs-mode-map "M" 'cvs-mode-mark-all-files)
|
|
|
1645 (define-key cvs-mode-map "Q" 'cvs-examine)
|
|
|
1646 (define-key cvs-mode-map "R" 'cvs-mode-revert-updated-buffers)
|
|
|
1647 (define-key cvs-mode-map "U" 'cvs-mode-undo-local-changes)
|
|
|
1648 (define-key cvs-mode-map "a" 'cvs-mode-add)
|
|
|
1649 (define-key cvs-mode-map "b" 'cvs-mode-diff-backup)
|
|
|
1650 (define-key cvs-mode-map "c" 'cvs-mode-commit)
|
|
|
1651 (define-key cvs-mode-map "d" 'cvs-mode-diff-cvs)
|
|
|
1652 (define-key cvs-mode-map "e" 'cvs-mode-ediff)
|
|
|
1653 (define-key cvs-mode-map "f" 'cvs-mode-find-file)
|
|
|
1654 (define-key cvs-mode-map "g" 'cvs-mode-update-no-prompt)
|
|
|
1655 (define-key cvs-mode-map "i" 'cvs-mode-ignore)
|
|
|
1656 (define-key cvs-mode-map "l" 'cvs-mode-log)
|
|
|
1657 (define-key cvs-mode-map "m" 'cvs-mode-mark)
|
|
|
1658 (define-key cvs-mode-map "n" 'cvs-mode-next-line)
|
|
|
1659 (define-key cvs-mode-map "o" 'cvs-mode-find-file-other-window)
|
|
|
1660 (define-key cvs-mode-map "p" 'cvs-mode-previous-line)
|
|
|
1661 (define-key cvs-mode-map "q" 'bury-buffer)
|
|
|
1662 (define-key cvs-mode-map "r" 'cvs-mode-remove-file)
|
|
|
1663 (define-key cvs-mode-map "s" 'cvs-mode-status)
|
|
|
1664 (define-key cvs-mode-map "t" 'cvs-mode-tag)
|
|
|
1665 (define-key cvs-mode-map "u" 'cvs-mode-unmark)
|
|
|
1666 (define-key cvs-mode-map "v" 'cvs-mode-diff-vendor)
|
|
|
1667 (define-key cvs-mode-map "x" 'cvs-mode-remove-handled))
|
|
|
1668
|
|
|
1669 ;;----------
|
|
|
1670 (defun cvs-get-marked (&optional ignore-marks ignore-contents)
|
|
|
1671 "Return a list of all selected tins.
|
|
|
1672 Args: &optional IGNORE-MARKS IGNORE-CONTENTS.
|
|
|
1673
|
|
|
1674 If there are any marked tins, and IGNORE-MARKS is nil, return them. Otherwise,
|
|
|
1675 if the cursor selects a directory, return all files in it, unless there are
|
|
|
1676 none, in which case just return the directory; or unless IGNORE-CONTENTS is not
|
|
|
1677 nil, in which case also just return the directory. Otherwise return (a list
|
|
|
1678 containing) the file the cursor points to, or an empty list if it doesn't point
|
|
|
1679 to a file at all."
|
|
|
1680
|
|
|
1681 (cond
|
|
|
1682 ;; Any marked cookies?
|
|
|
1683 ((and (not ignore-marks)
|
|
|
1684 (collection-collect-tin cvs-cookie-handle 'cvs-fileinfo->marked)))
|
|
|
1685 ;; Nope.
|
|
|
1686 ((and (not ignore-contents)
|
|
|
1687 (let ((sel (tin-locate cvs-cookie-handle (point))))
|
|
|
1688 (cond
|
|
|
1689 ;; If a directory is selected, all it members are returned.
|
|
|
1690 ((and sel (eq (cvs-fileinfo->type (tin-cookie cvs-cookie-handle
|
|
|
1691 sel))
|
|
|
1692 'DIRCHANGE))
|
|
|
1693 (let ((retsel
|
|
|
1694 (collection-collect-tin cvs-cookie-handle
|
|
|
1695 'cvs-dir-member-p
|
|
|
1696 (cvs-fileinfo->dir (tin-cookie
|
|
|
1697 cvs-cookie-handle sel)))))
|
|
|
1698 (if retsel
|
|
|
1699 retsel
|
|
|
1700 (list sel))))
|
|
|
1701 (t
|
|
|
1702 (list sel))))))
|
|
|
1703 (t
|
|
|
1704 (list (tin-locate cvs-cookie-handle (point))))))
|
|
|
1705
|
|
|
1706 ;;----------
|
|
|
1707 (defun cvs-dir-member-p (fileinfo dir)
|
|
|
1708 "Return true if FILEINFO represents a file in directory DIR."
|
|
|
1709
|
|
|
1710 (and (not (eq (cvs-fileinfo->type fileinfo) 'DIRCHANGE))
|
|
|
1711 (string= (cvs-fileinfo->dir fileinfo) dir)))
|
|
|
1712
|
|
|
1713 ;;----------
|
|
|
1714 (defun cvs-dir-empty-p (tin)
|
|
|
1715 "Return non-nil if TIN is a directory that is empty.
|
|
|
1716 Args: CVS-BUF TIN."
|
|
|
1717
|
|
|
1718 (and (eq (cvs-fileinfo->type (tin-cookie cvs-cookie-handle tin)) 'DIRCHANGE)
|
|
|
1719 (or (not (tin-next cvs-cookie-handle tin))
|
|
|
1720 (eq (cvs-fileinfo->type
|
|
|
1721 (tin-cookie cvs-cookie-handle
|
|
|
1722 (tin-next cvs-cookie-handle tin)))
|
|
|
1723 'DIRCHANGE))))
|
|
|
1724
|
|
|
1725 ;;----------
|
|
|
1726 (defun cvs-mode-revert-updated-buffers ()
|
|
|
1727 "Revert any buffers that are UPDATED, PATCHED, MERGED or CONFLICT."
|
|
|
1728
|
|
|
1729 (interactive)
|
|
|
1730 (cookie-map (function cvs-revert-fileinfo) cvs-cookie-handle))
|
|
|
1731
|
|
|
1732 ;;----------
|
|
|
1733 (defun cvs-revert-fileinfo (fileinfo)
|
|
|
1734 "Revert the buffer that holds the file in FILEINFO if it has changed,
|
|
|
1735 and if the type is UPDATED, PATCHED, MERGED or CONFLICT."
|
|
|
1736
|
|
|
1737 (let* ((type (cvs-fileinfo->type fileinfo))
|
|
|
1738 (file (cvs-fileinfo->full-path fileinfo))
|
|
|
1739 (buffer (get-file-buffer file)))
|
|
|
1740 ;; For a revert to happen...
|
|
|
1741 (cond
|
|
|
1742 ((and
|
|
|
1743 ;; ...the type must be one that justifies a revert...
|
|
|
1744 (or (eq type 'UPDATED)
|
|
|
1745 (eq type 'PATCHED)
|
|
|
1746 (eq type 'MERGED)
|
|
|
1747 (eq type 'CONFLICT))
|
|
|
1748 ;; ...and the user must be editing the file...
|
|
|
1749 buffer)
|
|
|
1750 (save-excursion
|
|
|
1751 (set-buffer buffer)
|
|
|
1752 (cond
|
|
|
1753 ((buffer-modified-p)
|
|
|
1754 (error "%s: edited since last cvs-update."
|
|
|
1755 (buffer-file-name)))
|
|
|
1756 ;; Go ahead and revert the file.
|
|
|
1757 (t (revert-buffer 'dont-use-auto-save-file 'dont-ask))))))))
|
|
|
1758
|
|
|
1759 ;;----------
|
|
|
1760 (defun cvs-mode-remove-handled ()
|
|
|
1761 "Remove all lines that are handled.
|
|
|
1762 Empty directories are removed."
|
|
|
1763
|
|
|
1764 (interactive)
|
|
|
1765 ;; Pass one: remove files that are handled.
|
|
|
1766 (collection-filter-cookies cvs-cookie-handle
|
|
|
1767 (function
|
|
|
1768 (lambda (fileinfo)
|
|
|
1769 (not (cvs-fileinfo->handled fileinfo)))))
|
|
|
1770 ;; Pass two: remove empty directories.
|
|
|
1771 (if cvs-auto-remove-handled-directories
|
|
|
1772 (cvs-remove-empty-directories)))
|
|
|
1773
|
|
|
1774 ;;----------
|
|
|
1775 (defun cvs-remove-empty-directories ()
|
|
|
1776 "Remove empty directories in the *cvs* buffer."
|
|
|
1777
|
|
|
1778 (collection-filter-tins cvs-cookie-handle
|
|
|
1779 (function
|
|
|
1780 (lambda (tin)
|
|
|
1781 (not (cvs-dir-empty-p tin))))))
|
|
|
1782
|
|
|
1783 ;;----------
|
|
|
1784 (defun cvs-mode-mark (pos)
|
|
|
1785 "Mark a fileinfo.
|
|
|
1786 Args: POS.
|
|
|
1787
|
|
|
1788 If the fileinfo is a directory, all the contents of that directory are marked
|
|
|
1789 instead. A directory can never be marked. POS is a buffer position."
|
|
|
1790
|
|
|
1791 (interactive "d")
|
|
|
1792 (let* ((tin (tin-locate cvs-cookie-handle pos))
|
|
|
1793 (sel (tin-cookie cvs-cookie-handle tin)))
|
|
|
1794 (cond
|
|
|
1795 ;; Does POS point to a directory? If so, mark all files in that directory.
|
|
|
1796 ((eq (cvs-fileinfo->type sel) 'DIRCHANGE)
|
|
|
1797 (cookie-map
|
|
|
1798 (function (lambda (f dir)
|
|
|
1799 (cond
|
|
|
1800 ((cvs-dir-member-p f dir)
|
|
|
1801 (cvs-set-fileinfo->marked f t)
|
|
|
1802 t)))) ; Tell cookie to redisplay this cookie.
|
|
|
1803 cvs-cookie-handle
|
|
|
1804 (cvs-fileinfo->dir sel)))
|
|
|
1805 (t
|
|
|
1806 (cvs-set-fileinfo->marked sel t)
|
|
|
1807 (tin-invalidate cvs-cookie-handle tin)
|
|
|
1808 (tin-goto-next cvs-cookie-handle pos 1)))))
|
|
|
1809
|
|
|
1810 ;;----------
|
|
|
1811 (defun cvs-committable (tin)
|
|
|
1812 "Check if the TIN is committable.
|
|
|
1813 It is committable if it
|
|
|
1814 a) is not handled and
|
|
|
1815 b) is either MODIFIED, ADDED, REMOVED, MERGED or CONFLICT."
|
|
|
1816
|
|
|
1817 (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
|
|
|
1818 (type (cvs-fileinfo->type fileinfo)))
|
|
|
1819 (and (not (cvs-fileinfo->handled fileinfo))
|
|
|
1820 (or (eq type 'MODIFIED)
|
|
|
1821 (eq type 'ADDED)
|
|
|
1822 (eq type 'REMOVED)
|
|
|
1823 (eq type 'MERGED)
|
|
|
1824 (eq type 'CONFLICT)))))
|
|
|
1825
|
|
|
1826 ;;----------
|
|
|
1827 (defun cvs-mode-commit ()
|
|
|
1828 "Check in all marked files, or the current file.
|
|
|
1829 The user will be asked for a log message in a buffer.
|
|
|
1830 If cvs-erase-input-buffer is non-nil that buffer will be erased.
|
|
|
1831 Otherwise mark and point will be set around the entire contents of the
|
|
|
1832 buffer so that it is easy to kill the contents of the buffer with \\[kill-region]."
|
|
|
1833
|
|
|
1834 (interactive)
|
|
|
1835 (let* ((cvs-buf (current-buffer))
|
|
|
1836 (marked (cvs-filter (function cvs-committable)
|
|
|
1837 (cvs-get-marked))))
|
|
|
1838 (if (null marked)
|
|
|
1839 (error "Nothing to commit!")
|
|
|
1840 (pop-to-buffer (get-buffer-create cvs-commit-prompt-buffer))
|
|
|
1841 (goto-char (point-min))
|
|
|
1842
|
|
|
1843 (if cvs-erase-input-buffer
|
|
|
1844 (erase-buffer)
|
|
|
1845 (push-mark (point-max)))
|
|
|
1846 (cvs-edit-mode)
|
|
|
1847 (make-local-variable 'cvs-commit-list)
|
|
|
1848 (setq cvs-commit-list marked)
|
|
|
1849 (message "Press C-c C-c when you are done editing."))))
|
|
|
1850
|
|
|
1851 ;;----------
|
|
|
1852 (defun cvs-edit-done ()
|
|
|
1853 "Commit the files to the repository."
|
|
|
1854
|
|
|
1855 (interactive)
|
|
|
1856 (if (null cvs-commit-list)
|
|
|
1857 (error "You have already committed the files"))
|
|
|
1858 (if (and (> (point-max) 1)
|
|
|
1859 (/= (char-after (1- (point-max))) ?\n)
|
|
|
1860 (or (eq cvs-commit-buffer-require-final-newline t)
|
|
|
1861 (and cvs-commit-buffer-require-final-newline
|
|
|
1862 (yes-or-no-p
|
|
|
1863 (format "Buffer %s does not end in newline. Add one? "
|
|
|
1864 (buffer-name))))))
|
|
|
1865 (save-excursion
|
|
|
1866 (goto-char (point-max))
|
|
|
1867 (insert ?\n)))
|
|
|
1868 (save-some-buffers)
|
|
|
1869 (let ((cc-list cvs-commit-list)
|
|
|
1870 (cc-buffer (get-buffer cvs-buffer-name))
|
|
|
1871 (msg-buffer (current-buffer))
|
|
|
1872 (msg (buffer-substring (point-min) (point-max))))
|
|
|
1873 (pop-to-buffer cc-buffer)
|
|
|
1874 (bury-buffer msg-buffer)
|
|
|
1875 (cvs-use-temp-buffer)
|
|
|
1876 (message "Committing...")
|
|
|
1877 (if (cvs-execute-list cc-list cvs-program
|
|
|
1878 (if cvs-cvsroot
|
|
|
1879 (list "-d" cvs-cvsroot "commit" "-m" msg)
|
|
|
1880 (list "commit" "-m" msg))
|
|
|
1881 "Committing %s...")
|
|
|
1882 (error "Something went wrong. Check the %s buffer carefully."
|
|
|
1883 cvs-temp-buffer-name))
|
|
|
1884 ;; FIXME: don't do any of this if the commit fails.
|
|
|
1885 (let ((ccl cc-list))
|
|
|
1886 (while ccl
|
|
|
1887 (cvs-after-commit-function (tin-cookie cvs-cookie-handle (car ccl)))
|
|
|
1888 (setq ccl (cdr ccl))))
|
|
|
1889 (apply 'tin-invalidate cvs-cookie-handle cc-list)
|
|
|
1890 (set-buffer msg-buffer)
|
|
|
1891 (setq cvs-commit-list nil)
|
|
|
1892 (set-buffer cc-buffer)
|
|
|
1893 (if cvs-auto-remove-handled
|
|
|
1894 (cvs-mode-remove-handled)))
|
|
|
1895
|
|
|
1896 (message "Committing... Done."))
|
|
|
1897
|
|
|
1898 ;;----------
|
|
|
1899 (defun cvs-after-commit-function (fileinfo)
|
|
|
1900 "Do everything that needs to be done when FILEINFO has been committed.
|
|
|
1901 The fileinfo->handle is set, and if the buffer is present it is reverted."
|
|
|
1902
|
|
|
1903 (cvs-set-fileinfo->handled fileinfo t)
|
|
|
1904 (if cvs-auto-revert-after-commit
|
|
|
1905 (let* ((file (cvs-fileinfo->full-path fileinfo))
|
|
|
1906 (buffer (get-file-buffer file)))
|
|
|
1907 ;; For a revert to happen...
|
|
|
1908 (if buffer
|
|
|
1909 ;; ...the user must be editing the file...
|
|
|
1910 (save-excursion
|
|
|
1911 (set-buffer buffer)
|
|
|
1912 (if (not (buffer-modified-p))
|
|
|
1913 ;; ...but it must be unmodified.
|
|
|
1914 (revert-buffer 'dont-use-auto-save-file 'dont-ask)))))))
|
|
|
1915
|
|
|
1916 ;;----------
|
|
|
1917 (defun cvs-execute-list (tin-list program constant-args &optional message-fmt)
|
|
|
1918 "Run PROGRAM on all elements on TIN-LIST.
|
|
|
1919 Args: TIN-LIST PROGRAM CONSTANT-ARGS.
|
|
|
1920
|
|
|
1921 The PROGRAM will be called with pwd set to the directory the files reside
|
|
|
1922 in. CONSTANT-ARGS should be a list of strings. The arguments given to the
|
|
|
1923 program will be CONSTANT-ARGS followed by all the files (from TIN-LIST) that
|
|
|
1924 resides in that directory. If the files in TIN-LIST resides in different
|
|
|
1925 directories the PROGRAM will be run once for each directory (if all files in
|
|
|
1926 the same directory appears after each other).
|
|
|
1927
|
|
|
1928 Any output from PROGRAM will be inserted in the current buffer.
|
|
|
1929
|
|
|
1930 This function return nil if all went well, or the numerical exit status or a
|
|
|
1931 signal name as a string. Note that PROGRAM might be called several times. This
|
|
|
1932 will return non-nil if something goes wrong, but there is no way to know which
|
|
|
1933 process that failed.
|
|
|
1934
|
|
|
1935 If MESSAGE-FMT is not nil, then message is called to display progress with
|
|
|
1936 MESSAGE-FMT as the string. MESSAGE-FMT should contain one %s for the arg-list
|
|
|
1937 being passed to PROGRAM."
|
|
|
1938
|
|
|
1939 ;; FIXME: something seems wrong with the error checking here....
|
|
|
1940
|
|
|
1941 (let ((exitstatus nil))
|
|
|
1942 (while tin-list
|
|
|
1943 (let ((current-dir (cvs-fileinfo->dir (tin-cookie cvs-cookie-handle
|
|
|
1944 (car tin-list))))
|
|
|
1945 arg-list
|
|
|
1946 arg-str)
|
|
|
1947
|
|
|
1948 ;; Collect all marked files in this directory.
|
|
|
1949
|
|
|
1950 (while (and tin-list
|
|
|
1951 (string= current-dir
|
|
|
1952 (cvs-fileinfo->dir (tin-cookie cvs-cookie-handle
|
|
|
1953 (car tin-list)))))
|
|
|
1954 (setq arg-list
|
|
|
1955 (cons (cvs-fileinfo->file-name
|
|
|
1956 (tin-cookie cvs-cookie-handle (car tin-list)))
|
|
|
1957 arg-list))
|
|
|
1958 (setq tin-list (cdr tin-list)))
|
|
|
1959
|
|
|
1960 (setq arg-list (nreverse arg-list))
|
|
|
1961
|
|
|
1962 ;; Execute the command on all the files that were collected.
|
|
|
1963
|
|
|
1964 (if message-fmt
|
|
|
1965 (message message-fmt
|
|
|
1966 (mapconcat 'cvs-quote-multiword-string
|
|
|
1967 arg-list
|
|
|
1968 " ")))
|
|
|
1969 (setq default-directory (file-name-as-directory current-dir))
|
|
|
1970 (insert (format "=== cd %s\n" default-directory))
|
|
|
1971 (insert (format "=== %s %s\n\n"
|
|
|
1972 program
|
|
|
1973 (mapconcat 'cvs-quote-multiword-string
|
|
|
1974 (nconc (copy-sequence constant-args)
|
|
|
1975 arg-list)
|
|
|
1976 " ")))
|
|
|
1977 (let ((res (apply 'call-process program nil t t
|
|
|
1978 (nconc (copy-sequence constant-args) arg-list))))
|
|
|
1979 ;; Remember the first, or highest, exitstatus.
|
|
|
1980 (if (and (not (and (integerp res) (zerop res)))
|
|
|
1981 (or (null exitstatus)
|
|
|
1982 (and (integerp exitstatus) (= 1 exitstatus))))
|
|
|
1983 (setq exitstatus res)))
|
|
|
1984 (goto-char (point-max))
|
|
|
1985 (if message-fmt
|
|
|
1986 (message message-fmt
|
|
|
1987 (mapconcat 'cvs-quote-multiword-string
|
|
|
1988 (nconc (copy-sequence arg-list) '("Done."))
|
|
|
1989 " ")))
|
|
|
1990 exitstatus))))
|
|
|
1991
|
|
|
1992 ;;----------
|
|
|
1993 ;;;; +++ not currently used!
|
|
|
1994 (defun cvs-execute-single-file-list (tin-list extractor program constant-args
|
|
|
1995 &optional cleanup message-fmt)
|
|
|
1996 "Run PROGRAM on all elements on TIN-LIST.
|
|
|
1997 Args: TIN-LIST EXTRACTOR PROGRAM CONSTANT-ARGS &optional CLEANUP.
|
|
|
1998
|
|
|
1999 The PROGRAM will be called with pwd set to the directory the files
|
|
|
2000 reside in. CONSTANT-ARGS is a list of strings to pass as arguments to
|
|
|
2001 PROGRAM. The arguments given to the program will be CONSTANT-ARGS
|
|
|
2002 followed by the list that EXTRACTOR returns.
|
|
|
2003
|
|
|
2004 EXTRACTOR will be called once for each file on TIN-LIST. It is given
|
|
|
2005 one argument, the cvs-fileinfo. It can return t, which means ignore
|
|
|
2006 this file, or a list of arguments to send to the program.
|
|
|
2007
|
|
|
2008 If CLEANUP is not nil, the filenames returned by EXTRACTOR are deleted.
|
|
|
2009
|
|
|
2010 If MESSAGE-FMT is not nil, then message is called to display progress with
|
|
|
2011 MESSAGE-FMT as the string. MESSAGE-FMT should contain one %s for the arg-list
|
|
|
2012 being passed to PROGRAM."
|
|
|
2013
|
|
|
2014 (while tin-list
|
|
|
2015 (let ((current-dir (file-name-as-directory
|
|
|
2016 (cvs-fileinfo->dir
|
|
|
2017 (tin-cookie cvs-cookie-handle
|
|
|
2018 (car tin-list)))))
|
|
|
2019 (arg-list
|
|
|
2020 (funcall extractor
|
|
|
2021 (tin-cookie cvs-cookie-handle (car tin-list)))))
|
|
|
2022
|
|
|
2023 ;; Execute the command unless extractor returned t.
|
|
|
2024
|
|
|
2025 (if (eq arg-list t)
|
|
|
2026 nil
|
|
|
2027 (setq default-directory current-dir)
|
|
|
2028 (insert (format "=== cd %s\n" default-directory))
|
|
|
2029 (insert (format "=== %s %s\n\n"
|
|
|
2030 program
|
|
|
2031 (mapconcat 'cvs-quote-multiword-string
|
|
|
2032 (nconc (copy-sequence constant-args)
|
|
|
2033 arg-list)
|
|
|
2034 " ")))
|
|
|
2035 (if message-fmt
|
|
|
2036 (message message-fmt (mapconcat 'cvs-quote-multiword-string
|
|
|
2037 arg-list
|
|
|
2038 " ")))
|
|
|
2039 (apply 'call-process program nil t t
|
|
|
2040 (nconc (copy-sequence constant-args) arg-list))
|
|
|
2041 (goto-char (point-max))
|
|
|
2042 (if message-fmt
|
|
|
2043 (message message-fmt (mapconcat 'cvs-quote-multiword-string
|
|
|
2044 (nconc arg-list '("Done."))
|
|
|
2045 " ")))
|
|
|
2046 (if cleanup
|
|
|
2047 (while arg-list
|
|
|
2048 ;;;; (kill-buffer ?????)
|
|
|
2049 (delete-file (car arg-list))
|
|
|
2050 (setq arg-list (cdr arg-list))))))
|
|
|
2051 (setq tin-list (cdr tin-list))))
|
|
|
2052
|
|
|
2053 ;;----------
|
|
|
2054 (defun cvs-edit-mode ()
|
|
|
2055 "\\<cvs-edit-mode-map>Mode for editing cvs log messages.
|
|
|
2056 Commands:
|
|
|
2057 \\[cvs-edit-done] checks in the file when you are ready.
|
|
|
2058 This mode is based on fundamental mode."
|
|
|
2059
|
|
|
2060 (interactive)
|
|
|
2061 (use-local-map cvs-edit-mode-map)
|
|
|
2062 (setq major-mode 'cvs-edit-mode)
|
|
|
2063 (setq mode-name "CVS Log")
|
|
|
2064 (auto-fill-mode 1))
|
|
|
2065
|
|
|
2066 ;;----------
|
|
|
2067 (if cvs-edit-mode-map
|
|
|
2068 nil
|
|
|
2069 (setq cvs-edit-mode-map (make-sparse-keymap))
|
|
|
2070 (define-prefix-command 'cvs-edit-mode-control-c-prefix)
|
|
|
2071 (define-key cvs-edit-mode-map "\C-c" 'cvs-edit-mode-control-c-prefix)
|
|
|
2072 (define-key cvs-edit-mode-map "\C-c\C-c" 'cvs-edit-done))
|
|
|
2073
|
|
|
2074 ;;----------
|
|
|
2075 (defun cvs-diffable (tins)
|
|
|
2076 "Return a list of all tins on TINS that it makes sense to run
|
|
|
2077 ``cvs diff'' on."
|
|
|
2078
|
|
|
2079 ;; +++ There is an unnecessary (nreverse) here. Get the list the
|
|
|
2080 ;; other way around instead!
|
|
|
2081 (let ((result nil))
|
|
|
2082 (while tins
|
|
|
2083 (let ((type (cvs-fileinfo->type
|
|
|
2084 (tin-cookie cvs-cookie-handle (car tins)))))
|
|
|
2085 (if (or (eq type 'MODIFIED)
|
|
|
2086 (eq type 'UPDATED)
|
|
|
2087 (eq type 'PATCHED)
|
|
|
2088 (eq type 'MERGED)
|
|
|
2089 (eq type 'CONFLICT)
|
|
|
2090 (eq type 'REMOVED) ;+++Does this line make sense?
|
|
|
2091 (eq type 'ADDED)) ;+++Does this line make sense?
|
|
|
2092 (setq result (cons (car tins) result)))
|
|
|
2093 (setq tins (cdr tins))))
|
|
|
2094 (nreverse result)))
|
|
|
2095
|
|
|
2096 ;;----------
|
|
|
2097 (defun cvs-mode-diff-cvs (&optional ignore-marks)
|
|
|
2098 "Diff the selected files against the head revisions in the repository.
|
|
|
2099
|
|
|
2100 If the variable cvs-diff-ignore-marks is non-nil any marked files will not be
|
|
|
2101 considered to be selected. An optional prefix argument will invert the
|
|
|
2102 influence from cvs-diff-ignore-marks.
|
|
|
2103
|
|
|
2104 The flags in the variable cvs-diff-flags will be passed to ``cvs diff''.
|
|
|
2105
|
|
|
2106 The resulting diffs are placed in the cvs-fileinfo->cvs-diff-buffer."
|
|
|
2107
|
|
|
2108 (interactive "P")
|
|
|
2109 (if (not (listp cvs-diff-flags))
|
|
|
2110 (error "cvs-diff-flags should be set using cvs-set-diff-flags."))
|
|
|
2111 (save-some-buffers)
|
|
|
2112 (message "cvsdiffing...")
|
|
|
2113 (let ((marked-file-list (cvs-diffable
|
|
|
2114 (cvs-get-marked
|
|
|
2115 (or (and ignore-marks (not cvs-diff-ignore-marks))
|
|
|
2116 (and (not ignore-marks) cvs-diff-ignore-marks))))))
|
|
|
2117 (while marked-file-list
|
|
|
2118 (let ((fileinfo-to-diff (tin-cookie cvs-cookie-handle
|
|
|
2119 (car marked-file-list)))
|
|
|
2120 (local-def-directory (file-name-as-directory
|
|
|
2121 (cvs-fileinfo->dir
|
|
|
2122 (tin-cookie cvs-cookie-handle
|
|
|
2123 (car marked-file-list))))))
|
|
|
2124 (message "cvsdiffing %s..."
|
|
|
2125 (cvs-fileinfo->file-name fileinfo-to-diff))
|
|
|
2126
|
|
|
2127 ;; FIXME: this seems messy to test and set buffer name at this point....
|
|
|
2128 (if (not (cvs-fileinfo->cvs-diff-buffer fileinfo-to-diff))
|
|
|
2129 (cvs-set-fileinfo->cvs-diff-buffer fileinfo-to-diff
|
|
|
2130 (concat "*cvs-diff-"
|
|
|
2131 (cvs-fileinfo->file-name
|
|
|
2132 fileinfo-to-diff)
|
|
|
2133 "-in-"
|
|
|
2134 local-def-directory
|
|
|
2135 "*")))
|
|
|
2136 (display-buffer (get-buffer-create
|
|
|
2137 (cvs-fileinfo->cvs-diff-buffer fileinfo-to-diff)))
|
|
|
2138 (set-buffer (cvs-fileinfo->cvs-diff-buffer fileinfo-to-diff))
|
|
|
2139 (setq buffer-read-only nil)
|
|
|
2140 (setq default-directory local-def-directory)
|
|
|
2141 (erase-buffer)
|
|
|
2142 (insert (format "=== cd %s\n" default-directory))
|
|
|
2143 (insert (format "=== cvs %s\n\n"
|
|
|
2144 (mapconcat 'cvs-quote-multiword-string
|
|
|
2145 (nconc (if cvs-cvsroot
|
|
|
2146 (list "-d" cvs-cvsroot "diff")
|
|
|
2147 '("diff"))
|
|
|
2148 (copy-sequence cvs-diff-flags)
|
|
|
2149 (list (cvs-fileinfo->file-name
|
|
|
2150 fileinfo-to-diff)))
|
|
|
2151 " ")))
|
|
|
2152 (if (apply 'call-process cvs-program nil t t
|
|
|
2153 (nconc (if cvs-cvsroot
|
|
|
2154 (list "-d" cvs-cvsroot "diff")
|
|
|
2155 '("diff"))
|
|
|
2156 (copy-sequence cvs-diff-flags)
|
|
|
2157 (list (cvs-fileinfo->file-name fileinfo-to-diff))))
|
|
|
2158 (message "cvsdiffing %s... Done."
|
|
|
2159 (cvs-fileinfo->file-name fileinfo-to-diff))
|
|
|
2160 (message "cvsdiffing %s... No differences found."
|
|
|
2161 (cvs-fileinfo->file-name fileinfo-to-diff)))
|
|
|
2162 (goto-char (point-max))
|
|
|
2163 (setq marked-file-list (cdr marked-file-list)))))
|
|
|
2164 (message "cvsdiffing... Done."))
|
|
|
2165
|
|
|
2166 ;;----------
|
|
|
2167 (defun cvs-mode-diff-backup (&optional ignore-marks)
|
|
|
2168 "Diff the files against the backup file.
|
|
|
2169 This command can be used on files that are marked with \"Merged\"
|
|
|
2170 or \"Conflict\" in the *cvs* buffer.
|
|
|
2171
|
|
|
2172 If the variable cvs-diff-ignore-marks is non-nil any marked files will
|
|
|
2173 not be considered to be selected. An optional prefix argument will
|
|
|
2174 invert the influence from cvs-diff-ignore-marks.
|
|
|
2175
|
|
|
2176 The flags in cvs-diff-flags will be passed to ``diff''.
|
|
|
2177
|
|
|
2178 The resulting diffs are placed in the cvs-fileinfo->backup-diff-buffer."
|
|
|
2179
|
|
|
2180 (interactive "P")
|
|
|
2181 (if (not (listp cvs-diff-flags))
|
|
|
2182 (error "cvs-diff-flags should be set using cvs-set-diff-flags."))
|
|
|
2183 (save-some-buffers)
|
|
|
2184 (let ((marked-file-list (cvs-filter
|
|
|
2185 (function cvs-backup-diffable)
|
|
|
2186 (cvs-get-marked
|
|
|
2187 (or
|
|
|
2188 (and ignore-marks (not cvs-diff-ignore-marks))
|
|
|
2189 (and (not ignore-marks) cvs-diff-ignore-marks))))))
|
|
|
2190 (if (null marked-file-list)
|
|
|
2191 (error "No ``Conflict'' or ``Merged'' file selected!"))
|
|
|
2192 (message "backup diff...")
|
|
|
2193 (while marked-file-list
|
|
|
2194 (let ((fileinfo-to-diff (tin-cookie cvs-cookie-handle
|
|
|
2195 (car marked-file-list)))
|
|
|
2196 (local-def-directory (file-name-as-directory
|
|
|
2197 (cvs-fileinfo->dir
|
|
|
2198 (tin-cookie cvs-cookie-handle
|
|
|
2199 (car marked-file-list)))))
|
|
|
2200 (backup-temp-files (cvs-diff-backup-extractor
|
|
|
2201 (tin-cookie cvs-cookie-handle
|
|
|
2202 (car marked-file-list)))))
|
|
|
2203 (message "backup diff %s..."
|
|
|
2204 (cvs-fileinfo->file-name fileinfo-to-diff))
|
|
|
2205
|
|
|
2206 ;; FIXME: this seems messy to test and set buffer name at this point....
|
|
|
2207 (if (not (cvs-fileinfo->backup-diff-buffer fileinfo-to-diff))
|
|
|
2208 (cvs-set-fileinfo->backup-diff-buffer fileinfo-to-diff
|
|
|
2209 (concat "*cvs-diff-"
|
|
|
2210 (cvs-fileinfo->backup-file
|
|
|
2211 fileinfo-to-diff)
|
|
|
2212 "-to-"
|
|
|
2213 (cvs-fileinfo->file-name
|
|
|
2214 fileinfo-to-diff)
|
|
|
2215 "-in"
|
|
|
2216 local-def-directory
|
|
|
2217 "*")))
|
|
|
2218 (display-buffer (get-buffer-create
|
|
|
2219 (cvs-fileinfo->backup-diff-buffer fileinfo-to-diff)))
|
|
|
2220 (set-buffer (cvs-fileinfo->backup-diff-buffer fileinfo-to-diff))
|
|
|
2221 (setq buffer-read-only nil)
|
|
|
2222 (setq default-directory local-def-directory)
|
|
|
2223 (erase-buffer)
|
|
|
2224 (insert (format "=== cd %s\n" default-directory))
|
|
|
2225 (insert (format "=== %s %s\n\n"
|
|
|
2226 cvs-diff-program
|
|
|
2227 (mapconcat 'cvs-quote-multiword-string
|
|
|
2228 (nconc (copy-sequence cvs-diff-flags)
|
|
|
2229 backup-temp-files)
|
|
|
2230 " ")))
|
|
|
2231 (apply 'call-process cvs-diff-program nil t t
|
|
|
2232 (nconc (copy-sequence cvs-diff-flags) backup-temp-files))
|
|
|
2233 (goto-char (point-max))
|
|
|
2234 (message "backup diff %s... Done."
|
|
|
2235 (cvs-fileinfo->file-name fileinfo-to-diff))
|
|
|
2236 (setq marked-file-list (cdr marked-file-list)))))
|
|
|
2237 (message "backup diff... Done."))
|
|
|
2238
|
|
|
2239 ;;----------
|
|
|
2240 (defun cvs-mode-diff-vendor (&optional ignore-marks)
|
|
|
2241 "Diff the revisions merged into the current file. I.e. show what changes
|
|
|
2242 were merged in.
|
|
|
2243
|
|
|
2244 This command can be used on files that are marked with \"Merged\"
|
|
|
2245 or \"Conflict\" in the *cvs* buffer.
|
|
|
2246
|
|
|
2247 If the variable cvs-diff-ignore-marks is non-nil any marked files will
|
|
|
2248 not be considered to be selected. An optional prefix argument will
|
|
|
2249 invert the influence from cvs-diff-ignore-marks.
|
|
|
2250
|
|
|
2251 The flags in cvs-diff-flags will be passed to ``diff''.
|
|
|
2252
|
|
|
2253 The resulting diffs are placed in the cvs-fileinfo->vendor-diff-buffer."
|
|
|
2254
|
|
|
2255 (interactive "P")
|
|
|
2256 (if (not (listp cvs-diff-flags))
|
|
|
2257 (error "cvs-diff-flags should be set using cvs-set-diff-flags."))
|
|
|
2258 (save-some-buffers)
|
|
|
2259 (let ((marked-file-list (cvs-filter
|
|
|
2260 (function cvs-vendor-diffable)
|
|
|
2261 (cvs-get-marked
|
|
|
2262 (or
|
|
|
2263 (and ignore-marks (not cvs-diff-ignore-marks))
|
|
|
2264 (and (not ignore-marks) cvs-diff-ignore-marks))))))
|
|
|
2265 (if (null marked-file-list)
|
|
|
2266 (error "No ``Conflict'' or ``Merged'' file selected!"))
|
|
|
2267 (message "vendor diff...")
|
|
|
2268 (while marked-file-list
|
|
|
2269 (let ((fileinfo-to-diff (tin-cookie cvs-cookie-handle
|
|
|
2270 (car marked-file-list)))
|
|
|
2271 (local-def-directory (file-name-as-directory
|
|
|
2272 (cvs-fileinfo->dir
|
|
|
2273 (tin-cookie cvs-cookie-handle
|
|
|
2274 (car marked-file-list)))))
|
|
|
2275 (vendor-temp-files (cvs-diff-vendor-extractor
|
|
|
2276 (tin-cookie cvs-cookie-handle
|
|
|
2277 (car marked-file-list)))))
|
|
|
2278 (message "vendor diff %s..."
|
|
|
2279 (cvs-fileinfo->file-name fileinfo-to-diff))
|
|
|
2280 (if (not (cvs-fileinfo->vendor-diff-buffer fileinfo-to-diff))
|
|
|
2281 (cvs-set-fileinfo->vendor-diff-buffer fileinfo-to-diff
|
|
|
2282 (concat "*cvs-diff-"
|
|
|
2283 (cvs-fileinfo->file-name
|
|
|
2284 fileinfo-to-diff)
|
|
|
2285 "-of-"
|
|
|
2286 (cvs-fileinfo->base-revision
|
|
|
2287 fileinfo-to-diff)
|
|
|
2288 "-to-"
|
|
|
2289 (cvs-fileinfo->head-revision
|
|
|
2290 fileinfo-to-diff)
|
|
|
2291 "-in-"
|
|
|
2292 local-def-directory
|
|
|
2293 "*")))
|
|
|
2294 (display-buffer (get-buffer-create
|
|
|
2295 (cvs-fileinfo->vendor-diff-buffer fileinfo-to-diff)))
|
|
|
2296 (set-buffer (cvs-fileinfo->vendor-diff-buffer fileinfo-to-diff))
|
|
|
2297 (setq buffer-read-only nil)
|
|
|
2298 (setq default-directory local-def-directory)
|
|
|
2299 (erase-buffer)
|
|
|
2300 (insert (format "=== cd %s\n" default-directory))
|
|
|
2301 (insert (format "=== %s %s\n\n"
|
|
|
2302 cvs-diff-program
|
|
|
2303 (mapconcat 'cvs-quote-multiword-string
|
|
|
2304 (nconc (copy-sequence cvs-diff-flags)
|
|
|
2305 vendor-temp-files)
|
|
|
2306 " ")))
|
|
|
2307 (apply 'call-process cvs-diff-program nil t t
|
|
|
2308 (nconc (copy-sequence cvs-diff-flags) vendor-temp-files))
|
|
|
2309 (goto-char (point-max))
|
|
|
2310 (message "vendor diff %s... Done."
|
|
|
2311 (cvs-fileinfo->file-name fileinfo-to-diff))
|
|
|
2312 (while vendor-temp-files
|
|
|
2313 (cvs-kill-buffer-visiting (car vendor-temp-files))
|
|
|
2314 (delete-file (car vendor-temp-files))
|
|
|
2315 (setq vendor-temp-files (cdr vendor-temp-files)))
|
|
|
2316 (setq marked-file-list (cdr marked-file-list)))))
|
|
|
2317 (message "vendor diff... Done."))
|
|
|
2318
|
|
|
2319 ;;----------
|
|
|
2320 (defun cvs-backup-diffable (tin)
|
|
|
2321 "Check if the TIN is backup-diffable.
|
|
|
2322 It must have a backup file to be diffable."
|
|
|
2323
|
|
|
2324 (file-readable-p
|
|
|
2325 (cvs-fileinfo->backup-file (tin-cookie cvs-cookie-handle tin))))
|
|
|
2326
|
|
|
2327 ;;----------
|
|
|
2328 (defun cvs-vendor-diffable (tin)
|
|
|
2329 "Check if the TIN is vendor-diffable.
|
|
|
2330 It must have head and base revision info to be diffable."
|
|
|
2331
|
|
|
2332 (and
|
|
|
2333 (cvs-fileinfo->base-revision (tin-cookie cvs-cookie-handle tin))
|
|
|
2334 (cvs-fileinfo->head-revision (tin-cookie cvs-cookie-handle tin))))
|
|
|
2335
|
|
|
2336 ;;----------
|
|
|
2337 (defun cvs-diff-backup-extractor (fileinfo)
|
|
|
2338 "Return the filename and the name of the backup file as a list.
|
|
|
2339 Signal an error if there is no backup file."
|
|
|
2340
|
|
|
2341 (if (not (file-readable-p (cvs-fileinfo->backup-file fileinfo)))
|
|
|
2342 (error "%s has no backup file."
|
|
|
2343 (concat
|
|
|
2344 (file-name-as-directory (cvs-fileinfo->dir fileinfo))
|
|
|
2345 (cvs-fileinfo->file-name fileinfo))))
|
|
|
2346 (list (cvs-fileinfo->backup-file fileinfo)
|
|
|
2347 (cvs-fileinfo->file-name fileinfo)))
|
|
|
2348
|
|
|
2349 ;;----------
|
|
|
2350 (defun cvs-diff-vendor-extractor (fileinfo)
|
|
|
2351 "Retrieve and return the filenames of the vendor branch revisions as a list.
|
|
|
2352 Signal an error if there is no info for the vendor revisions."
|
|
|
2353
|
|
|
2354 (list (cvs-retrieve-revision-to-tmpfile fileinfo
|
|
|
2355 (cvs-fileinfo->base-revision
|
|
|
2356 fileinfo))
|
|
|
2357 (cvs-retrieve-revision-to-tmpfile fileinfo
|
|
|
2358 (cvs-fileinfo->head-revision
|
|
|
2359 fileinfo))))
|
|
|
2360
|
|
|
2361 ;;----------
|
|
|
2362 (defun cvs-mode-find-file-other-window (pos)
|
|
|
2363 "Select a buffer containing the file in another window.
|
|
|
2364 Args: POS."
|
|
|
2365
|
|
|
2366 (interactive "d")
|
|
|
2367 (let ((tin (tin-locate cvs-cookie-handle pos)))
|
|
|
2368 (if tin
|
|
|
2369 (let ((type (cvs-fileinfo->type (tin-cookie cvs-cookie-handle tin))))
|
|
|
2370 (cond
|
|
|
2371 ((or (eq type 'REMOVED)
|
|
|
2372 (eq type 'CVS-REMOVED))
|
|
|
2373 (error "Can't visit a removed file."))
|
|
|
2374 ((eq type 'DIRCHANGE)
|
|
|
2375 (let ((obuf (current-buffer))
|
|
|
2376 (odir default-directory))
|
|
|
2377 (setq default-directory
|
|
|
2378 (file-name-as-directory
|
|
|
2379 (cvs-fileinfo->dir
|
|
|
2380 (tin-cookie cvs-cookie-handle tin))))
|
|
|
2381 (dired-other-window default-directory)
|
|
|
2382 (set-buffer obuf)
|
|
|
2383 (setq default-directory odir)))
|
|
|
2384 (t
|
|
|
2385 (find-file-other-window (cvs-full-path tin)))))
|
|
|
2386 (error "There is no file to find."))))
|
|
|
2387
|
|
|
2388 ;;----------
|
|
|
2389 (defun cvs-fileinfo->full-path (fileinfo)
|
|
|
2390 "Return the full path for the file that is described in FILEINFO."
|
|
|
2391
|
|
|
2392 (concat
|
|
|
2393 (file-name-as-directory
|
|
|
2394 (cvs-fileinfo->dir fileinfo))
|
|
|
2395 (cvs-fileinfo->file-name fileinfo)))
|
|
|
2396
|
|
|
2397 ;;----------
|
|
|
2398 (defun cvs-full-path (tin)
|
|
|
2399 "Return the full path for the file that is described in TIN."
|
|
|
2400
|
|
|
2401 (cvs-fileinfo->full-path (tin-cookie cvs-cookie-handle tin)))
|
|
|
2402
|
|
|
2403 ;;----------
|
|
|
2404 (defun cvs-mode-find-file (pos)
|
|
|
2405 "Select a buffer containing the file in another window.
|
|
|
2406 Args: POS."
|
|
|
2407
|
|
|
2408 (interactive "d")
|
|
|
2409 (let* ((cvs-buf (current-buffer))
|
|
|
2410 (tin (tin-locate cvs-cookie-handle pos)))
|
|
|
2411 (if tin
|
|
|
2412 (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
|
|
|
2413 (type (cvs-fileinfo->type fileinfo)))
|
|
|
2414 (cond
|
|
|
2415 ((or (eq type 'REMOVED)
|
|
|
2416 (eq type 'CVS-REMOVED))
|
|
|
2417 (error "Can't visit a removed file."))
|
|
|
2418 ((eq type 'DIRCHANGE)
|
|
|
2419 (let ((odir default-directory))
|
|
|
2420 (setq default-directory
|
|
|
2421 (file-name-as-directory (cvs-fileinfo->dir fileinfo)))
|
|
|
2422 (dired default-directory)
|
|
|
2423 (set-buffer cvs-buf)
|
|
|
2424 (setq default-directory odir)))
|
|
|
2425 (t
|
|
|
2426 (find-file (cvs-full-path tin)))))
|
|
|
2427 (error "There is no file to find."))))
|
|
|
2428
|
|
|
2429 ;;----------
|
|
|
2430 (defun cvs-mode-mark-all-files ()
|
|
|
2431 "Mark all files.
|
|
|
2432 Directories are not marked."
|
|
|
2433
|
|
|
2434 (interactive)
|
|
|
2435 (cookie-map (function (lambda (cookie)
|
|
|
2436 (cond
|
|
|
2437 ((not (eq (cvs-fileinfo->type cookie) 'DIRCHANGE))
|
|
|
2438 (cvs-set-fileinfo->marked cookie t)
|
|
|
2439 t))))
|
|
|
2440 cvs-cookie-handle))
|
|
|
2441
|
|
|
2442 ;;----------
|
|
|
2443 (defun cvs-mode-unmark (pos)
|
|
|
2444 "Unmark a fileinfo.
|
|
|
2445 Args: POS."
|
|
|
2446
|
|
|
2447 (interactive "d")
|
|
|
2448 (let* ((tin (tin-locate cvs-cookie-handle pos))
|
|
|
2449 (sel (tin-cookie cvs-cookie-handle tin)))
|
|
|
2450 (cond
|
|
|
2451 ((eq (cvs-fileinfo->type sel) 'DIRCHANGE)
|
|
|
2452 (cookie-map
|
|
|
2453 (function (lambda (f dir)
|
|
|
2454 (cond
|
|
|
2455 ((cvs-dir-member-p f dir)
|
|
|
2456 (cvs-set-fileinfo->marked f nil)
|
|
|
2457 t))))
|
|
|
2458 cvs-cookie-handle
|
|
|
2459 (cvs-fileinfo->dir sel)))
|
|
|
2460 (t
|
|
|
2461 (cvs-set-fileinfo->marked sel nil)
|
|
|
2462 (tin-invalidate cvs-cookie-handle tin)
|
|
|
2463 (tin-goto-next cvs-cookie-handle pos 1)))))
|
|
|
2464
|
|
|
2465 ;;----------
|
|
|
2466 (defun cvs-mode-unmark-all-files ()
|
|
|
2467 "Unmark all files.
|
|
|
2468 Directories are also unmarked, but that doesn't matter, since
|
|
|
2469 they should always be unmarked."
|
|
|
2470
|
|
|
2471 (interactive)
|
|
|
2472 (cookie-map (function (lambda (cookie)
|
|
|
2473 (cvs-set-fileinfo->marked cookie nil)
|
|
|
2474 t))
|
|
|
2475 cvs-cookie-handle))
|
|
|
2476
|
|
|
2477 ;;----------
|
|
|
2478 (defun cvs-do-removal (tins)
|
|
|
2479 "Remove files.
|
|
|
2480 Args: TINS.
|
|
|
2481
|
|
|
2482 TINS is a list of tins that the user wants to delete. The files are deleted.
|
|
|
2483 If the type of the tin is 'UNKNOWN or 'UNKNOWN-DIR the tin is removed from the
|
|
|
2484 buffer. If it is anything else the file is added to a list that should be `cvs
|
|
|
2485 remove'd and the tin is changed to be of type 'REMOVED.
|
|
|
2486
|
|
|
2487 Returns a list of tins files that should be `cvs remove'd."
|
|
|
2488
|
|
|
2489 (cvs-use-temp-buffer)
|
|
|
2490 (mapcar 'cvs-insert-full-path tins)
|
|
|
2491 (cond
|
|
|
2492 ((and tins (yes-or-no-p (format "Delete %d files? " (length tins))))
|
|
|
2493 (let (files-to-remove)
|
|
|
2494 (while tins
|
|
|
2495 (let* ((tin (car tins))
|
|
|
2496 (fileinfo (tin-cookie cvs-cookie-handle tin))
|
|
|
2497 (filepath (cvs-full-path tin))
|
|
|
2498 (type (cvs-fileinfo->type fileinfo)))
|
|
|
2499 (if (or (eq type 'REMOVED)
|
|
|
2500 (eq type 'CVS-REMOVED))
|
|
|
2501 nil
|
|
|
2502 ;; if it doesn't exist, as a file or directory, ignore it
|
|
|
2503 (cond ((file-directory-p filepath)
|
|
|
2504 (call-process cvs-rmdir-program nil nil nil filepath))
|
|
|
2505 ((file-exists-p filepath)
|
|
|
2506 (delete-file filepath)))
|
|
|
2507 (if (or (eq type 'UNKNOWN)
|
|
|
2508 (eq type 'UNKNOWN-DIR)
|
|
|
2509 (eq type 'MOVE-AWAY))
|
|
|
2510 (tin-delete cvs-cookie-handle tin)
|
|
|
2511 (setq files-to-remove (cons tin files-to-remove))
|
|
|
2512 (cvs-set-fileinfo->type fileinfo 'REMOVED)
|
|
|
2513 (cvs-set-fileinfo->handled fileinfo nil)
|
|
|
2514 (tin-invalidate cvs-cookie-handle tin))))
|
|
|
2515 (setq tins (cdr tins)))
|
|
|
2516 files-to-remove))
|
|
|
2517 (t nil)))
|
|
|
2518
|
|
|
2519 ;;----------
|
|
|
2520 (defun cvs-mode-remove-file ()
|
|
|
2521 "Remove all marked files."
|
|
|
2522
|
|
|
2523 (interactive)
|
|
|
2524 (let ((files-to-remove (cvs-do-removal (cvs-get-marked))))
|
|
|
2525 (if (null files-to-remove)
|
|
|
2526 nil
|
|
|
2527 (cvs-use-temp-buffer)
|
|
|
2528 (message "removing from repository...")
|
|
|
2529 (if (cvs-execute-list files-to-remove cvs-program
|
|
|
2530 (if cvs-cvsroot
|
|
|
2531 (list "-d" cvs-cvsroot "remove")
|
|
|
2532 '("remove"))
|
|
|
2533 "removing %s from repository...")
|
|
|
2534 (error "CVS exited with non-zero exit status.")
|
|
|
2535 (message "removing from repository... Done.")))))
|
|
|
2536
|
|
|
2537 ;;----------
|
|
|
2538 (defun cvs-mode-undo-local-changes ()
|
|
|
2539 "Undo local changes to all marked files.
|
|
|
2540 The file is removed and `cvs update FILE' is run."
|
|
|
2541
|
|
|
2542 (interactive)
|
|
|
2543 (let ((tins-to-undo (cvs-get-marked)))
|
|
|
2544 (cvs-use-temp-buffer)
|
|
|
2545 (mapcar 'cvs-insert-full-path tins-to-undo)
|
|
|
2546 (cond
|
|
|
2547 ((and tins-to-undo (yes-or-no-p (format "Undo changes to %d files? "
|
|
|
2548 (length tins-to-undo))))
|
|
|
2549 (let (files-to-update)
|
|
|
2550 (while tins-to-undo
|
|
|
2551 (let* ((tin (car tins-to-undo))
|
|
|
2552 (fileinfo (tin-cookie cvs-cookie-handle tin))
|
|
|
2553 (type (cvs-fileinfo->type fileinfo)))
|
|
|
2554 (cond
|
|
|
2555 ((or
|
|
|
2556 (eq type 'UPDATED)
|
|
|
2557 (eq type 'PATCHED)
|
|
|
2558 (eq type 'MODIFIED)
|
|
|
2559 (eq type 'MERGED)
|
|
|
2560 (eq type 'CONFLICT)
|
|
|
2561 (eq type 'CVS-REMOVED)
|
|
|
2562 (eq type 'REM-CONFLICT)
|
|
|
2563 (eq type 'MOVE-AWAY)
|
|
|
2564 (eq type 'REMOVED))
|
|
|
2565 (if (not (eq type 'REMOVED))
|
|
|
2566 (delete-file (cvs-full-path tin)))
|
|
|
2567 (setq files-to-update (cons tin files-to-update))
|
|
|
2568 (cvs-set-fileinfo->type fileinfo 'UPDATED)
|
|
|
2569 (cvs-set-fileinfo->handled fileinfo t)
|
|
|
2570 (tin-invalidate cvs-cookie-handle tin))
|
|
|
2571
|
|
|
2572 ((eq type 'MOD-CONFLICT)
|
|
|
2573 (error "Use cvs-mode-add instead on %s."
|
|
|
2574 (cvs-fileinfo->file-name fileinfo)))
|
|
|
2575
|
|
|
2576 ((eq type 'REM-CONFLICT)
|
|
|
2577 (error "Can't deal with a file you have removed and recreated."))
|
|
|
2578
|
|
|
2579 ((eq type 'DIRCHANGE)
|
|
|
2580 (error "Undo on directories not supported (yet)."))
|
|
|
2581
|
|
|
2582 ((eq type 'ADDED)
|
|
|
2583 (error "There is no old revision to get for %s"
|
|
|
2584 (cvs-fileinfo->file-name fileinfo)))
|
|
|
2585 (t (error "cvs-mode-undo-local-changes: can't handle an %s"
|
|
|
2586 type)))
|
|
|
2587
|
|
|
2588 (setq tins-to-undo (cdr tins-to-undo))))
|
|
|
2589 (cvs-use-temp-buffer)
|
|
|
2590 (message "Re-getting files from repository...")
|
|
|
2591 (if (cvs-execute-list files-to-update cvs-program
|
|
|
2592 (if cvs-cvsroot
|
|
|
2593 (list "-d" cvs-cvsroot "update")
|
|
|
2594 '("update"))
|
|
|
2595 "Re-getting %s from repository...")
|
|
|
2596 (error "CVS exited with non-zero exit status.")
|
|
|
2597 (message "Re-getting files from repository... Done.")))))))
|
|
|
2598
|
|
|
2599 ;;----------
|
|
|
2600 (defun cvs-mode-acknowledge ()
|
|
|
2601 "Remove all marked files from the buffer."
|
|
|
2602
|
|
|
2603 (interactive)
|
|
|
2604 (mapcar (function (lambda (tin)
|
|
|
2605 (tin-delete cvs-cookie-handle tin)))
|
|
|
2606 (cvs-get-marked)))
|
|
|
2607
|
|
|
2608 ;;----------
|
|
|
2609 (defun cvs-mode-unmark-up (pos)
|
|
|
2610 "Unmark the file on the previous line.
|
|
|
2611 Takes one argument POS, a buffer position."
|
|
|
2612
|
|
|
2613 (interactive "d")
|
|
|
2614 (let ((tin (tin-goto-previous cvs-cookie-handle pos 1)))
|
|
|
2615 (cond
|
|
|
2616 (tin
|
|
|
2617 (cvs-set-fileinfo->marked (tin-cookie cvs-cookie-handle tin)
|
|
|
2618 nil)
|
|
|
2619 (tin-invalidate cvs-cookie-handle tin)))))
|
|
|
2620
|
|
|
2621 ;;----------
|
|
|
2622 (defun cvs-mode-previous-line (arg)
|
|
|
2623 "Go to the previous line.
|
|
|
2624 If a prefix argument is given, move by that many lines."
|
|
|
2625
|
|
|
2626 (interactive "p")
|
|
|
2627 (tin-goto-previous cvs-cookie-handle (point) arg))
|
|
|
2628
|
|
|
2629 ;;----------
|
|
|
2630 (defun cvs-mode-next-line (arg)
|
|
|
2631 "Go to the next line.
|
|
|
2632 If a prefix argument is given, move by that many lines."
|
|
|
2633
|
|
|
2634 (interactive "p")
|
|
|
2635 (tin-goto-next cvs-cookie-handle (point) arg))
|
|
|
2636
|
|
|
2637 ;;----------
|
|
|
2638 (defun cvs-add-file-update-buffer (tin)
|
|
|
2639 "Sub-function to cvs-mode-add. Internal use only. Update the display. Return
|
|
|
2640 non-nil if `cvs add' should be called on this file.
|
|
|
2641 Args: TIN.
|
|
|
2642
|
|
|
2643 Returns 'DIR, 'ADD, 'ADD-DIR, or 'RESURRECT."
|
|
|
2644
|
|
|
2645 (let ((fileinfo (tin-cookie cvs-cookie-handle tin)))
|
|
|
2646 (cond
|
|
|
2647 ((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN-DIR)
|
|
|
2648 (cvs-set-fileinfo->full-log fileinfo "new directory added with cvs-mode-add")
|
|
|
2649 'ADD-DIR)
|
|
|
2650 ((eq (cvs-fileinfo->type fileinfo) 'UNKNOWN)
|
|
|
2651 (cvs-set-fileinfo->type fileinfo 'ADDED)
|
|
|
2652 (cvs-set-fileinfo->full-log fileinfo "new file added with cvs-mode-add")
|
|
|
2653 (tin-invalidate cvs-cookie-handle tin)
|
|
|
2654 'ADD)
|
|
|
2655 ((eq (cvs-fileinfo->type fileinfo) 'REMOVED)
|
|
|
2656 (cvs-set-fileinfo->type fileinfo 'UPDATED)
|
|
|
2657 (cvs-set-fileinfo->full-log fileinfo "file resurrected with cvs-mode-add")
|
|
|
2658 (cvs-set-fileinfo->handled fileinfo t)
|
|
|
2659 (tin-invalidate cvs-cookie-handle tin)
|
|
|
2660 'RESURRECT))))
|
|
|
2661
|
|
|
2662 ;;----------
|
|
|
2663 (defun cvs-add-sub (cvs-buf candidates)
|
|
|
2664 "Internal use only.
|
|
|
2665 Args: CVS-BUF CANDIDATES.
|
|
|
2666
|
|
|
2667 CANDIDATES is a list of tins. Updates the CVS-BUF and returns a list of lists.
|
|
|
2668 The first list is unknown tins that shall be `cvs add -m msg'ed.
|
|
|
2669 The second list is unknown directory tins that shall be `cvs add -m msg'ed.
|
|
|
2670 The third list is removed files that shall be `cvs add'ed (resurrected)."
|
|
|
2671
|
|
|
2672 (let (add add-dir resurrect)
|
|
|
2673 (while candidates
|
|
|
2674 (let ((type (cvs-add-file-update-buffer (car candidates))))
|
|
|
2675 (cond ((eq type 'ADD)
|
|
|
2676 (setq add (cons (car candidates) add)))
|
|
|
2677 ((eq type 'ADD-DIR)
|
|
|
2678 (setq add-dir (cons (car candidates) add-dir)))
|
|
|
2679 ((eq type 'RESURRECT)
|
|
|
2680 (setq resurrect (cons (car candidates) resurrect)))))
|
|
|
2681 (setq candidates (cdr candidates)))
|
|
|
2682 (list add add-dir resurrect)))
|
|
|
2683
|
|
|
2684 ;;----------
|
|
|
2685 (defun cvs-mode-add ()
|
|
|
2686 "Add marked files to the cvs repository."
|
|
|
2687
|
|
|
2688 (interactive)
|
|
|
2689 (let* ((buf (current-buffer))
|
|
|
2690 (marked (cvs-get-marked))
|
|
|
2691 (result (cvs-add-sub buf marked))
|
|
|
2692 (added (car result))
|
|
|
2693 (newdirs (car (cdr result)))
|
|
|
2694 (resurrect (car (cdr (cdr result))))
|
|
|
2695 (msg (if (or added newdirs)
|
|
|
2696 (read-from-minibuffer "Enter description: "))))
|
|
|
2697
|
|
|
2698 (if (or resurrect (or added newdirs))
|
|
|
2699 (cvs-use-temp-buffer))
|
|
|
2700
|
|
|
2701 (cond (resurrect
|
|
|
2702 (message "Resurrecting files from repository...")
|
|
|
2703 (if (cvs-execute-list resurrect
|
|
|
2704 cvs-program
|
|
|
2705 (if cvs-cvsroot
|
|
|
2706 (list "-d" cvs-cvsroot "add")
|
|
|
2707 '("add"))
|
|
|
2708 "Resurrecting %s from repository...")
|
|
|
2709 (error "CVS exited with non-zero exit status.")
|
|
|
2710 (message "Resurrecting files from repository... Done."))))
|
|
|
2711
|
|
|
2712 (cond (added
|
|
|
2713 (message "Adding new files to repository...")
|
|
|
2714 (if (cvs-execute-list added
|
|
|
2715 cvs-program
|
|
|
2716 (if cvs-cvsroot
|
|
|
2717 (list "-d" cvs-cvsroot "add" "-m" msg)
|
|
|
2718 (list "add" "-m" msg))
|
|
|
2719 "Adding %s to repository...")
|
|
|
2720 (error "CVS exited with non-zero exit status.")
|
|
|
2721 (message "Adding new files to repository... Done."))))
|
|
|
2722
|
|
|
2723 (cond (newdirs
|
|
|
2724 (message "Adding new directories to repository...")
|
|
|
2725 (if (cvs-execute-list newdirs
|
|
|
2726 cvs-program
|
|
|
2727 (if cvs-cvsroot
|
|
|
2728 (list "-d" cvs-cvsroot "add" "-m" msg)
|
|
|
2729 (list "add" "-m" msg))
|
|
|
2730 "Adding %s to repository...")
|
|
|
2731 (error "CVS exited with non-zero exit status.")
|
|
|
2732 (while newdirs
|
|
|
2733 (let* ((tin (car newdirs))
|
|
|
2734 (fileinfo (tin-cookie cvs-cookie-handle tin))
|
|
|
2735 (newdir (cvs-fileinfo->file-name fileinfo)))
|
|
|
2736 (cvs-set-fileinfo->dir fileinfo
|
|
|
2737 (concat (cvs-fileinfo->dir fileinfo)
|
|
|
2738 "/"
|
|
|
2739 newdir))
|
|
|
2740 (cvs-set-fileinfo->type fileinfo 'DIRCHANGE)
|
|
|
2741 (cvs-set-fileinfo->file-name fileinfo ".")
|
|
|
2742 (tin-invalidate cvs-cookie-handle tin)
|
|
|
2743 (setq newdirs (cdr newdirs))))
|
|
|
2744 ;; FIXME: this should really run cvs-update-no-prompt on the
|
|
|
2745 ;; subdir and insert everthing in the current list.
|
|
|
2746 (message "You must re-update to visit the new directories."))))))
|
|
|
2747
|
|
|
2748 ;;----------
|
|
|
2749 (defun cvs-mode-ignore ()
|
|
|
2750 "Arrange so that CVS ignores the selected files and directories.
|
|
|
2751 This command ignores files/dirs that are flagged as `Unknown'."
|
|
|
2752
|
|
|
2753 (interactive)
|
|
|
2754 (mapcar (function (lambda (tin)
|
|
|
2755 (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
|
|
|
2756 (type (cvs-fileinfo->type fileinfo)))
|
|
|
2757 (cond ((or (eq type 'UNKNOWN)
|
|
|
2758 (eq type 'UNKNOWN-DIR))
|
|
|
2759 (cvs-append-to-ignore fileinfo)
|
|
|
2760 (tin-delete cvs-cookie-handle tin))))))
|
|
|
2761 (cvs-get-marked)))
|
|
|
2762
|
|
|
2763 ;;----------
|
|
|
2764 (defun cvs-append-to-ignore (fileinfo)
|
|
|
2765 "Append the file in fileinfo to the .cvsignore file"
|
|
|
2766
|
|
|
2767 (save-window-excursion
|
|
|
2768 (set-buffer (find-file-noselect (concat (file-name-as-directory
|
|
|
2769 (cvs-fileinfo->dir fileinfo))
|
|
|
2770 ".cvsignore")))
|
|
|
2771 (goto-char (point-max))
|
|
|
2772 (if (not (zerop (current-column)))
|
|
|
2773 (insert "\n"))
|
|
|
2774 (insert (cvs-fileinfo->file-name fileinfo) "\n")
|
|
|
2775 (if cvs-sort-ignore-file
|
|
|
2776 (sort-lines nil (point-min) (point-max)))
|
|
|
2777 (save-buffer)))
|
|
|
2778
|
|
|
2779 ;;----------
|
|
|
2780 (defun cvs-mode-status ()
|
|
|
2781 "Show cvs status for all marked files."
|
|
|
2782
|
|
|
2783 (interactive)
|
|
|
2784 (save-some-buffers)
|
|
|
2785 (if (not (listp cvs-status-flags))
|
|
|
2786 (error "cvs-status-flags should be set using cvs-set-status-flags."))
|
|
|
2787 (let ((marked (cvs-get-marked nil t)))
|
|
|
2788 (cvs-use-temp-buffer)
|
|
|
2789 (message "Running cvs status ...")
|
|
|
2790 (if (cvs-execute-list marked
|
|
|
2791 cvs-program
|
|
|
2792 (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
|
|
|
2793 (list "-Q" "status")
|
|
|
2794 cvs-status-flags)
|
|
|
2795 "Running cvs -Q status %s...")
|
|
|
2796 (error "CVS exited with non-zero exit status.")
|
|
|
2797 (message "Running cvs -Q status ... Done."))))
|
|
|
2798
|
|
|
2799 ;;----------
|
|
|
2800 (defun cvs-mode-log ()
|
|
|
2801 "Display the cvs log of all selected files."
|
|
|
2802
|
|
|
2803 (interactive)
|
|
|
2804 (if (not (listp cvs-log-flags))
|
|
|
2805 (error "cvs-log-flags should be set using cvs-set-log-flags."))
|
|
|
2806 (let ((marked (cvs-get-marked nil t)))
|
|
|
2807 (cvs-use-temp-buffer)
|
|
|
2808 (message "Running cvs log ...")
|
|
|
2809 (if (cvs-execute-list marked
|
|
|
2810 cvs-program
|
|
|
2811 (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
|
|
|
2812 (list "log")
|
|
|
2813 cvs-log-flags)
|
|
|
2814 "Running cvs log %s...")
|
|
|
2815 (error "CVS exited with non-zero exit status.")
|
|
|
2816 (message "Running cvs log ... Done."))))
|
|
|
2817
|
|
|
2818 ;;----------
|
|
|
2819 (defun cvs-mode-tag ()
|
|
|
2820 "Run 'cvs tag' on all selected files."
|
|
|
2821
|
|
|
2822 (interactive)
|
|
|
2823 (if (not (listp cvs-tag-flags))
|
|
|
2824 (error "cvs-tag-flags should be set using cvs-set-tag-flags."))
|
|
|
2825 (let ((marked (cvs-get-marked nil t))
|
|
|
2826 (tag-args (cvs-make-list (read-string "Tag name (and flags): "))))
|
|
|
2827 (cvs-use-temp-buffer)
|
|
|
2828 (message "Running cvs tag ...")
|
|
|
2829 (if (cvs-execute-list marked
|
|
|
2830 cvs-program
|
|
|
2831 (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
|
|
|
2832 (list "tag")
|
|
|
2833 cvs-tag-flags
|
|
|
2834 tag-args)
|
|
|
2835 "Running cvs tag %s...")
|
|
|
2836 (error "CVS exited with non-zero exit status.")
|
|
|
2837 (message "Running cvs tag ... Done."))))
|
|
|
2838
|
|
|
2839 ;;----------
|
|
|
2840 (defun cvs-mode-rtag ()
|
|
|
2841 "Run 'cvs rtag' on all selected files."
|
|
|
2842
|
|
|
2843 (interactive)
|
|
|
2844 (if (not (listp cvs-rtag-flags))
|
|
|
2845 (error "cvs-rtag-flags should be set using cvs-set-rtag-flags."))
|
|
|
2846 (let ((marked (cvs-get-marked nil t))
|
|
|
2847 ;; FIXME: should give selection from the modules file
|
|
|
2848 (module-name (read-string "Module name: "))
|
|
|
2849 ;; FIXME: should also ask for an existing tag *or* date
|
|
|
2850 (rtag-args (cvs-make-list (read-string "Tag name (and flags): "))))
|
|
|
2851 (cvs-use-temp-buffer)
|
|
|
2852 (message "Running cvs rtag ...")
|
|
|
2853 (if (cvs-execute-list marked
|
|
|
2854 cvs-program
|
|
|
2855 (append (if cvs-cvsroot (list "-d" cvs-cvsroot))
|
|
|
2856 (list "rtag")
|
|
|
2857 cvs-rtag-flags
|
|
|
2858 rtag-args
|
|
|
2859 (list module-name))
|
|
|
2860 "Running cvs rtag %s...")
|
|
|
2861 (error "CVS rtag exited with non-zero exit status.")
|
|
|
2862 (message "Running cvs rtag ... Done."))))
|
|
|
2863
|
|
|
2864 ;;----------
|
|
|
2865 (defun cvs-mode-byte-compile-files ()
|
|
|
2866 "Run byte-compile-file on all selected files that end in '.el'."
|
|
|
2867
|
|
|
2868 (interactive)
|
|
|
2869 (let ((marked (cvs-get-marked)))
|
|
|
2870 (while marked
|
|
|
2871 (let ((filename (cvs-full-path (car marked))))
|
|
|
2872 (if (string-match "\\.el$" filename)
|
|
|
2873 (byte-compile-file filename)))
|
|
|
2874 (setq marked (cdr marked)))))
|
|
|
2875
|
|
|
2876 ;;----------
|
|
|
2877 (defun cvs-insert-full-path (tin)
|
|
|
2878 "Insert full path to the file described in TIN in the current buffer."
|
|
|
2879
|
|
|
2880 (insert (format "%s\n" (cvs-full-path tin))))
|
|
|
2881
|
|
|
2882 ;;----------
|
|
|
2883 (defun cvs-mode-add-change-log-entry-other-window (pos)
|
|
|
2884 "Add a ChangeLog entry in the ChangeLog of the current directory.
|
|
|
2885 Args: POS."
|
|
|
2886
|
|
|
2887 (interactive "d")
|
|
|
2888 (let* ((cvs-buf (current-buffer))
|
|
|
2889 (odir default-directory)
|
|
|
2890 (obfname buffer-file-name)
|
|
|
2891 (tin (tin-locate cvs-cookie-handle pos))
|
|
|
2892 (fileinfo (tin-cookie cvs-cookie-handle tin))
|
|
|
2893 (fname (cvs-fileinfo->file-name fileinfo))
|
|
|
2894 (dname (file-name-as-directory (cvs-fileinfo->dir fileinfo))))
|
|
|
2895 (setq change-log-default-name nil) ; this rarely correct in 19.28
|
|
|
2896 (setq buffer-file-name (cond (fname
|
|
|
2897 fname)
|
|
|
2898 (t
|
|
|
2899 nil)))
|
|
|
2900 (setq default-directory (cond (dname
|
|
|
2901 dname)
|
|
|
2902 (t
|
|
|
2903 odir)))
|
|
|
2904 (add-change-log-entry-other-window)
|
|
|
2905 (set-buffer cvs-buf)
|
|
|
2906 (setq default-directory odir)
|
|
|
2907 (setq buffer-file-name obfname)))
|
|
|
2908
|
|
|
2909 ;;----------
|
|
|
2910 (defun print-cvs-tin (foo)
|
|
|
2911 "Debug utility."
|
|
|
2912
|
|
|
2913 (let ((cookie (tin-cookie cvs-cookie-handle foo))
|
|
|
2914 (stream (get-buffer-create "pcl-cvs-debug")))
|
|
|
2915 (princ "==============\n" stream)
|
|
|
2916 (princ (cvs-fileinfo->file-name cookie) stream)
|
|
|
2917 (princ "\n" stream)
|
|
|
2918 (princ (cvs-fileinfo->dir cookie) stream)
|
|
|
2919 (princ "\n" stream)
|
|
|
2920 (princ (cvs-fileinfo->full-log cookie) stream)
|
|
|
2921 (princ "\n" stream)
|
|
|
2922 (princ (cvs-fileinfo->marked cookie) stream)
|
|
|
2923 (princ "\n" stream)))
|
|
|
2924
|
|
|
2925 ;;----------
|
|
|
2926 ;; NOTE: the variable cvs-emerge-tmp-head-file will be "free" when compiling
|
|
|
2927 (defun cvs-mode-emerge (pos)
|
|
|
2928 "Emerge appropriate revisions of the selected file.
|
|
|
2929 Args: POS."
|
|
|
2930
|
|
|
2931 (interactive "d")
|
|
|
2932 (let* ((cvs-buf (current-buffer))
|
|
|
2933 (tin (tin-locate cvs-cookie-handle pos)))
|
|
|
2934 (if (boundp 'cvs-emerge-tmp-head-file)
|
|
|
2935 (error "There can only be one emerge session active at a time."))
|
|
|
2936 (if tin
|
|
|
2937 (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
|
|
|
2938 (type (cvs-fileinfo->type fileinfo)))
|
|
|
2939 (cond
|
|
|
2940 ((eq type 'MODIFIED) ; merge repository head rev. with working file
|
|
|
2941 (require 'emerge)
|
|
|
2942 (setq cvs-emerge-tmp-head-file ; trick to prevent multiple runs
|
|
|
2943 (cvs-retrieve-revision-to-tmpfile fileinfo))
|
|
|
2944 (unwind-protect
|
|
|
2945 (if (not (emerge-files
|
|
|
2946 t ; arg
|
|
|
2947 (cvs-fileinfo->full-path fileinfo) ; file-A
|
|
|
2948 ;; this is an un-avoidable compiler reference to a free variable
|
|
|
2949 cvs-emerge-tmp-head-file ; file-B
|
|
|
2950 (cvs-fileinfo->full-path fileinfo) ; file-out
|
|
|
2951 nil ; start-hooks
|
|
|
2952 '(lambda () ; quit-hooks
|
|
|
2953 (delete-file cvs-emerge-tmp-head-file)
|
|
|
2954 (makunbound 'cvs-emerge-tmp-head-file))))
|
|
|
2955 (error "Emerge session failed"))))
|
|
|
2956
|
|
|
2957 ;; re-do the same merge rcsmerge supposedly just did....
|
|
|
2958 ((or (eq type 'MERGED)
|
|
|
2959 (eq type 'CONFLICT)) ; merge backup-working=A, head=B, base=ancestor
|
|
|
2960 (require 'emerge)
|
|
|
2961 (setq cvs-emerge-tmp-head-file ; trick to prevent multiple runs
|
|
|
2962 (cvs-retrieve-revision-to-tmpfile fileinfo
|
|
|
2963 (cvs-fileinfo->head-revision
|
|
|
2964 fileinfo)))
|
|
|
2965 (let ((cvs-emerge-tmp-backup-working-file
|
|
|
2966 (cvs-fileinfo->backup-file fileinfo))
|
|
|
2967 (cvs-emerge-tmp-ancestor-file
|
|
|
2968 (cvs-retrieve-revision-to-tmpfile fileinfo
|
|
|
2969 (cvs-fileinfo->base-revision
|
|
|
2970 fileinfo))))
|
|
|
2971 (unwind-protect
|
|
|
2972 (if (not (emerge-files-with-ancestor
|
|
|
2973 t ; arg
|
|
|
2974 cvs-emerge-tmp-backup-working-file ; file-A
|
|
|
2975 ;; this is an un-avoidable compiler reference to a free variable
|
|
|
2976 cvs-emerge-tmp-head-file ; file-B
|
|
|
2977 cvs-emerge-tmp-ancestor-file ; file-ancestor
|
|
|
2978 (cvs-fileinfo->full-path fileinfo) ; file-out
|
|
|
2979 nil ; start-hooks
|
|
|
2980 '(lambda () ; quit-hooks
|
|
|
2981 (delete-file cvs-emerge-tmp-backup-file)
|
|
|
2982 (delete-file cvs-emerge-tmp-ancestor-file)
|
|
|
2983 (delete-file cvs-emerge-tmp-head-file)
|
|
|
2984 (makunbound 'cvs-emerge-tmp-head-file))))
|
|
|
2985 (error "Emerge session failed")))))
|
|
|
2986 (t
|
|
|
2987 (error "Can only e-merge \"Modified\", \"Merged\" or \"Conflict\" files"))))
|
|
|
2988 (error "There is no file to e-merge."))))
|
|
|
2989
|
|
|
2990 ;;----------
|
|
|
2991 ;; NOTE: the variable ediff-version may be "free" when compiling
|
|
|
2992 (defun cvs-mode-ediff (pos)
|
|
|
2993 "Ediff appropriate revisions of the selected file.
|
|
|
2994 Args: POS."
|
|
|
2995
|
|
|
2996 (interactive "d")
|
|
|
2997 (if (boundp 'cvs-ediff-tmp-head-file)
|
|
|
2998 (error "There can only be one ediff session active at a time."))
|
|
|
2999 (require 'ediff)
|
|
|
3000 (if (and (boundp 'ediff-version)
|
|
|
3001 (>= (string-to-number ediff-version) 2.0)) ; FIXME real number?
|
|
|
3002 (run-ediff-from-cvs-buffer pos)
|
|
|
3003 (cvs-old-ediff-interface pos)))
|
|
|
3004
|
|
|
3005 (defun cvs-old-ediff-interface (pos)
|
|
|
3006 "Emerge like interface for older ediffs.
|
|
|
3007 Args: POS"
|
|
|
3008
|
|
|
3009 (let* ((cvs-buf (current-buffer))
|
|
|
3010 (tin (tin-locate cvs-cookie-handle pos)))
|
|
|
3011 (if tin
|
|
|
3012 (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
|
|
|
3013 (type (cvs-fileinfo->type fileinfo)))
|
|
|
3014 (cond
|
|
|
3015 ((eq type 'MODIFIED) ; diff repository head rev. with working file
|
|
|
3016 ;; should this be inside the unwind-protect, and should the
|
|
|
3017 ;; makeunbound be an unwindform?
|
|
|
3018 (setq cvs-ediff-tmp-head-file ; trick to prevent multiple runs
|
|
|
3019 (cvs-retrieve-revision-to-tmpfile fileinfo))
|
|
|
3020 (unwind-protect
|
|
|
3021 (if (not (ediff-files ; check correct ordering of args
|
|
|
3022 (cvs-fileinfo->full-path fileinfo) ; file-A
|
|
|
3023 ;; this is an un-avoidable compiler reference to a free variable
|
|
|
3024 cvs-ediff-tmp-head-file ; file-B
|
|
|
3025 '(lambda () ; startup-hooks
|
|
|
3026 (make-local-hook 'ediff-cleanup-hooks)
|
|
|
3027 (add-hook 'ediff-cleanup-hooks
|
|
|
3028 '(lambda ()
|
|
|
3029 (ediff-janitor)
|
|
|
3030 (delete-file cvs-ediff-tmp-head-file)
|
|
|
3031 (makunbound 'cvs-ediff-tmp-head-file))
|
|
|
3032 nil t))))
|
|
|
3033 (error "Ediff session failed"))))
|
|
|
3034
|
|
|
3035 ;; look at the merge rcsmerge supposedly just did....
|
|
|
3036 ((or (eq type 'MERGED)
|
|
|
3037 (eq type 'CONFLICT)) ; diff backup-working=A, head=B, base=ancestor
|
|
|
3038 (if (not (boundp 'ediff-version))
|
|
|
3039 (error "ediff version way too old for 3-way diff"))
|
|
|
3040 (if (<= (string-to-number ediff-version) 1.9) ; FIXME real number?
|
|
|
3041 (error "ediff version %s too old for 3-way diff" ediff-version))
|
|
|
3042 (setq cvs-ediff-tmp-head-file ; trick to prevent multiple runs
|
|
|
3043 (cvs-retrieve-revision-to-tmpfile fileinfo
|
|
|
3044 (cvs-fileinfo->head-revision
|
|
|
3045 fileinfo)))
|
|
|
3046 (let ((cvs-ediff-tmp-backup-working-file
|
|
|
3047 (cvs-fileinfo->backup-file fileinfo))
|
|
|
3048 (cvs-ediff-tmp-ancestor-file
|
|
|
3049 (cvs-retrieve-revision-to-tmpfile fileinfo
|
|
|
3050 (cvs-fileinfo->base-revision
|
|
|
3051 fileinfo))))
|
|
|
3052 (unwind-protect
|
|
|
3053 (if (not (ediff-files3 ; check correct ordering of args
|
|
|
3054 cvs-ediff-tmp-backup-working-file ; file-A
|
|
|
3055 ;; this is an un-avoidable compiler reference to a free variable
|
|
|
3056 cvs-ediff-tmp-head-file ; file-B
|
|
|
3057 cvs-ediff-tmp-ancestor-file ; file-ancestor
|
|
|
3058 '(lambda () ; start-hooks
|
|
|
3059 (make-local-hook 'ediff-cleanup-hooks)
|
|
|
3060 (add-hook 'ediff-cleanup-hooks
|
|
|
3061 '(lambda ()
|
|
|
3062 (ediff-janitor)
|
|
|
3063 (delete-file cvs-ediff-tmp-backup-file)
|
|
|
3064 (delete-file cvs-ediff-tmp-ancestor-file)
|
|
|
3065 (delete-file cvs-ediff-tmp-head-file)
|
|
|
3066 (makunbound 'cvs-ediff-tmp-head-file))
|
|
|
3067 nil t))))
|
|
|
3068 (error "Ediff session failed")))))
|
|
|
3069
|
|
|
3070 ((not (or (eq type 'UNKNOWN)
|
|
|
3071 (eq type 'UNKNOWN-DIR))) ; i.e. UPDATED or PATCHED ????
|
|
|
3072 ;; this should really diff the current working file with the previous
|
|
|
3073 ;; rev. on the current branch (i.e. not the head, since that's what
|
|
|
3074 ;; the current file should be)
|
|
|
3075 (setq cvs-ediff-tmp-head-file ; trick to prevent multiple runs
|
|
|
3076 (cvs-retrieve-revision-to-tmpfile fileinfo
|
|
|
3077 (read-string "Rev #/tag to diff against: "
|
|
|
3078 (cvs-fileinfo->head-revision
|
|
|
3079 fileinfo))))
|
|
|
3080 (unwind-protect
|
|
|
3081 (if (not (ediff-files ; check correct ordering of args
|
|
|
3082 (cvs-fileinfo->full-path fileinfo) ; file-A
|
|
|
3083 ;; this is an un-avoidable compiler reference to a free variable
|
|
|
3084 cvs-ediff-tmp-head-file ; file-B
|
|
|
3085 '(lambda () ; startup-hooks
|
|
|
3086 (make-local-hook 'ediff-cleanup-hooks)
|
|
|
3087 (add-hook 'ediff-cleanup-hooks
|
|
|
3088 '(lambda ()
|
|
|
3089 (ediff-janitor)
|
|
|
3090 (delete-file cvs-ediff-tmp-head-file)
|
|
|
3091 (makunbound 'cvs-ediff-tmp-head-file))
|
|
|
3092 nil t))))
|
|
|
3093 (error "Ediff session failed"))))
|
|
|
3094 (t
|
|
|
3095 (error "Can not ediff \"Unknown\" files"))))
|
|
|
3096 (error "There is no file to ediff."))))
|
|
|
3097
|
|
|
3098 ;;----------
|
|
|
3099 (defun cvs-retrieve-revision-to-tmpfile (fileinfo &optional revision)
|
|
|
3100 "Retrieve the latest revision of the file in FILEINFO to a temporary file.
|
|
|
3101 If second optional argument REVISION is given, retrieve that revision instead."
|
|
|
3102
|
|
|
3103 (let
|
|
|
3104 ((temp-name (make-temp-name
|
|
|
3105 (concat (file-name-as-directory
|
|
|
3106 (or (getenv "TMPDIR") "/tmp"))
|
|
|
3107 "pcl-cvs." revision))))
|
|
|
3108 (cvs-kill-buffer-visiting temp-name)
|
|
|
3109 (if (and revision
|
|
|
3110 (stringp revision)
|
|
|
3111 (not (string= revision "")))
|
|
|
3112 (message "Retrieving revision %s..." revision)
|
|
|
3113 (message "Retrieving latest revision..."))
|
|
|
3114 (let ((res (call-process cvs-shell nil nil nil "-c"
|
|
|
3115 (concat cvs-program " update -p "
|
|
|
3116 (if (and revision
|
|
|
3117 (stringp revision)
|
|
|
3118 (not (string= revision "")))
|
|
|
3119 (concat "-r " revision " ")
|
|
|
3120 "")
|
|
|
3121 (cvs-fileinfo->full-path fileinfo)
|
|
|
3122 " > " temp-name))))
|
|
|
3123 (if (and res (not (and (integerp res) (zerop res))))
|
|
|
3124 (error "Something went wrong retrieving revision %s: %s"
|
|
|
3125 revision res))
|
|
|
3126
|
|
|
3127 (if revision
|
|
|
3128 (message "Retrieving revision %s... Done." revision)
|
|
|
3129 (message "Retrieving latest revision... Done."))
|
|
|
3130 (save-excursion
|
|
|
3131 (set-buffer (find-file-noselect temp-name))
|
|
|
3132 (rename-buffer (concat " " (file-name-nondirectory temp-name)) t))
|
|
|
3133 temp-name)))
|
|
|
3134
|
|
|
3135 ;;----------
|
|
|
3136 (defun cvs-kill-buffer-visiting (filename)
|
|
|
3137 "If there is any buffer visiting FILENAME, kill it (without confirmation)."
|
|
|
3138
|
|
|
3139 (let ((l (buffer-list)))
|
|
|
3140 (while l
|
|
|
3141 (if (string= (buffer-file-name (car l)) filename)
|
|
|
3142 (kill-buffer (car l)))
|
|
|
3143 (setq l (cdr l)))))
|
|
|
3144
|
|
|
3145 ;;----------
|
|
|
3146 (defun cvs-change-cvsroot ()
|
|
|
3147 "Ask for a new cvsroot."
|
|
|
3148
|
|
|
3149 (interactive)
|
|
|
3150 (cvs-set-cvsroot (read-file-name "New CVSROOT: " cvs-cvsroot)))
|
|
|
3151
|
|
|
3152 ;;----------
|
|
|
3153 (defun cvs-set-cvsroot (newroot)
|
|
|
3154 "Change the cvsroot."
|
|
|
3155
|
|
|
3156 (if (or (file-directory-p (expand-file-name "CVSROOT" newroot))
|
|
|
3157 (y-or-n-p (concat "Warning: no CVSROOT found inside repository."
|
|
|
3158 " Change cvs-cvsroot anyhow?")))
|
|
|
3159 (setq cvs-cvsroot newroot)))
|
|
|
3160
|
|
|
3161 ;;----------
|
|
|
3162 (defun cvs-set-diff-flags ()
|
|
|
3163 "Ask for new setting of cvs-diff-flags."
|
|
|
3164
|
|
|
3165 (interactive)
|
|
|
3166 (let ((old-value (mapconcat 'identity
|
|
|
3167 (copy-sequence cvs-diff-flags) " ")))
|
|
|
3168 (setq cvs-diff-flags
|
|
|
3169 (cvs-make-list (read-string "Diff flags: " old-value)))))
|
|
|
3170
|
|
|
3171 ;;----------
|
|
|
3172 (defun cvs-set-update-optional-flags ()
|
|
|
3173 "Ask for new setting of cvs-update-optional-flags."
|
|
|
3174
|
|
|
3175 (interactive)
|
|
|
3176 (let ((old-value (mapconcat 'identity
|
|
|
3177 (copy-sequence cvs-update-optional-flags) " ")))
|
|
|
3178 (setq cvs-update-optional-flags
|
|
|
3179 (cvs-make-list (read-string "Update optional flags: " old-value)))))
|
|
|
3180
|
|
|
3181 ;;----------
|
|
|
3182 (defun cvs-set-status-flags ()
|
|
|
3183 "Ask for new setting of cvs-status-flags."
|
|
|
3184
|
|
|
3185 (interactive)
|
|
|
3186 (let ((old-value (mapconcat 'identity
|
|
|
3187 (copy-sequence cvs-status-flags) " ")))
|
|
|
3188 (setq cvs-status-flags
|
|
|
3189 (cvs-make-list (read-string "Status flags: " old-value)))))
|
|
|
3190
|
|
|
3191 ;;----------
|
|
|
3192 (defun cvs-set-log-flags ()
|
|
|
3193 "Ask for new setting of cvs-log-flags."
|
|
|
3194
|
|
|
3195 (interactive)
|
|
|
3196 (let ((old-value (mapconcat 'identity
|
|
|
3197 (copy-sequence cvs-log-flags) " ")))
|
|
|
3198 (setq cvs-log-flags
|
|
|
3199 (cvs-make-list (read-string "Log flags: " old-value)))))
|
|
|
3200
|
|
|
3201 ;;----------
|
|
|
3202 (defun cvs-set-tag-flags ()
|
|
|
3203 "Ask for new setting of cvs-tag-flags."
|
|
|
3204
|
|
|
3205 (interactive)
|
|
|
3206 (let ((old-value (mapconcat 'identity
|
|
|
3207 (copy-sequence cvs-tag-flags) " ")))
|
|
|
3208 (setq cvs-tag-flags
|
|
|
3209 (cvs-make-list (read-string "Tag flags: " old-value)))))
|
|
|
3210
|
|
|
3211 ;;----------
|
|
|
3212 (defun cvs-set-rtag-flags ()
|
|
|
3213 "Ask for new setting of cvs-rtag-flags."
|
|
|
3214
|
|
|
3215 (interactive)
|
|
|
3216 (let ((old-value (mapconcat 'identity
|
|
|
3217 (copy-sequence cvs-rtag-flags) " ")))
|
|
|
3218 (setq cvs-rtag-flags
|
|
|
3219 (cvs-make-list (read-string "Rtag flags: " old-value)))))
|
|
|
3220
|
|
|
3221 ;;----------
|
|
|
3222 (if (string-match "XEmacs" emacs-version)
|
|
|
3223 (progn
|
|
|
3224 ;; now marked to autload in pcl-cvs-xemacs
|
|
|
3225 ;(autoload 'pcl-cvs-fontify "pcl-cvs-xemacs")
|
|
|
3226 (add-hook 'cvs-mode-hook 'pcl-cvs-fontify)))
|
|
|
3227
|
|
|
3228 (defun cvs-changelog-name (directory)
|
|
|
3229 "Return the name of the ChangeLog file that handles DIRECTORY.
|
|
|
3230 This is in DIRECTORY or one of its parents.
|
|
|
3231 Signal an error if we can't find an appropriate ChangeLog file."
|
|
|
3232 (let ((dir (file-name-as-directory directory))
|
|
|
3233 file)
|
|
|
3234 (while (and dir
|
|
|
3235 (not (file-exists-p
|
|
|
3236 (setq file (expand-file-name "ChangeLog" dir)))))
|
|
|
3237 (let ((last dir))
|
|
|
3238 (setq dir (file-name-directory (directory-file-name dir)))
|
|
|
3239 (if (equal last dir)
|
|
|
3240 (setq dir nil))))
|
|
|
3241 (or dir
|
|
|
3242 (error "Can't find ChangeLog for %s" directory))
|
|
|
3243 file))
|
|
|
3244
|
|
|
3245 (defun cvs-narrow-changelog ()
|
|
|
3246 "Narrow to the top page of the current buffer, a ChangeLog file.
|
|
|
3247 Actually, the narrowed region doesn't include the date line.
|
|
|
3248 A \"page\" in a ChangeLog file is the area between two dates."
|
|
|
3249 (or (eq major-mode 'change-log-mode)
|
|
|
3250 (error "cvs-narrow-changelog: current buffer isn't a ChangeLog"))
|
|
|
3251
|
|
|
3252 (goto-char (point-min))
|
|
|
3253
|
|
|
3254 ;; Skip date line and subsequent blank lines.
|
|
|
3255 (forward-line 1)
|
|
|
3256 (if (looking-at "[ \t\n]*\n")
|
|
|
3257 (goto-char (match-end 0)))
|
|
|
3258
|
|
|
3259 (let ((start (point)))
|
|
|
3260 (forward-page 1)
|
|
|
3261 (narrow-to-region start (point))
|
|
|
3262 (goto-char (point-min))))
|
|
|
3263
|
|
|
3264 (defun cvs-changelog-paragraph ()
|
|
|
3265 "Return the bounds of the ChangeLog paragraph containing point.
|
|
|
3266 If we are between paragraphs, return the previous paragraph."
|
|
|
3267 (save-excursion
|
|
|
3268 (beginning-of-line)
|
|
|
3269 (if (looking-at "^[ \t]*$")
|
|
|
3270 (skip-chars-backward " \t\n" (point-min)))
|
|
|
3271 (list (progn
|
|
|
3272 (if (re-search-backward "^[ \t]*\n" nil 'or-to-limit)
|
|
|
3273 (goto-char (match-end 0)))
|
|
|
3274 (point))
|
|
|
3275 (if (re-search-forward "^[ \t\n]*$" nil t)
|
|
|
3276 (match-beginning 0)
|
|
|
3277 (point)))))
|
|
|
3278
|
|
|
3279 (defun cvs-changelog-subparagraph ()
|
|
|
3280 "Return the bounds of the ChangeLog subparagraph containing point.
|
|
|
3281 A subparagraph is a block of non-blank lines beginning with an asterisk.
|
|
|
3282 If we are between sub-paragraphs, return the previous subparagraph."
|
|
|
3283 (save-excursion
|
|
|
3284 (end-of-line)
|
|
|
3285 (if (search-backward "*" nil t)
|
|
|
3286 (list (progn (beginning-of-line) (point))
|
|
|
3287 (progn
|
|
|
3288 (forward-line 1)
|
|
|
3289 (if (re-search-forward "^[ \t]*[\n*]" nil t)
|
|
|
3290 (match-beginning 0)
|
|
|
3291 (point-max))))
|
|
|
3292 (list (point) (point)))))
|
|
|
3293
|
|
|
3294 (defun cvs-changelog-entry ()
|
|
|
3295 "Return the bounds of the ChangeLog entry containing point.
|
|
|
3296 The variable `cvs-changelog-full-paragraphs' decides whether an
|
|
|
3297 \"entry\" is a paragraph or a subparagraph; see its documentation string
|
|
|
3298 for more details."
|
|
|
3299 (if cvs-changelog-full-paragraphs
|
|
|
3300 (cvs-changelog-paragraph)
|
|
|
3301 (cvs-changelog-subparagraph)))
|
|
|
3302
|
|
|
3303 ;; NOTE: the variable user-full-name may be "free" when compiling
|
|
|
3304 (defun cvs-changelog-ours-p ()
|
|
|
3305 "See if ChangeLog entry at point is for the current user, today.
|
|
|
3306 Return non-nil iff it is."
|
|
|
3307 ;; Code adapted from add-change-log-entry.
|
|
|
3308 (looking-at (concat (regexp-quote (substring (current-time-string)
|
|
|
3309 0 10))
|
|
|
3310 ".* "
|
|
|
3311 (regexp-quote (substring (current-time-string) -4))
|
|
|
3312 "[ \t]+"
|
|
|
3313 (regexp-quote (if (and (boundp 'add-log-full-name)
|
|
|
3314 add-log-full-name)
|
|
|
3315 add-log-full-name
|
|
|
3316 user-full-name))
|
|
|
3317 " <"
|
|
|
3318 (regexp-quote (if (and (boundp 'add-log-mailing-address)
|
|
|
3319 add-log-mailing-address)
|
|
|
3320 add-log-mailing-address
|
|
114
|
3321 (user-mail-address))))))
|
|
0
|
3322
|
|
|
3323 (defun cvs-relative-path (base child)
|
|
|
3324 "Return a directory path relative to BASE for CHILD.
|
|
|
3325 If CHILD doesn't seem to be in a subdirectory of BASE, just return
|
|
|
3326 the full path to CHILD."
|
|
|
3327 (let ((base (file-name-as-directory (expand-file-name base)))
|
|
|
3328 (child (expand-file-name child)))
|
|
|
3329 (or (string= base (substring child 0 (length base)))
|
|
|
3330 (error "cvs-relative-path: %s isn't in %s" child base))
|
|
|
3331 (substring child (length base))))
|
|
|
3332
|
|
|
3333 (defun cvs-changelog-entries (file)
|
|
|
3334 "Return the ChangeLog entries for FILE, and the ChangeLog they came from.
|
|
|
3335 The return value looks like this:
|
|
|
3336 (LOGBUFFER (ENTRYSTART . ENTRYEND) ...)
|
|
|
3337 where LOGBUFFER is the name of the ChangeLog buffer, and each
|
|
|
3338 \(ENTRYSTART . ENTRYEND\) pair is a buffer region."
|
|
|
3339 (save-excursion
|
|
|
3340 (set-buffer (find-file-noselect
|
|
|
3341 (cvs-changelog-name
|
|
|
3342 (file-name-directory
|
|
|
3343 (expand-file-name file)))))
|
|
|
3344 (or (eq major-mode 'change-log-mode)
|
|
|
3345 (change-log-mode))
|
|
|
3346 (goto-char (point-min))
|
|
|
3347 (if (looking-at "[ \t\n]*\n")
|
|
|
3348 (goto-char (match-end 0)))
|
|
|
3349 (if (not (cvs-changelog-ours-p))
|
|
|
3350 (list (current-buffer))
|
|
|
3351 (save-restriction
|
|
|
3352 (cvs-narrow-changelog)
|
|
|
3353 (goto-char (point-min))
|
|
|
3354
|
|
|
3355 ;; Search for the name of FILE relative to the ChangeLog. If that
|
|
|
3356 ;; doesn't occur anywhere, they're not using full relative
|
|
|
3357 ;; filenames in the ChangeLog, so just look for FILE; we'll accept
|
|
|
3358 ;; some false positives.
|
|
|
3359 (let ((pattern (cvs-relative-path
|
|
|
3360 (file-name-directory buffer-file-name) file)))
|
|
|
3361 (if (or (string= pattern "")
|
|
|
3362 (not (save-excursion
|
|
|
3363 (search-forward pattern nil t))))
|
|
|
3364 (setq pattern file))
|
|
|
3365
|
|
|
3366 (let (texts)
|
|
|
3367 (while (search-forward pattern nil t)
|
|
|
3368 (let ((entry (cvs-changelog-entry)))
|
|
|
3369 (setq texts (cons entry texts))
|
|
|
3370 (goto-char (elt entry 1))))
|
|
|
3371
|
|
|
3372 (cons (current-buffer) texts)))))))
|
|
|
3373
|
|
|
3374 (defun cvs-changelog-insert-entries (buffer regions)
|
|
|
3375 "Insert those regions in BUFFER specified in REGIONS.
|
|
|
3376 Sort REGIONS front-to-back first."
|
|
|
3377 (let ((regions (sort regions 'car-less-than-car))
|
|
|
3378 (last))
|
|
|
3379 (while regions
|
|
|
3380 (if (and last (< last (car (car regions))))
|
|
|
3381 (newline))
|
|
|
3382 (setq last (elt (car regions) 1))
|
|
|
3383 (apply 'insert-buffer-substring buffer (car regions))
|
|
|
3384 (setq regions (cdr regions)))))
|
|
|
3385
|
|
|
3386 (defun cvs-union (set1 set2)
|
|
|
3387 "Return the union of SET1 and SET2, according to `equal'."
|
|
|
3388 (while set2
|
|
|
3389 (or (member (car set2) set1)
|
|
|
3390 (setq set1 (cons (car set2) set1)))
|
|
|
3391 (setq set2 (cdr set2)))
|
|
|
3392 set1)
|
|
|
3393
|
|
|
3394 (defun cvs-insert-changelog-entries (files)
|
|
|
3395 "Given a list of files FILES, insert the ChangeLog entries for them."
|
|
|
3396 (let ((buffer-entries nil))
|
|
|
3397
|
|
|
3398 ;; Add each buffer to buffer-entries, and associate it with the list
|
|
|
3399 ;; of entries we want from that file.
|
|
|
3400 (while files
|
|
|
3401 (let* ((entries (cvs-changelog-entries (car files)))
|
|
|
3402 (pair (assq (car entries) buffer-entries)))
|
|
|
3403 (if pair
|
|
|
3404 (setcdr pair (cvs-union (cdr pair) (cdr entries)))
|
|
|
3405 (setq buffer-entries (cons entries buffer-entries))))
|
|
|
3406 (setq files (cdr files)))
|
|
|
3407
|
|
|
3408 ;; Now map over each buffer in buffer-entries, sort the entries for
|
|
|
3409 ;; each buffer, and extract them as strings.
|
|
|
3410 (while buffer-entries
|
|
|
3411 (cvs-changelog-insert-entries (car (car buffer-entries))
|
|
|
3412 (cdr (car buffer-entries)))
|
|
|
3413 (if (and (cdr buffer-entries) (cdr (car buffer-entries)))
|
|
|
3414 (newline))
|
|
|
3415 (setq buffer-entries (cdr buffer-entries)))))
|
|
|
3416
|
|
|
3417 (defun cvs-edit-delete-common-indentation ()
|
|
|
3418 "Unindent the current buffer rigidly until at least one line is flush left."
|
|
|
3419 (save-excursion
|
|
|
3420 (let ((common 100000))
|
|
|
3421 (goto-char (point-min))
|
|
|
3422 (while (< (point) (point-max))
|
|
|
3423 (if (not (looking-at "^[ \t]*$"))
|
|
|
3424 (setq common (min common (current-indentation))))
|
|
|
3425 (forward-line 1))
|
|
|
3426 (indent-rigidly (point-min) (point-max) (- common)))))
|
|
|
3427
|
|
|
3428 (defun cvs-mode-changelog-commit ()
|
|
|
3429 "Check in all marked files, or the current file.
|
|
|
3430 Ask the user for a log message in a buffer.
|
|
|
3431
|
|
|
3432 This is just like `\\[cvs-mode-commit]', except that it tries to provide
|
|
|
3433 appropriate default log messages by looking at the ChangeLog. The
|
|
|
3434 idea is to write your ChangeLog entries first, and then use this
|
|
|
3435 command to commit your changes.
|
|
|
3436
|
|
|
3437 To select default log text, we:
|
|
|
3438 - find the ChangeLog entries for the files to be checked in,
|
|
|
3439 - verify that the top entry in the ChangeLog is on the current date
|
|
|
3440 and by the current user; if not, we don't provide any default text,
|
|
|
3441 - search the ChangeLog entry for paragraphs containing the names of
|
|
|
3442 the files we're checking in, and finally
|
|
|
3443 - use those paragraphs as the log text."
|
|
|
3444
|
|
|
3445 (interactive)
|
|
|
3446
|
|
|
3447 (let* ((cvs-buf (current-buffer))
|
|
|
3448 (marked (cvs-filter (function cvs-committable)
|
|
|
3449 (cvs-get-marked))))
|
|
|
3450 (if (null marked)
|
|
|
3451 (error "Nothing to commit!")
|
|
|
3452 (pop-to-buffer (get-buffer-create cvs-commit-prompt-buffer))
|
|
|
3453 (goto-char (point-min))
|
|
|
3454
|
|
|
3455 (erase-buffer)
|
|
|
3456 (cvs-insert-changelog-entries
|
|
|
3457 (mapcar (lambda (tin)
|
|
|
3458 (let ((cookie (tin-cookie cvs-cookie-handle tin)))
|
|
|
3459 (expand-file-name
|
|
|
3460 (cvs-fileinfo->file-name cookie)
|
|
|
3461 (cvs-fileinfo->dir cookie))))
|
|
|
3462 marked))
|
|
|
3463 (cvs-edit-delete-common-indentation)
|
|
|
3464
|
|
|
3465 (cvs-edit-mode)
|
|
|
3466 (make-local-variable 'cvs-commit-list)
|
|
|
3467 (setq cvs-commit-list marked)
|
|
|
3468 (message "Press C-c C-c when you are done editing."))))
|
|
|
3469
|
|
76
|
3470 (provide 'pcl-cvs)
|
|
|
3471
|
|
|
3472 ;;; pcl-cvs.el ends here
|
