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

Diff of /meta-cvs/F-FFF16CA4956A36F19290AC9E1EBAFFD8

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

revision 1.37 by kaz, Sat Jul 6 17:15:02 2002 UTC revision 1.38 by kaz, Mon Jul 8 05:11:10 2002 UTC
# Line 7  Line 7 
7  (require "sync")  (require "sync")
8  (require "chatter")  (require "chatter")
9  (require "restart")  (require "restart")
10    (require "seqfuncs")
11  (provide "mapping")  (provide "mapping")
12    
13  (eval-when (:compile-toplevel :load-toplevel :execute)  (eval-when (:compile-toplevel :load-toplevel :execute)
# Line 239  to ensure that the newly incorporated ch Line 240  to ensure that the newly incorporated ch
240  - a mapping containing only elements removed by new-mapping; and  - a mapping containing only elements removed by new-mapping; and
241  - a list of moved items, which contains pairs of elements from both, whose  - a list of moved items, which contains pairs of elements from both, whose
242    object name matches, but path differs."    object name matches, but path differs."
243    (let (added-items removed-items moved-pairs)    (multiple-value-bind (matching-pairs added-items removed-items)
244      (setf old-mapping (sort (copy-list old-mapping) #'string< :key #'first))                         (intersection-difference
245      (setf new-mapping (sort (copy-list new-mapping) #'string< :key #'first))                           new-mapping old-mapping
246                             :key #'first :test #'equal
247      (loop                           :combine #'(lambda (new old)
248        (let* ((old-item (first old-mapping))                                        (unless (string= (second new)
249               (new-item (first new-mapping)))                                                         (second old))
250          (cond                                          (list old new))))
251            ((and (endp old-item) (endp new-item)) (return))      (let ((moved-pairs (remove-if #'null matching-pairs)))
252            ((string< (first old-item) (first new-item))        (values added-items removed-items moved-pairs))))
              (pop old-mapping)  
              (push old-item removed-items))  
           ((string= (first old-item) (first new-item))  
              (pop old-mapping)  
              (pop new-mapping)  
              (when (not (path-equal (second old-item) (second new-item)))  
                (push (list old-item new-item) moved-pairs)))  
           (t  
              (pop new-mapping)  
              (push new-item added-items)))))  
     (values added-items removed-items moved-pairs)))  
253    
254  (defun mapping-update (&key no-delete-removed)  (defun mapping-update (&key no-delete-removed)
255  #.(format nil  #.(format nil

Legend:
Removed from v.1.37  
changed lines
  Added in v.1.38

  ViewVC Help
Powered by ViewVC 1.1.5