Skip to content
Snippets Groups Projects
Commit 0c046afa authored by ram's avatar ram
Browse files

Added support for parsing :WILD and :WILD-INFERIORS. Fixed :WILD-INFERIORS

unparsing.  Un-commented-out USER-HOMEDIR-PATHNAME.  Un-generalized
split-at-slashes, since logical pathname parsing no longer uses it.
parent 4a1becbc
No related branches found
No related tags found
No related merge requests found
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.30 1993/07/15 17:59:50 phg Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.31 1993/07/31 01:07:13 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -160,9 +160,13 @@ ...@@ -160,9 +160,13 @@
(flush-pending-regulars))) (flush-pending-regulars)))
(cond ((null (pattern)) (cond ((null (pattern))
"") "")
((and (null (cdr (pattern))) ((null (cdr (pattern)))
(simple-string-p (car (pattern)))) (let ((piece (first (pattern))))
(car (pattern))) (typecase piece
((member :multi-char-wild) :wild)
(simple-string piece)
(t
(make-pattern (pattern))))))
(t (t
(make-pattern (pattern))))))) (make-pattern (pattern)))))))
...@@ -205,23 +209,24 @@ ...@@ -205,23 +209,24 @@
nil nil
version))))) version)))))
(defun split-at-slashes (namestr start end &optional (char #\/)) ;;; Take a string and return a list of cons cells that mark the char
"Take a string and return a list of cons cells that mark the char ;;; separated subseq. The first value t if absolute directories location.
separated subseq. The first value t if absolute directories location." ;;;
(declare (type simple-base-string namestr) (defun split-at-slashes (namestr start end)
(declare (type simple-base-string namestr)
(type index start end)) (type index start end))
(let ((absolute (and (/= start end) (let ((absolute (and (/= start end)
(char= (schar namestr start) char)))) (char= (schar namestr start) #\/))))
(when absolute (when absolute
(incf start)) (incf start))
;; Next, split the remainder into ; separated chunks. ;; Next, split the remainder into slash seperated chunks.
(collect ((pieces)) (collect ((pieces))
(loop (loop
(let ((char-pos (position char namestr :start start :end end))) (let ((slash (position #\/ namestr :start start :end end)))
(pieces (cons start (or char-pos end))) (pieces (cons start (or slash end)))
(unless char-pos (unless slash
(return)) (return))
(setf start (1+ char-pos)))) (setf start (1+ slash))))
(values absolute (pieces))))) (values absolute (pieces)))))
(defun maybe-extract-search-list (namestr start end) (defun maybe-extract-search-list (namestr start end)
...@@ -276,13 +281,16 @@ ...@@ -276,13 +281,16 @@
(let ((piece-start (car piece)) (let ((piece-start (car piece))
(piece-end (cdr piece))) (piece-end (cdr piece)))
(unless (= piece-start piece-end) (unless (= piece-start piece-end)
(let ((dir (maybe-make-pattern namestr (cond ((string= namestr ".." :start1 piece-start
piece-start :end1 piece-end)
piece-end))) (dirs :up))
(if (and (simple-string-p dir) ((string= namestr "**" :start1 piece-start
(string= dir "..")) :end1 piece-end)
(dirs :up) (dirs :wild-inferiors))
(dirs dir)))))) (t
(dirs (maybe-make-pattern namestr
piece-start
piece-end)))))))
(cond (absolute (cond (absolute
(cons :absolute (dirs))) (cons :absolute (dirs)))
((dirs) ((dirs)
...@@ -300,10 +308,7 @@ ...@@ -300,10 +308,7 @@
(defun unparse-unix-piece (thing) (defun unparse-unix-piece (thing)
(etypecase thing (etypecase thing
(keyword ((member :wild) "*")
(cond ((eq thing ':wild) "*")
((eq thing ':wild-inferiors) "**")
(t (error "Invalid keyword piece: ~S~%" thing))))
(simple-string (simple-string
(let* ((srclen (length thing)) (let* ((srclen (length thing))
(dstlen srclen)) (dstlen srclen))
...@@ -329,15 +334,11 @@ ...@@ -329,15 +334,11 @@
(simple-string (simple-string
(strings piece)) (strings piece))
(symbol (symbol
(case piece (ecase piece
(:wild
(strings "*"))
(:multi-char-wild (:multi-char-wild
(strings "*")) (strings "*"))
(:single-char-wild (:single-char-wild
(strings "?")) (strings "?"))))
(t
(error "Invalid pattern piece: ~S" piece))))
(cons (cons
(case (car piece) (case (car piece)
(:character-set (:character-set
...@@ -370,6 +371,8 @@ ...@@ -370,6 +371,8 @@
(pieces "../")) (pieces "../"))
((member :back) ((member :back)
(error ":BACK cannot be represented in namestrings.")) (error ":BACK cannot be represented in namestrings."))
((member :wild-inferiors)
(pieces "**/"))
((or simple-string pattern) ((or simple-string pattern)
(pieces (unparse-unix-piece dir)) (pieces (unparse-unix-piece dir))
(pieces "/")) (pieces "/"))
...@@ -717,13 +720,11 @@ ...@@ -717,13 +720,11 @@
;;; ;;;
;;; Return Home:, which is set up for us at initialization time. ;;; Return Home:, which is set up for us at initialization time.
;;; ;;;
#|
(defun user-homedir-pathname (&optional host) (defun user-homedir-pathname (&optional host)
"Returns the home directory of the logged in user as a pathname. "Returns the home directory of the logged in user as a pathname.
This is obtained from the logical name \"home:\"." This is obtained from the logical name \"home:\"."
(declare (ignore host)) (declare (ignore host))
#p"home:") #p"home:")
|#
;;; File-Write-Date -- Public ;;; File-Write-Date -- Public
;;; ;;;
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment