ViewVC logotype

Diff of /meta-cvs/F-73871F8E513E48E095DE0FEFB1CFC48B

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.22 by kaz, Sat Jul 6 17:15:02 2002 UTC revision 1.23 by kaz, Sat Aug 31 20:53:13 2002 UTC
# Line 30  Line 30 
30            (nreverse expanded-paths)            (nreverse expanded-paths)
32            (dolist (full-name expanded-paths)            (dolist (full-name expanded-paths)
33              (let ((abs-name (real-to-abstract-path full-name)))              (let ((abs-name (real-to-abstract-path full-name))
34                      (file-info (stat full-name)))
35                (can-restart-here ("Continue adding files.")                (can-restart-here ("Continue adding files.")
36                  (cond                  (cond
37                    ((path-prefix-equal *mcvs-dir* full-name)                    ((path-prefix-equal *mcvs-dir* full-name)
# Line 38  Line 39 
39                             full-name))                             full-name))
40                    ((mapping-lookup filemap abs-name)                    ((mapping-lookup filemap abs-name)
41                      (chatter-info "mcvs-add: ~a already added.~%" full-name))                      (chatter-info "mcvs-add: ~a already added.~%" full-name))
42                    ((directory-p full-name)                    ((directory-p file-info)
43                      (when (not recursivep)                      (when (not recursivep)
44                        (error "mcvs-add: ~a, is a directory, use -R to add." full-name)))                        (error "mcvs-add: ~a, is a directory, use -R to add." full-name)))
45                    ((not (regular-p full-name))                    ((regular-p file-info)
                     (error "mcvs-add: cannot add ~a, not regular file."  
46                      (let* ((suffix (suffix full-name))                      (let* ((suffix (suffix full-name))
47                             (f-file (mapping-generate-name suffix)))                             (f-file (mapping-generate-id :suffix suffix)))
48                        (when suffix                        (when suffix
49                              (setf new-types (adjoin (list suffix :default)                              (setf new-types (adjoin (list suffix :default)
50                                                      new-types :test #'equal)))                                                      new-types :test #'equal)))
51                        (push (list f-file abs-name) new-map-entries)))))))))                        (push (make-mapping-entry :kind :file
52                                                    :id f-file
53                                                    :path abs-name)
54                                new-map-entries)))
55                      ((symlink-p file-info)
56                        (let ((id (mapping-generate-id :no-dir t :prefix "S-")))
57                          (push (make-mapping-entry :kind :symlink
58                                                    :id id
59                                                    :path abs-name
60                                                    :target (readlink full-name))
61                                new-map-entries)))
62                      (t
63                        (error "mcvs-add: cannot add ~a, not regular file or symlink."
64                               full-name))))))))
66        (setf new-types (set-difference        (setf new-types (set-difference
67                          new-types types :key #'first :test #'string=))                          new-types types :key #'first :test #'string=))
# Line 64  Line 75 
76        (when new-map-entries        (when new-map-entries
77          (dolist (map-entry new-map-entries)          (dolist (map-entry new-map-entries)
78            (destructuring-bind (f-file path-name) map-entry            (with-slots (kind id path) map-entry
79              (push map-entry filemap)              (push map-entry filemap)
80              (let ((real-name (abstract-to-real-path path-name)))              (let ((real-name (abstract-to-real-path path)))
81                (chatter-info "mapping ~a <- ~a~%" f-file real-name)                (chatter-info "mapping ~a <- ~a~%" id real-name)
82                (link real-name f-file))))                (if (eq kind :file)
83                    (link real-name id)))))
85          (mapping-write filemap *mcvs-map* :sort-map t)          (mapping-write filemap *mcvs-map* :sort-map t)
# Line 78  Line 90 
90          (chatter-debug "Synchronizing.~%")          (chatter-debug "Synchronizing.~%")
91          (mapping-synchronize)          (mapping-synchronize)
93            (setf new-map-entries (mapping-extract-kind new-map-entries :file))
95          (let ((add-commands (types-make-cvs-adds types new-map-entries)))          (let ((add-commands (types-make-cvs-adds types new-map-entries)))
96            (loop            (loop
97              (restart-case              (restart-case
# Line 102  Line 116 
116                  (mapping-write saved-filemap *mcvs-map*)                  (mapping-write saved-filemap *mcvs-map*)
117                  (ignore-errors                  (ignore-errors
118                    (dolist (entry new-map-entries)                    (dolist (entry new-map-entries)
119                      (unlink (first entry))))                      (unlink (mapping-entry-id entry))))
120                  (return)))))                  (return)))))
122          (chatter-debug "Updating file structure.~%")          (chatter-debug "Updating file structure.~%")

Removed from v.1.22  
changed lines
  Added in v.1.23

  ViewVC Help
Powered by ViewVC 1.1.5