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