From 172f99d7bc00ff0422b6bc4eedc481c3dae9a5b8 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Tue, 14 Mar 2006 15:19:10 +0000 Subject: [PATCH] o Add docstring for *IGNORE-WILDCARDS*. o Make UNPARSE-UNIX-PIECE honor *IGNORE-WILDCARDS*. Requested by Lynn Quam so namestrings can be given to run-program and friends without pathname wildcards escaped. --- code/filesys.lisp | 43 +++++++++++++++++++++++++------------------ 1 file changed, 25 insertions(+), 18 deletions(-) diff --git a/code/filesys.lisp b/code/filesys.lisp index be56f1e3e..5da81b0f1 100644 --- a/code/filesys.lisp +++ b/code/filesys.lisp @@ -6,7 +6,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.99 2005/12/04 15:49:35 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.100 2006/03/14 15:19:10 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -97,7 +97,12 @@ :offset (1- end))) (shrink-vector result dst))) -(defvar *ignore-wildcards* nil) +(defvar *ignore-wildcards* nil + "If non-NIL, Unix shell-style wildcards are ignored when parsing + pathname namestrings. They are also ignored when computing + namestrings for pathname objects. Thus, *, ?, etc. are not + wildcards when parsing a namestring, and are not escaped when + printing pathnames.") (defun maybe-make-pattern (namestr start end) (declare (type simple-base-string namestr) @@ -399,23 +404,25 @@ ;; cause the component not to appear in the namestring." "") (simple-string - (let* ((srclen (length thing)) - (dstlen srclen)) - (dotimes (i srclen) - (case (schar thing i) - ((#\* #\? #\[) - (incf dstlen)))) - (let ((result (make-string dstlen)) - (dst 0)) - (dotimes (src srclen) - (let ((char (schar thing src))) - (case char + (if *ignore-wildcards* + thing + (let* ((srclen (length thing)) + (dstlen srclen)) + (dotimes (i srclen) + (case (schar thing i) ((#\* #\? #\[) - (setf (schar result dst) #\\) - (incf dst))) - (setf (schar result dst) char) - (incf dst))) - result))) + (incf dstlen)))) + (let ((result (make-string dstlen)) + (dst 0)) + (dotimes (src srclen) + (let ((char (schar thing src))) + (case char + ((#\* #\? #\[) + (setf (schar result dst) #\\) + (incf dst))) + (setf (schar result dst) char) + (incf dst))) + result)))) (pattern (collect ((strings)) (dolist (piece (pattern-pieces thing)) -- GitLab