/[meta-cvs]/meta-cvs/F-FFF16CA4956A36F19290AC9E1EBAFFD8
ViewVC logotype

Contents of /meta-cvs/F-FFF16CA4956A36F19290AC9E1EBAFFD8

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.47 - (hide annotations)
Sat Oct 5 18:19:23 2002 UTC (11 years, 6 months ago) by kaz
Branch: MAIN
Changes since 1.46: +1 -1 lines
* code/error.lisp (mcvs-error-handler): Simplify roundabout way
of printing error message.

* code/mapping.lisp (mapping-write): Incorporate the low level error
message into the more informative error message.
1 kaz 1.10 ;;; This source file is part of the Meta-CVS program,
2 kaz 1.9 ;;; which is distributed under the GNU license.
3     ;;; Copyright 2002 Kaz Kylheku
4    
5 kaz 1.1 (require "dirwalk")
6     (require "system")
7     (require "sync")
8     (require "chatter")
9     (require "restart")
10 kaz 1.38 (require "seqfuncs")
11 kaz 1.1 (provide "mapping")
12    
13 kaz 1.6 (eval-when (:compile-toplevel :load-toplevel :execute)
14 kaz 1.40 (defconstant *mcvs-dir* "MCVS")
15 kaz 1.20 (defconstant *mcvs-map-name* "MAP")
16 kaz 1.37 (defconstant *mcvs-map-local-name* "MAP-LOCAL")
17     (defconstant *mcvs-displaced-name* "DISPLACED"))
18 kaz 1.6
19     (eval-when (:compile-toplevel :load-toplevel :execute)
20 kaz 1.20 (defconstant *mcvs-map* #.(path-cat *mcvs-dir* *mcvs-map-name*))
21 kaz 1.37 (defconstant *mcvs-map-local* #.(path-cat *mcvs-dir* *mcvs-map-local-name*))
22     (defconstant *mcvs-displaced* #.(path-cat *mcvs-dir* *mcvs-displaced-name*)))
23    
24     (defvar *displaced-path-prefix* nil)
25     (defvar *displaced-path-length* nil)
26 kaz 1.1
27     (defun mcvs-locate ()
28 kaz 1.40 (let ((current-dir (split-fields (getcwd) *path-sep*)))
29     (dotimes (i (length current-dir) nil)
30     (let* ((path-components (butlast current-dir i))
31     (path-string (reduce #'path-cat path-components)))
32     (when (ignore-errors (stat (path-cat path-string *mcvs-dir*)))
33     (chdir path-string)
34     (return (if (zerop i)
35     "."
36     (reduce #'path-cat (last current-dir i)))))))))
37 kaz 1.1
38 kaz 1.37 (defun real-path-exists (path)
39     (or (null *displaced-path-prefix*)
40     (path-prefix-equal *displaced-path-prefix* path)))
41    
42     (defun abstract-to-real-path (path)
43     (if *displaced-path-length*
44     (if (or (= (length path) (1- *displaced-path-length*))
45     (= (length path) *displaced-path-length*))
46     *this-dir*
47     (substring path *displaced-path-length*))
48     path))
49    
50     (defun real-to-abstract-path (path)
51     (if *displaced-path-prefix*
52     (concatenate 'string *displaced-path-prefix* path)
53     path))
54    
55     (declaim (inline real-path-exists abstract-to-real-path
56     real-to-abstract-path))
57    
58 kaz 1.4 (defmacro in-sandbox-root-dir (&body forms)
59     (let ((downpath-sym (gensym "DOWNPATH-")))
60     `(current-dir-restore
61     (let ((,downpath-sym (mcvs-locate)))
62     (when (not ,downpath-sym)
63 kaz 1.46 (error "could not locate ~a directory." *mcvs-dir*))
64 kaz 1.37 (let* ((*displaced-path-prefix* (displaced-path-read))
65     (*displaced-path-length* (if *displaced-path-prefix*
66     (length *displaced-path-prefix*))))
67     (flet ((sandbox-translate-path (in-path)
68     (multiple-value-bind (out-path out-of-bounds)
69     (canonicalize-path
70     (if (path-absolute-p in-path)
71     (path-cat *this-dir* in-path)
72     (path-cat ,downpath-sym in-path)))
73     (if out-of-bounds
74 kaz 1.46 (error "path ~a is not within sandbox." out-path)
75 kaz 1.37 out-path))))
76     (symbol-macrolet ((sandbox-down-path ,downpath-sym))
77     ,@forms)))))))
78 kaz 1.4
79 kaz 1.42 (defstruct mapping-entry
80     (kind :file)
81     (id "")
82     (path "")
83 kaz 1.43 (target "")
84 kaz 1.44 (executable nil)
85     (raw-plist nil))
86 kaz 1.42
87     (defun equal-mapping-entries (left right)
88     (and (eq (mapping-entry-kind left) (mapping-entry-kind right))
89     (string= (mapping-entry-id left) (mapping-entry-id right))
90     (path-equal (mapping-entry-path left) (mapping-entry-path right))
91     (equal (mapping-entry-target left) (mapping-entry-target right))))
92    
93     (defun equal-filemaps (left right)
94     (let ((same nil))
95     (mapc #'(lambda (le re)
96     (setf same (and same (equal-mapping-entries le re))))
97     left right)))
98    
99 kaz 1.44 (defun mapping-entry-parse-plist (entry)
100     (with-slots (executable raw-plist) entry
101 kaz 1.45 (destructuring-bind (&key exec &allow-other-keys)
102     raw-plist
103     (setf executable exec)))
104     (values))
105 kaz 1.43
106 kaz 1.42 (defun mapping-generate-id (&key no-dir (suffix "") (prefix "F-"))
107     (format nil "~a~a~32,'0X~a"
108     (if no-dir "" (concatenate 'string *mcvs-dir* *path-sep*))
109     prefix
110     (guid-gen)
111     (if (or (null suffix) (string= "" suffix))
112     ""
113     (concatenate 'string "." suffix))))
114    
115     (defun mapping-extract-kind (filemap kind)
116     (remove-if-not #'(lambda (entry-kind)
117     (eq entry-kind kind))
118     filemap
119     :key #'mapping-entry-kind))
120 kaz 1.1
121 kaz 1.12 (defun mapping-extract-paths (filemap)
122 kaz 1.42 (mapcar #'mapping-entry-path filemap))
123 kaz 1.12 (declaim (inline mapping-extract-paths))
124 kaz 1.4
125 kaz 1.12 (defun mapping-lookup (filemap path)
126 kaz 1.42 (find path filemap :test #'path-equal :key #'mapping-entry-path))
127 kaz 1.6
128 kaz 1.12 (defun mapping-prefix-lookup (filemap prefix)
129 kaz 1.6 (if (path-equal *this-dir* prefix)
130     (first filemap)
131 kaz 1.42 (find prefix filemap :test #'path-prefix-equal :key #'mapping-entry-path)))
132 kaz 1.1
133 kaz 1.12 (defun mapping-prefix-matches (filemap path)
134 kaz 1.2 (if (path-equal *this-dir* path)
135     filemap
136     (remove-if-not #'(lambda (entry)
137 kaz 1.42 (path-prefix-equal path (mapping-entry-path entry)))
138     filemap)))
139 kaz 1.2
140 kaz 1.42 (defun mapping-same-id-p (entry-one entry-two)
141     (string= (mapping-entry-id entry-one) (mapping-entry-id entry-two)))
142 kaz 1.1
143 kaz 1.12 (defun mapping-same-path-p (entry-one entry-two)
144 kaz 1.42 (path-equal (mapping-entry-path entry-one) (mapping-entry-path entry-two)))
145 kaz 1.1
146 kaz 1.12 (defun mapping-rename-files (filemap file-list old-prefix new-prefix)
147 kaz 1.3 "Returns a new filemap, in which the pathames in the list file-list are edited
148     by replacing the old-prefix with the new-prefix. If any path thus created
149     matches an existing map entry, that map entry is removed. The sorting order
150     of the map is not preserved."
151 kaz 1.4 (flet ((combine (prefix path)
152     (if (string= path "")
153     prefix
154     (canonicalize-path (path-cat prefix path)))))
155     (let* ((op-len (length old-prefix))
156     (delete-map (mapcan #'(lambda (entry)
157 kaz 1.42 (with-slots (path) entry
158 kaz 1.4 (if (and (member path file-list
159     :test #'path-equal)
160     (path-prefix-equal old-prefix
161     path))
162     (list entry)))) filemap))
163     (replace-map (mapcan #'(lambda (entry)
164 kaz 1.42 (with-slots (path) entry
165     (let ((new-entry (copy-mapping-entry
166     entry)))
167     (setf (mapping-entry-path new-entry)
168     (combine new-prefix
169     (subseq path op-len)))
170     (list new-entry))))
171 kaz 1.4 delete-map)))
172 kaz 1.3 (append
173     (set-difference
174 kaz 1.12 (set-difference filemap delete-map :test #'mapping-same-path-p)
175     replace-map :test #'mapping-same-path-p)
176 kaz 1.4 replace-map))))
177 kaz 1.3
178 kaz 1.29 (defun malformed-map ()
179 kaz 1.46 (error "malformed map (merge conflicts?): correct and run mcvs update."))
180 kaz 1.29
181 kaz 1.13 (defun mapping-dupe-check (filemap)
182     "Signals an error condition if the filemap contains duplicate paths or
183 kaz 1.17 duplicate objects. Otherwise returns the filemap, sorted by path."
184 kaz 1.42 (let ((dupes)
185     (id-hash (make-hash-table :test #'equal))
186     (path-hash (make-hash-table :test #'equal)))
187     (dolist (entry filemap)
188     (if (gethash (mapping-entry-id entry) id-hash)
189     (push entry dupes)
190     (setf (gethash (mapping-entry-id entry) id-hash) entry))
191     (if (gethash (mapping-entry-path entry) path-hash)
192     (push entry dupes)
193     (setf (gethash (mapping-entry-path entry) path-hash) entry)))
194 kaz 1.13 (when dupes
195     (dolist (dupe dupes)
196 kaz 1.42 (chatter-terse "duplicate ~a -> ~a~%"
197     (mapping-entry-id dupe) (mapping-entry-path dupe)))
198 kaz 1.46 (error "duplicates in map: correct and run mcvs update.")))
199 kaz 1.13 filemap)
200 kaz 1.1
201 kaz 1.42 (defun mapping-convert-old-style-in (raw-filemap)
202     "Converts old-style Meta-CVS file mapping to a list of mapping-entry
203     structures."
204     (mapcar #'(lambda (item)
205     (when (or (not (consp item))
206     (not (and (stringp (first item))
207     (stringp (second item)))))
208     (malformed-map))
209     (make-mapping-entry :kind :file
210     :id (first item)
211     :path (second item)))
212     raw-filemap))
213    
214     (defun mapping-convert-in (raw-filemap)
215     "Converts a Meta-CVS filemap as read from a file into its internal
216     representation---a list of mapping-entry structures."
217     (mapcar #'(lambda (item)
218     (when (or (not (consp item))
219     (not (and (keywordp (first item))
220     (stringp (second item)))))
221     (malformed-map))
222     (case (first item)
223     ((:file)
224 kaz 1.43 (let ((entry (make-mapping-entry :kind :file
225     :id (second item)
226 kaz 1.44 :path (third item)
227     :raw-plist (fourth item))))
228 kaz 1.43 (when (fourth item)
229 kaz 1.44 (mapping-entry-parse-plist entry))
230 kaz 1.43 entry))
231 kaz 1.42 ((:symlink)
232     (when (not (third item))
233 kaz 1.46 (error "bad map: symlink ~a has no target."
234 kaz 1.42 (second item)))
235     (make-mapping-entry :kind :symlink
236     :id (second item)
237     :path (third item)
238 kaz 1.44 :target (fourth item)
239     :raw-plist (fifth item)))
240 kaz 1.46 (otherwise (error "bad type keyword ~s in map."
241 kaz 1.42 (first item)))))
242     raw-filemap))
243    
244     (defun mapping-convert-out (filemap)
245     "Converts the internal representation of a Meta-CVS mapping to
246     the external form that is written out to files."
247     (mapcar #'(lambda (entry)
248 kaz 1.44 (with-slots (kind id path target executable raw-plist) entry
249     (when executable
250     (setf (getf raw-plist :exec) t))
251 kaz 1.42 (case kind
252 kaz 1.44 ((:file) (list* kind id path
253     (if raw-plist (list raw-plist))))
254     ((:symlink) (list* kind id path target
255     (if raw-plist (list raw-plist))))
256 kaz 1.42 (otherwise (error "unknown mapping entry type ~s." kind)))))
257     filemap))
258    
259 kaz 1.11 (defun mapping-read (filename &key sanity-check)
260 kaz 1.42 "Reads a Meta-CVS from a file, optionally performing a check
261     for duplicate entries"
262 kaz 1.11 (let (filemap)
263 kaz 1.42 ;;
264     ;; Read the raw data, ensure that the file contains
265     ;; a Lisp object and that it's a list, or at least a cons.
266     ;;
267 kaz 1.11 (with-open-file (file filename :direction :input)
268 kaz 1.29 (setf filemap (read file nil :error))
269     (when (or (eq filemap :error)
270     (and (not (consp filemap)) (not (null filemap))))
271     (malformed-map)))
272 kaz 1.42 ;;
273     ;; Distinguish between the old-style Meta-CVS map and
274     ;; the new one. The old one is a list of lists of strings.
275     ;; The new one is a list of lists having a keyword in
276     ;; the first position.
277     ;;
278     (setf filemap (if (or (null filemap) (keywordp (first (first filemap))))
279     (mapping-convert-in filemap)
280     (mapping-convert-old-style-in filemap)))
281    
282 kaz 1.11 (if sanity-check
283 kaz 1.14 (mapping-dupe-check filemap)
284 kaz 1.11 filemap)))
285    
286     (defun mapping-write (filemap filename &key sort-map)
287 kaz 1.42 (when sort-map
288     (setf filemap (sort (copy-list filemap)
289     #'string< :key #'mapping-entry-id)))
290     (let ((raw-filemap (mapping-convert-out filemap)))
291 kaz 1.46 (handler-case
292     (with-open-file (file filename :direction :output)
293     (let ((*print-right-margin* 1))
294     (prin1 raw-filemap file)
295     (terpri file)))
296 kaz 1.47 (error (cond) (error "unable to write mapping file: ~a" cond)))))
297 kaz 1.11
298 kaz 1.1 (defun mapping-synchronize ()
299     "Synchronizes the contents of files in the sandbox, and their corresponding
300 kaz 1.10 CVS files in the Meta-CVS directory. This must be done before any CVS operation
301     such as commit or update, so that the Meta-CVS files have the correct contents
302 kaz 1.1 reflecting local changes. It must also be done after any CVS update operation,
303     to ensure that the newly incorporated changes are propagated to the sandbox"
304 kaz 1.11 (let ((filemap (mapping-read *mcvs-map-local*)))
305 kaz 1.43 (dolist (entry filemap)
306 kaz 1.1 (can-restart-here ("Continue synchronizing files.")
307 kaz 1.43 (with-slots (kind id path target executable) entry
308 kaz 1.42 (when (real-path-exists path)
309     (case kind
310     ((:file)
311     (let ((left id) (right (abstract-to-real-path path)))
312 kaz 1.43 (case (synchronize-files left right executable)
313 kaz 1.42 ((:left)
314     (chatter-info "sync ~a -> ~a~%" left right))
315     ((:right)
316     (chatter-info "sync ~a <- ~a~%" left right))
317     ((:same))
318     ((:dir)
319 kaz 1.46 (error "cannot sync, either ~a or ~a is a directory."
320 kaz 1.42 left right))
321     ((nil)
322 kaz 1.46 (error "cannot sync, neither ~a nor ~a exists."
323 kaz 1.42 left right)))))
324     ((:symlink)
325     (let* ((symlink (abstract-to-real-path path))
326     (linkdata (no-existence-error (readlink symlink))))
327     (when (or (not linkdata)
328     (not (string= linkdata target)))
329     (no-existence-error (unlink symlink))
330     (ensure-directories-exist symlink)
331     (symlink target symlink)
332     (chatter-info "linking: ~a -> ~a~%"
333     symlink target)))))))))))
334 kaz 1.1
335 kaz 1.17 (defun mapping-difference (old-mapping new-mapping)
336     "Compute the difference between two mappings. Returns three values:
337 kaz 1.22 - a mapping containing only elements added by new-mapping;
338     - a mapping containing only elements removed by new-mapping; and
339     - a list of moved items, which contains pairs of elements from both, whose
340     object name matches, but path differs."
341 kaz 1.39 (multiple-value-bind (moved-pairs added-items removed-items)
342 kaz 1.38 (intersection-difference
343     new-mapping old-mapping
344 kaz 1.42 :key #'mapping-entry-id :test #'equal
345 kaz 1.38 :combine #'(lambda (new old)
346 kaz 1.42 (unless (string= (mapping-entry-path new)
347     (mapping-entry-path old))
348 kaz 1.39 (list old new)))
349     :squash-nil t)
350     (values added-items removed-items moved-pairs)))
351 kaz 1.17
352 kaz 1.35 (defun mapping-update (&key no-delete-removed)
353 kaz 1.1 #.(format nil
354 kaz 1.10 "Reads the Meta-CVS mapping files ~a and ~a, the local
355 kaz 1.1 mapping and repository mapping, respectively. It computes the difference
356     between them and then reorganizes the file structure of the sandbox as
357     necessary to make the mapping up to date. Then the local mapping file is
358     overwritten so it is identical to the repository one. This is necessary to
359 kaz 1.19 bring the local structure up to date after incorporating mapping changes
360     whether they came from the CVS repository, or from local operations."
361 kaz 1.1 *mcvs-map-local* *mcvs-map*)
362 kaz 1.11 (let ((old-filemap (mapping-read *mcvs-map-local*))
363 kaz 1.22 (new-filemap (mapping-read *mcvs-map* :sanity-check t))
364     rollback-remove-items rollback-restore-items)
365     (restart-case
366     (multiple-value-bind (added-items removed-items moved-pairs)
367     (mapping-difference old-filemap new-filemap)
368     ;; First remove what has to be removed. This way when we
369     ;; do sanity checks, we won't complain about clobbering things
370     ;; that are slated to disappear.
371 kaz 1.37 (dolist (item removed-items)
372 kaz 1.42 (when (real-path-exists (mapping-entry-path item))
373     (let ((real (abstract-to-real-path (mapping-entry-path item))))
374 kaz 1.37 (chatter-terse "removing ~a~%" real)
375     (unless no-delete-removed
376     (restart-case
377     (ensure-directories-gone real)
378     (ignore () :report "Ignore file removal error."))
379     (push item rollback-restore-items)))))
380 kaz 1.22
381     (dolist (pair moved-pairs)
382     (let ((old-item (first pair)))
383 kaz 1.42 (with-slots (path) old-item
384     (when (real-path-exists path)
385     (ensure-directories-gone (abstract-to-real-path path))
386     (push old-item rollback-restore-items)))))
387 kaz 1.22
388     ;; Now check sanity of adds and moves, to verify they don't
389     ;; clobber any local files.
390 kaz 1.23 (let (clobber-add-items clobber-move-pairs)
391     (dolist (item added-items)
392 kaz 1.42 (with-slots (kind id path target) item
393     (when (real-path-exists path)
394     (let* ((real-path (abstract-to-real-path path))
395     (file-info (exists real-path)))
396     (when (and file-info
397     (case kind
398     ((:file)
399     (not (same-file-p file-info (stat id))))
400     ((:symlink)
401     (not (string= (readlink real-path)
402     target)))
403     (otherwise t))
404     (not (mapping-lookup old-filemap path)))
405     (push item clobber-add-items))))))
406 kaz 1.23
407     (dolist (item moved-pairs)
408     (destructuring-bind (old-item new-item) item
409     (declare (ignore old-item))
410 kaz 1.42 (with-slots (path) new-item
411     (when (real-path-exists path)
412     (let ((file-info (exists (abstract-to-real-path path))))
413     (when (and file-info
414     (not (mapping-lookup old-filemap path)))
415     (push item clobber-move-pairs)))))))
416 kaz 1.23
417     (when (or clobber-add-items clobber-move-pairs)
418     (block nil
419     (restart-bind
420     ((print-clobbers
421     #'(lambda ()
422     (dolist (item clobber-add-items)
423 kaz 1.37 (format t "add: ~a~%"
424 kaz 1.42 (abstract-to-real-path (mapping-entry-path item))))
425 kaz 1.23 (dolist (pair clobber-move-pairs)
426 kaz 1.37 (format t "move ~a -> ~a~%"
427 kaz 1.42 (abstract-to-real-path (mapping-entry-path
428     (first pair)))
429     (abstract-to-real-path (mapping-entry-path
430     (second pair))))))
431 kaz 1.23 :report-function
432     #'(lambda (stream)
433     (write-string "Print list of adds or moves which want to overwrite."
434     stream)))
435     (do-clobber
436     #'(lambda ()
437     (return))
438     :report-function
439     #'(lambda (stream)
440     (write-string "Go ahead and overwrite the target files."
441     stream))))
442 kaz 1.46 (error "some moves or adds want to overwrite local files or directories.")))))
443 kaz 1.19
444 kaz 1.22 ;; Sanity check passed, complete moves and adds.
445     (dolist (item moved-pairs)
446     (destructuring-bind (old-item new-item) item
447 kaz 1.42 (with-slots ((old-path path) (old-id id)) old-item
448 kaz 1.43 (with-slots ((new-path path) (new-id id) kind target executable)
449     new-item
450 kaz 1.42 (let ((real-old-exists (real-path-exists old-path))
451     (real-new-exists (real-path-exists new-path)))
452     (let ((real-old (and real-old-exists
453     (abstract-to-real-path old-path)))
454     (real-new (and real-new-exists
455     (abstract-to-real-path new-path))))
456     (cond
457     ((and real-old-exists real-new-exists)
458     (chatter-terse "moving ~a -> ~a~%" real-old real-new))
459     (real-new-exists
460     (chatter-terse "moving (out-of-sandbox) -> ~a~%" real-new))
461     (real-old-exists
462     (chatter-terse "moving ~a -> (out-of-sandbox)~%" real-old)))
463    
464     (when real-new-exists
465     (no-existence-error (unlink real-new))
466     (case kind
467     ((:file)
468 kaz 1.43 (synchronize-files new-id real-new executable))
469 kaz 1.42 ((:symlink)
470     (ensure-directories-exist real-new)
471     (symlink target real-new)))
472     (push new-item rollback-remove-items))))))))
473 kaz 1.1
474 kaz 1.22 (dolist (item added-items)
475 kaz 1.43 (with-slots (kind id path target executable) item
476 kaz 1.42 (when (real-path-exists path)
477     (let ((real (abstract-to-real-path path)))
478     (can-restart-here ("Continue updating file structure.")
479     (case kind
480     ((:file)
481     (chatter-terse "adding ~a~%" real)
482 kaz 1.43 (synchronize-files id real executable))
483 kaz 1.42 ((:symlink)
484     (chatter-terse "linking ~a -> ~a~%" real target)
485     (no-existence-error (unlink real))
486     (ensure-directories-exist real)
487     (symlink target real)))
488     (push item rollback-remove-items)))))))
489 kaz 1.22 (continue ()
490     :report "Restore all restructuring done so far."
491 kaz 1.28 (chatter-debug "Restoring.~%")
492 kaz 1.22 (dolist (item rollback-remove-items)
493 kaz 1.42 (let ((real (abstract-to-real-path (mapping-entry-path item))))
494 kaz 1.37 (chatter-terse "removing ~a~%" real)
495     (ensure-directories-gone real)))
496 kaz 1.22 (dolist (item rollback-restore-items)
497 kaz 1.43 (with-slots (kind path id target executable) item
498 kaz 1.42 (let ((real (abstract-to-real-path path)))
499     (chatter-terse "restoring ~a~%" real)
500     (case kind
501     ((:file)
502 kaz 1.43 (synchronize-files id real executable))
503 kaz 1.42 ((:symlink)
504     (ensure-directories-exist real)
505     (symlink target real))))))
506 kaz 1.24 (return-from mapping-update nil)))
507 kaz 1.1
508 kaz 1.24 (mapping-write new-filemap *mcvs-map-local*))
509     t)
510 kaz 1.36
511     (defun mapping-removed-files (filemap)
512     (let ((to-be-removed ())
513     (f-hash (make-hash-table :test #'equal)))
514     (dolist (entry filemap)
515 kaz 1.42 (setf (gethash (mapping-entry-id entry) f-hash) entry))
516 kaz 1.36 (for-each-file-info (fi *mcvs-dir*)
517     (let ((base (basename (file-name fi))))
518     (multiple-value-bind (suffix name) (suffix base)
519     (declare (ignore suffix))
520     (when (and (= (length name) 34)
521     (string= (subseq name 0 2) "F-")
522     (not (gethash (file-name fi) f-hash)))
523     (push (file-name fi) to-be-removed)))))
524     to-be-removed))
525 kaz 1.37
526     (defun displaced-path-read ()
527     (ignore-errors (with-open-file (file *mcvs-displaced* :direction :input)
528     (read file))))
529    
530     (defun displaced-path-write (path)
531     (with-open-file (file *mcvs-displaced* :direction :output)
532     (prin1 path file)
533     (terpri file)))

  ViewVC Help
Powered by ViewVC 1.1.5