/[meta-cvs]/meta-cvs/F-58F396B2ADF675136DD8552C6FFD5310.lisp
ViewVC logotype

Diff of /meta-cvs/F-58F396B2ADF675136DD8552C6FFD5310.lisp

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

revision 1.16 by kaz, Tue Feb 18 07:00:41 2003 UTC revision 1.17 by kaz, Fri Jan 9 05:18:14 2004 UTC
# Line 35  and one of branch tags." Line 35  and one of branch tags."
35                (t (setf state :final))))                (t (setf state :final))))
36            ((:final)))))))            ((:final)))))))
37    
38  (defun parse-sticky (sticky)  (defun parse-dir-sticky (sticky)
39    (if (string= "" sticky)    (if (string= "" sticky)
40      nil      nil
41      (let ((first-char (char sticky 0))      (let ((first-char (char sticky 0))
# Line 43  and one of branch tags." Line 43  and one of branch tags."
43        (case first-char        (case first-char
44          (#\T (list :branch rest-string))          (#\T (list :branch rest-string))
45          (#\D (list :date rest-string))          (#\D (list :date rest-string))
46          (#\N (list :tag rest-string))          (#\N (list :version rest-string))
47          (otherwise (list :other sticky))))))          (otherwise (list :other sticky))))))
48    
49    (defun parse-entries-sticky (sticky)
50      (if (string= "" sticky)
51        nil
52        (let ((first-char (char sticky 0))
53              (rest-string (substring sticky 1)))
54          (case first-char
55            (#\T (list :tag rest-string))
56            (#\D (list :date rest-string))
57            (otherwise (list :other sticky))))))
58    
59    (defun equal-sticky (left right)
60      (destructuring-bind (type-left text-left) left
61        (destructuring-bind (type-right text-right) right
62          (and (equal text-left text-right)
63               (or (eq type-left type-right)
64                   (and (eq type-left :tag)
65                        (member type-right '(:version :branch)))
66                   (and (eq type-right :tag)
67                        (member type-left '(:version :branch))))))))
68    
69  (defun read-cvs-entries ()  (defun read-cvs-entries ()
70    (with-open-file (f "CVS/Entries" :direction :input :if-does-not-exist nil)    (with-open-file (f "CVS/Entries" :direction :input :if-does-not-exist nil)
71      (when (not f)      (when (not f)
# Line 60  and one of branch tags." Line 80  and one of branch tags."
80                      ((string= "D" (first split)) :directory)                      ((string= "D" (first split)) :directory)
81                      (t :other)))                      (t :other)))
82              (when (sixth split)              (when (sixth split)
83                (setf (sixth split) (parse-sticky (sixth split))))                (setf (sixth split) (parse-entries-sticky (sixth split))))
84              (push split entries))))))              (push split entries))))))
85    
86  (defun same-tag-check (entries &optional directory-sticky-tag)  (defun same-tag-check (entries &optional directory-sticky-tag)
# Line 68  and one of branch tags." Line 88  and one of branch tags."
88                                       entries                                       entries
89                                       :key #'first)))                                       :key #'first)))
90      (let ((first-tag (or directory-sticky-tag (sixth (first file-entries)))))      (let ((first-tag (or directory-sticky-tag (sixth (first file-entries)))))
91        (not (find-if-not #'(lambda (x) (equal x first-tag))        (not (find-if-not #'(lambda (x) (equal-sticky x first-tag))
92                          file-entries :key #'sixth)))))                          file-entries :key #'sixth)))))
93    
94  (defun what-are-we-sticky-to ()  (defun what-are-we-sticky-to ()
# Line 76  and one of branch tags." Line 96  and one of branch tags."
96      (if f      (if f
97        (let ((contents (read-line f nil)))        (let ((contents (read-line f nil)))
98          (if contents          (if contents
99            (parse-sticky contents))))))            (parse-dir-sticky contents))))))
100    
101  (defun what-module-is-this ()  (defun what-module-is-this ()
102    (with-open-file (f "CVS/Repository" :direction :input)    (with-open-file (f "CVS/Repository" :direction :input)
# Line 208  and one of branch tags." Line 228  and one of branch tags."
228                               symbols :key #'first :test #'string=)                               symbols :key #'first :test #'string=)
229                       "managed branch"                       "managed branch"
230                       "non-managed branch"))                       "non-managed branch"))
231                  ((:tag)                  ((:version)
232                     "version tag")                     "version tag")
233                  ((:date)                  ((:date)
234                     "sticky date")                     "sticky date")

Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17

  ViewVC Help
Powered by ViewVC 1.1.5