/[cmucl]/src/code/filesys.lisp
ViewVC logotype

Diff of /src/code/filesys.lisp

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

revision 1.99 by rtoy, Sun Dec 4 15:49:35 2005 UTC revision 1.100 by rtoy, Tue Mar 14 15:19:10 2006 UTC
# Line 97  Line 97 
97               :offset (1- end)))               :offset (1- end)))
98      (shrink-vector result dst)))      (shrink-vector result dst)))
99    
100  (defvar *ignore-wildcards* nil)  (defvar *ignore-wildcards* nil
101      "If non-NIL, Unix shell-style wildcards are ignored when parsing
102      pathname namestrings.  They are also ignored when computing
103      namestrings for pathname objects.  Thus, *, ?, etc. are not
104      wildcards when parsing a namestring, and are not escaped when
105      printing pathnames.")
106    
107  (defun maybe-make-pattern (namestr start end)  (defun maybe-make-pattern (namestr start end)
108    (declare (type simple-base-string namestr)    (declare (type simple-base-string namestr)
# Line 399  Line 404 
404       ;; cause the component not to appear in the namestring."       ;; cause the component not to appear in the namestring."
405       "")       "")
406      (simple-string      (simple-string
407       (let* ((srclen (length thing))       (if *ignore-wildcards*
408              (dstlen srclen))           thing
409         (dotimes (i srclen)           (let* ((srclen (length thing))
410           (case (schar thing i)                  (dstlen srclen))
411             ((#\* #\? #\[)             (dotimes (i srclen)
412              (incf dstlen))))               (case (schar thing i)
        (let ((result (make-string dstlen))  
              (dst 0))  
          (dotimes (src srclen)  
            (let ((char (schar thing src)))  
              (case char  
413                 ((#\* #\? #\[)                 ((#\* #\? #\[)
414                  (setf (schar result dst) #\\)                  (incf dstlen))))
415                  (incf dst)))             (let ((result (make-string dstlen))
416               (setf (schar result dst) char)                   (dst 0))
417               (incf dst)))               (dotimes (src srclen)
418           result)))                 (let ((char (schar thing src)))
419                     (case char
420                       ((#\* #\? #\[)
421                        (setf (schar result dst) #\\)
422                        (incf dst)))
423                     (setf (schar result dst) char)
424                     (incf dst)))
425                 result))))
426      (pattern      (pattern
427       (collect ((strings))       (collect ((strings))
428         (dolist (piece (pattern-pieces thing))         (dolist (piece (pattern-pieces thing))

Legend:
Removed from v.1.99  
changed lines
  Added in v.1.100

  ViewVC Help
Powered by ViewVC 1.1.5