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