source: branches/working-0711/ccl/lib/pathnames.lisp @ 8705

Last change on this file since 8705 was 8705, checked in by gb, 14 years ago

level-0/l0-io.lisp:
Ensure that blocking I/O syscalls (fd-read, fd-write) ignore
EINTR. (If syscalls aren't restartable, then interrupted
syscalls can return EINTR. If we're trying to interrupt
something via PROCESS-INTERRUPT, we want the syscall to
exit the kernel after the handler runs, so that lisp code
can notice the pending interrupt.)

lib/macros.lisp:
Try to make sure that the compille-time processing for DEFMETHOD
notes the method's lambda list as if &ALLOW-OTHER-KEYS was
specified whenever &KEY was. (It may not be that wise to
base our notion of a function's arglist on the latest method
we've seen; if this doesn't work for all cases where this branch
matters, we might just note the DEFGENERIC arglist at compile-time
and ignore the arglists of individual DEFMETHODs.)

lib/pathnames.lisp:
Add an obscure argument to DIRECTORY, default it to T. DIRECTORY
will ignore files whose names start with ".#" (which are often
broken links that Emacs uses as lockfiles). This means that people
who have real files whose names start with ".#" won't be able to
see them unless they override this option. Or they could give
them less brain-dead names ...

lisp-kernel/x86-exceptions.c:
Don't set the SA_RESTART open when installing signal handlers.
(This change was made in the trunk, but hadn't been backported
to the working-0711 branch.) The effect of the change is that
system calls (accept, read, write) that previously were
automatically restarted whenever they're interrupted now return
an "I was interrupted" error (#$EINTR). Returning from the OS
kernel (rather than restarting the syscall) means that pending
interrupts (sent via PROCESS-INTERRUPT) get handled on exit
from the syscall. (If we return from the lisp handler, we have
the option of restarting the syscall.)

None of this is hard to bootstrap, but the changes that make
syscalls interruptible require running under a recompiled
kernel, and handling the case where a "write" syscall is interrupted
requires changes to the lisp code. Do a full rebuild a time or two
and things should be fine.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 20.3 KB
Line 
1;;;-*-Mode: LISP; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   Portions copyright (C) 2001 Clozure Associates
5;;;   This file is part of OpenMCL. 
6;;;
7;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
8;;;   License , known as the LLGPL and distributed with OpenMCL as the
9;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
10;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
11;;;   conflict, the preamble takes precedence. 
12;;;
13;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
14;;;
15;;;   The LLGPL is also available online at
16;;;   http://opensource.franz.com/preamble.html
17
18;;pathnames.lisp Pathnames for Coral Common LISP
19(in-package "CCL")
20
21(eval-when (eval compile)
22  (require 'level-2)
23  (require 'backquote)
24)
25;(defconstant $accessDenied -5000) ; put this with other errnos
26(defconstant $afpAccessDenied -5000) ; which name to use?
27
28
29
30;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
31;ANSI CL logical pathnames
32
33
34(defvar *pathname-translations-pathname*
35  (make-pathname :host "ccl" :type "pathname-translations"))
36
37(defun load-logical-pathname-translations (host)
38  ;(setq host (verify-logical-host-name host))
39  (when (not (%str-assoc host %logical-host-translations%))
40    (setf (logical-pathname-translations host)
41          (with-open-file (file (merge-pathnames (make-pathname :name host :defaults nil)
42                                                 *pathname-translations-pathname*)
43                                :element-type 'base-char)
44            (read file)))
45    T))
46
47(defun back-translate-pathname (path &optional hosts)
48  (let ((newpath (back-translate-pathname-1 path hosts)))
49    (cond ((equalp path newpath)
50           ;; (fcomp-standard-source path)
51           (namestring (pathname path)))
52          (t newpath))))
53
54
55(defun back-translate-pathname-1 (path &optional hosts)
56  (dolist (host %logical-host-translations%)
57    (when (or (null hosts) (member (car host) hosts :test 'string-equal))
58      (dolist (trans (cdr host))
59        (when (pathname-match-p path (cadr trans))
60          (let* (newpath)         
61            (setq newpath (translate-pathname path (cadr trans) (car trans) :reversible t))
62            (return-from back-translate-pathname-1 
63              (if  (equalp path newpath) path (back-translate-pathname-1 newpath hosts))))))))
64  path)
65
66
67
68; must be after back-translate-pathname
69(defun physical-pathname-p (path)
70  (let* ((path (pathname path))
71         (dir (pathname-directory path)))
72    (and dir
73         (or (not (logical-pathname-p path))
74             (not (null (memq (pathname-host path) '(nil :unspecific))))))))
75
76
77
78;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
79;File or directory Manipulations
80
81(defun unix-rename (old-name new-name)
82  (with-cstrs ((old old-name)
83               (new new-name))
84    (let* ((res (#_rename old new)))
85      (declare (fixnum res))
86      (if (zerop res)
87        (values t nil)
88        (values nil (%get-errno))))))
89
90(defun rename-file (file new-name &key (if-exists :error))
91  "Rename FILE to have the specified NEW-NAME. If FILE is a stream open to a
92  file, then the associated file is renamed."
93  (let* ((original (truename file))
94         (original-namestring (native-translated-namestring original))
95         (new-name (merge-pathnames new-name original))
96         (new-namestring (native-translated-namestring new-name)))
97    (unless new-namestring
98      (error "~S can't be created." new-name))
99    (unless (and (probe-file new-name)
100                 (not (if-exists if-exists new-name)))
101      (multiple-value-bind (res error)
102                           (unix-rename original-namestring
103                                        new-namestring)
104        (unless res
105          (error "Failed to rename ~A to ~A: ~A"
106                 original new-name error))
107        (when (streamp file)
108          (setf (stream-filename file)
109                (namestring (native-to-pathname new-namestring))))
110        (values new-name original (truename new-name))))))
111
112
113(defun copy-file (source-path dest-path &key (if-exists :error)
114                              (preserve-attributes nil))
115  (let* ((original (truename source-path))
116         (original-namestring (native-translated-namestring original))
117         (new-name (merge-pathnames dest-path original))
118         (new-namestring (native-translated-namestring new-name))
119         (flags (if preserve-attributes "-pf" "-f")))
120    (unless new-namestring
121      (error "~S can't be created." new-name))
122    (unless (and (probe-file new-name)
123                 (not (if-exists if-exists new-name)))
124      (let* ((proc (run-program "/bin/cp"
125                                `(,flags ,original-namestring ,new-namestring)
126                                :wait t))
127             (exit-code (external-process-%exit-code proc)))
128        (unless (zerop exit-code)
129          (error "Error copying ~s to ~s: ~a"
130                 source-path dest-path (%strerror exit-code)))
131        (values new-name original (truename new-name))))))
132
133(defun recursive-copy-directory (source-path dest-path &key test (if-exists :error))
134  ;; TODO: Support :if-exists :supersede to blow away any files not in source dir
135  (setq if-exists (require-type if-exists '(member :overwrite :error)))
136  (setq dest-path (ensure-directory-pathname dest-path))
137  (when (eq if-exists :error)
138    (when (probe-file dest-path)
139      (if-exists if-exists dest-path))
140    ;; Skip the probe-file in recursive calls, already know ok.
141    (setq if-exists :overwrite))
142  (let* ((source-dir (ensure-directory-pathname source-path))
143         (pattern (make-pathname :name :wild :type :wild :defaults source-dir))
144         (source-files (directory pattern :test test :directories t :files t)))
145    (ensure-directories-exist dest-path)
146    (dolist (f source-files)
147      (when (or (null test) (funcall test f))
148        (if (directory-pathname-p f)
149            (let ((dest-file (make-pathname :name (first (last (pathname-directory f)))
150                                            :defaults dest-path)))
151              (recursive-copy-directory f dest-file :test test :if-exists if-exists))
152            (let* ((dest-file (make-pathname :name (pathname-name f)
153                                             :type (pathname-type f)
154                                             :defaults dest-path)))
155              (copy-file f dest-file :if-exists :supersede :preserve-attributes t)))))))
156
157;;; use with caution!
158;;; blows away a directory and all its contents
159(defun recursive-delete-directory (path &key (if-does-not-exist :error))
160  (setq path (ensure-directory-pathname path))
161  (setq if-does-not-exist (require-type if-does-not-exist '(member :error nil)))
162  (when (eq if-does-not-exist :error)
163    (unless (probe-file path)
164      (if-does-not-exist if-does-not-exist path)))
165  (when (probe-file path)
166      (if (directoryp path)
167          ;; it's a directory: blow it away
168          (let* ((pattern (make-pathname :name :wild :type :wild :defaults path))
169                 (files (directory pattern :directories nil :files t))
170                 (subdirs (directory pattern :directories t :files nil))
171                 (target-pathname (native-translated-namestring path)))
172            (dolist (f files)
173              (delete-file f))
174            (dolist (d subdirs)
175              (recursive-delete-directory d :if-does-not-exist if-does-not-exist))
176            (%rmdir target-pathname))
177          ;; it's not a directory: for safety's sake, signal an error
178          (error "Pathname '~A' is not a directory" path))))
179
180;;; It's not clear that we can support anything stronger than
181;;; "advisory" ("you pretend the file's locked & I will too") file
182;;; locking under Darwin.
183
184
185
186
187(defun create-directory (path &key (mode #o777))
188  (let* ((pathname (translate-logical-pathname (merge-pathnames path)))
189         (created-p nil)
190         (parent-dirs (let* ((pd (pathname-directory pathname)))
191                        (if (eq (car pd) :relative)
192                          (pathname-directory (merge-pathnames
193                                               pathname
194                                               (mac-default-directory)))
195                          pd)))
196         (nparents (length parent-dirs)))
197    (when (wild-pathname-p pathname)
198      (error 'file-error :error-type "Inappropriate use of wild pathname ~s"
199             :pathname pathname))
200    (do* ((i 1 (1+ i)))
201         ((> i nparents) (values pathname created-p))
202      (declare (fixnum i))
203      (let* ((parent (make-pathname
204                      :name :unspecific
205                      :type :unspecific
206                      :host (pathname-host pathname)
207                      :device (pathname-device pathname)
208                      :directory (subseq parent-dirs 0 i)))
209             (parent-name (native-translated-namestring parent))
210             (parent-kind (%unix-file-kind parent-name)))
211
212        (if parent-kind
213          (unless (eq parent-kind :directory)
214            (error 'simple-file-error
215                   :error-type "Can't create directory ~s, since file ~a exists and is not a directory"
216                   :pathname pathname
217                   :format-arguments (list parent-name)))
218          (let* ((result (%mkdir parent-name mode)))
219            (declare (fixnum result))
220            (if (< result 0)
221              (signal-file-error result parent-name)
222              (setq created-p t))))))))
223
224
225(defun ensure-directories-exist (pathspec &key verbose (mode #o777))
226  "Test whether the directories containing the specified file
227  actually exist, and attempt to create them if they do not.
228  The MODE argument is an extension to control the Unix permission
229  bits.  Portable programs should avoid using the :MODE keyword
230  argument."
231  (let* ((pathname (make-directory-pathname :directory (pathname-directory (translate-logical-pathname (merge-pathnames pathspec)))))
232         (created-p nil))
233    (when (wild-pathname-p pathname)
234      (error 'file-error
235             :error-type "Inappropriate use of wild pathname ~s"
236             :pathname pathname))
237    (let ((dir (pathname-directory pathname)))
238      (if (eq (car dir) :relative)
239        (setq dir (pathname-directory (merge-pathnames
240                                       pathname
241                                       (mac-default-directory)))))
242      (loop for i from 1 upto (length dir)
243            do (let ((newpath (make-pathname
244                               :name :unspecific
245                               :type :unspecific
246                               :host (pathname-host pathname)
247                               :device (pathname-device pathname)
248                               :directory (subseq dir 0 i))))
249                 (unless (probe-file newpath)
250                   (let ((namestring (native-translated-namestring newpath)))
251                     (when verbose
252                       (format *standard-output* "~&Creating directory: ~A~%"
253                               namestring))
254                     (%mkdir namestring mode)
255                     (unless (probe-file newpath)
256                       (error 'file-error
257                              :pathname namestring
258                              :error-type "Can't create directory ~S."))
259                     (setf created-p t)))))
260      (values pathspec created-p))))
261
262(defun dirpath-to-filepath (path)
263  (setq path (translate-logical-pathname (merge-pathnames path)))
264  (let* ((dir (pathname-directory path))
265         (super (butlast dir))
266         (name (car (last dir))))
267    (when (eq name :up)
268      (setq dir (remove-up (copy-list dir)))
269      (setq super (butlast dir))
270      (setq name (car (last dir))))
271    (when (null super)
272      (signal-file-error $xnocreate path))
273    (setq path (make-pathname :directory super :name name :defaults nil))))
274
275(defun filepath-to-dirpath (path)
276  (let* ((dir (pathname-directory path))
277         (rest (file-namestring path)))
278    (make-pathname :directory (append dir (list rest)) :defaults nil)))
279 
280
281
282;Takes a pathname, returns the truename of the directory if the pathname
283;names a directory, NIL if it names an ordinary file, error otherwise.
284;E.g. (directoryp "ccl;:foo:baz") might return #P"hd:mumble:foo:baz:" if baz
285;is a dir. - should we doc this - its exported?
286(defun directoryp (path)
287  (let* ((native (native-translated-namestring path))
288         (realpath (%realpath native)))
289    (if realpath (eq (%unix-file-kind realpath) :directory))))
290         
291
292;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
293;Wildcards
294
295
296
297 
298;-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_-_
299;Directory Traversing
300
301(defmacro with-open-dir ((dirent dir) &body body)
302  `(let ((,dirent (%open-dir ,dir)))
303     (when ,dirent
304       (unwind-protect
305           (progn ,@body)
306         (close-dir ,dirent)))))
307
308(defun directory (path &key (directories nil) ;; include subdirectories
309                            (files t)         ;; include files
310                            (all t)           ;; include Unix dot files (other than dot and dot dot)
311                            (directory-pathnames t) ;; return directories as directory-pathname-p's.
312                            (include-emacs-lockfiles nil) ;; inculde .#foo
313                            test              ;; Only return pathnames matching test
314                            (follow-links t)) ;; return truename's of matching files.
315  "Return a list of PATHNAMEs, each the TRUENAME of a file that matched the
316   given pathname. Note that the interaction between this ANSI-specified
317   TRUENAMEing and the semantics of the Unix filesystem (symbolic links..)
318   means this function can sometimes return files which don't have the same
319   directory as PATHNAME."
320  (let* ((keys (list :directories directories ;list defaulted key values
321                     :files files
322                     :all all
323                     :directory-pathnames directory-pathnames
324                     :test test
325                     :include-emacs-lockfiles include-emacs-lockfiles
326                     :follow-links follow-links))
327         (path (full-pathname (merge-pathnames path) :no-error nil))
328         (dir (directory-namestring path)))
329    (declare (dynamic-extent keys))
330    (if (null (pathname-directory path))
331      (setq dir (directory-namestring (setq path
332                                            (merge-pathnames path
333                                                             (mac-default-directory))))))
334    (assert (eq (car (pathname-directory path)) :absolute) ()
335            "full-pathname returned relative path ~s??" path)
336    ;; return sorted in alphabetical order, target-Xload-level-0 depends
337    ;; on this.
338    (nreverse
339     (delete-duplicates (%directory "/" dir path '(:absolute) keys) :test #'equal))))
340
341(defun %directory (dir rest path so-far keys)
342  (multiple-value-bind (sub-dir wild rest) (%split-dir rest)
343    (%some-specific dir sub-dir wild rest path so-far keys)))
344
345(defun %some-specific (dir sub-dir wild rest path so-far keys)
346  (let* ((start 1)
347         (end (length sub-dir))
348         (full-dir (if (eq start end) dir (%str-cat dir (%substr sub-dir start end)))))
349    (while (neq start end)
350      (let ((pos (position #\/ sub-dir :start start :end end)))
351        (push (%path-std-quotes (%substr sub-dir start pos) nil "/:;*") so-far)
352        (setq start (%i+ 1 pos))))
353    (cond ((null wild)
354           (%files-in-directory full-dir path so-far keys))
355          ((string= wild "**")
356           (%all-directories full-dir rest path so-far keys))
357          (t (%one-wild full-dir wild rest path so-far keys)))))
358
359; for a * or *x*y
360(defun %one-wild (dir wild rest path so-far keys)
361  (let ((result ()) (all (getf keys :all)) name subdir)
362    (with-open-dir (dirent dir)
363      (while (setq name (%read-dir dirent))
364        (when (and (or all (neq (%schar name 0) #\.))
365                   (not (string= name "."))
366                   (not (string= name ".."))
367                   (%path-pstr*= wild name)
368                   (eq (%unix-file-kind (setq subdir (%str-cat dir name)) t) :directory))
369          (let ((so-far (cons (%path-std-quotes name nil "/;:*") so-far)))
370            (declare (dynamic-extent so-far))
371            (setq result
372                  (nconc (%directory (%str-cat subdir "/") rest path so-far keys) result))))))
373    result))
374
375(defun %files-in-directory (dir path so-far keys)
376  (let ((name (pathname-name path))
377        (type (pathname-type path))
378        (directories (getf keys :directories))
379        (files (getf keys :files))
380        (directory-pathnames (getf keys :directory-pathnames))
381        (test (getf keys :test))
382        (follow-links (getf keys :follow-links))
383        (all (getf keys :all))
384        (include-emacs-lockfiles (getf keys :include-emacs-lockfiles))
385        (result ())
386        sub dir-list ans)
387    (if (not (or name type))
388      (when directories
389        (setq ans (if directory-pathnames
390                    (%cons-pathname (reverse so-far) nil nil)
391                    (%cons-pathname (reverse (cdr so-far)) (car so-far) nil)))
392        (when (and ans (or (null test) (funcall test ans)))
393          (setq result (list ans))))
394      (with-open-dir (dirent dir)
395        (while (setq sub (%read-dir dirent))
396          (when (and (or all (neq (%schar sub 0) #\.))
397                     (or include-emacs-lockfiles
398                         (and (>= (length sub) 2)
399                              (not (string= sub ".#" :end1 2))))
400                     (not (string= sub "."))
401                     (not (string= sub ".."))
402                     (%file*= name type sub))
403            (setq ans
404                  (if (eq (%unix-file-kind (%str-cat dir sub) t) :directory)
405                    (when directories
406                      (let* ((std-sub (%path-std-quotes sub nil "/;:*")))
407                        (if directory-pathnames
408                          (%cons-pathname (reverse (cons std-sub so-far)) nil nil)
409                          (%cons-pathname (or dir-list (setq dir-list (reverse so-far))) std-sub nil))))
410                    (when files
411                      (multiple-value-bind (name type) (%std-name-and-type sub)
412                        (%cons-pathname (or dir-list (setq dir-list (reverse so-far))) name type)))))
413            (when (and ans (or (null test) (funcall test ans)))
414              (push (if follow-links (or (probe-file ans) ans) ans) result))))))
415    result))
416
417; now for samson:**:*c*:**: we get samson:ccl:crap:barf: twice because
418; it matches in two ways
419; 1) **=ccl *c*=crap **=barf
420; 2) **= nothing *c*=ccl **=crap:barf
421; called to match a **
422(defun %all-directories (dir rest path so-far keys)
423  (let ((do-files nil)
424        (do-dirs nil)
425        (result nil)
426        (name (pathname-name path))
427        (type (pathname-type path))
428        (all (getf keys :all))
429        (test (getf keys :test))
430        (directory-pathnames (getf keys :directory-pathnames))
431        (follow-links (getf keys :follow-links))
432        sub subfile dir-list ans)
433    ;; First process the case that the ** stands for 0 components
434    (multiple-value-bind (next-dir next-wild next-rest) (%split-dir rest)
435      (while (and next-wild ; Check for **/**/ which is the same as **/
436                  (string= next-dir "/")
437                  (string= next-wild "**"))
438        (setq rest next-rest)
439        (multiple-value-setq (next-dir next-wild next-rest) (%split-dir rest)))
440      (cond ((not (string= next-dir "/"))
441             (setq result
442                   (%some-specific dir next-dir next-wild next-rest path so-far keys)))
443            (next-wild
444             (setq result
445                   (%one-wild dir next-wild next-rest path so-far keys)))
446            ((or name type)
447             (when (getf keys :files) (setq do-files t))
448             (when (getf keys :directories) (setq do-dirs t)))
449            (t (when (getf keys :directories)
450                 (setq sub (if directory-pathnames
451                             (%cons-pathname (setq dir-list (reverse so-far)) nil nil)
452                             (%cons-pathname (reverse (cdr so-far)) (car so-far) nil)))
453                 (when (or (null test) (funcall test sub))
454                   (setq result (list (if follow-links (truename sub) sub))))))))
455    ; now descend doing %all-dirs on dirs and collecting files & dirs if do-x is t
456    (with-open-dir (dirent dir)
457      (while (setq sub (%read-dir dirent))
458        (when (and (or all (neq (%schar sub 0) #\.))
459                   (not (string= sub "."))
460                   (not (string= sub "..")))
461          (if (eq (%unix-file-kind (setq subfile (%str-cat dir sub)) t) :directory)
462            (let* ((std-sub (%path-std-quotes sub nil "/;:*"))
463                   (so-far (cons std-sub so-far))
464                   (subdir (%str-cat subfile "/")))
465              (declare (dynamic-extent so-far))
466              (when (and do-dirs (%file*= name type sub))
467                (setq ans (if directory-pathnames
468                            (%cons-pathname (reverse so-far) nil nil)
469                            (%cons-pathname (or dir-list (setq dir-list (reverse (cdr so-far))))
470                                            std-sub nil)))
471                (when (or (null test) (funcall test ans))
472                  (push (if follow-links (truename ans) ans) result)))
473              (setq result (nconc (%all-directories subdir rest path so-far keys) result)))
474            (when (and do-files (%file*= name type sub))
475              (multiple-value-bind (name type) (%std-name-and-type sub)
476                (setq ans (%cons-pathname (or dir-list (setq dir-list (reverse so-far))) name type))
477                (when (or (null test) (funcall test ans))
478                  (push (if follow-links (truename ans) ans) result))))))))
479    result))
480
481(defun %split-dir (dir &aux pos)                 ; dir ends in a "/".
482  ;"/foo/bar/../x*y/baz/../z*t/"  ->  "/foo/bar/../" "x*y" "/baz/../z*t/"
483  (if (null (setq pos (%path-mem "*" dir)))
484    (values dir nil nil)
485    (let (epos (len (length dir)))
486      (setq pos (if (setq pos (%path-mem-last "/" dir 0 pos)) (%i+ pos 1) 0)
487            epos (%path-mem "/" dir pos len))
488      (when (%path-mem-last-quoted "/" dir 0 pos)
489        (signal-file-error $xbadfilenamechar dir #\/))
490      (values (unless (%izerop pos) (namestring-unquote (%substr dir 0 pos)))
491              (%substr dir pos epos)
492              (%substr dir epos len)))))
493
494(defun %path-pstr*= (pattern pstr &optional (p-start 0))
495  (assert (eq p-start 0))
496  (%path-str*= pstr pattern))
497
498(defun %file*= (name-pat type-pat pstr)
499  (if (eq name-pat :wild) (setq name-pat "*"))
500  (if (eq type-pat :wild) (setq type-pat "*"))
501  (when (and (null name-pat) (null type-pat))
502    (return-from %file*= T))
503  (let* ((end (length pstr))
504         (pos (position #\. pstr :from-end t))
505         (type (and pos (%substr pstr (%i+ pos 1) end)))
506         (name (unless (eq (or pos end) 0) (if pos (%substr pstr 0 pos) pstr))))
507    (and (cond ((or (eq name-pat :unspecific) (null name-pat)) (null name))
508               (t (%path-pstr*= name-pat (or name ""))))
509         (cond ((or (null type-pat) (eq type-pat :unspecific)) (null type))
510               (t (%path-pstr*= type-pat (or type "")))))))
511
512(provide "PATHNAMES")
Note: See TracBrowser for help on using the repository browser.