LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031863. :SYSTEM-TYPE :LOGICAL :VERSION 10. :TYPE "LISP" :NAME "PNMAP" :DIRECTORY ("REL3-SOURCE" "PATHNAME") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758742141. :AUTHOR "REL3" :LENGTH-IN-BYTES 19606. :LENGTH-IN-BLOCKS 20. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             ;; -*- Mode:Common-LISP; Package:FILE-SYSTEM; Base:8; COLD-LOAD:T -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;; Copyright (C) 1985,1987 Texas Instruments Incorporated. All rights reserved.;; Wildcard mapping operations.;; Match a pattern against a sample.;; Both the pattern and the sample are pathname components;;; the pattern can contain wildcards.;; WILD-ANY is the character which, if found in the pattern,;; is a wildcard that matches any number of characters.;; WILD-ONE is the wild character that matches exactly one character.;; Either of those may be NIL, meaning that there is no such wildcard.;;; REVISIONS:;;;04.22.87 MBCFix one hole in :TARGET-TRANSLATE-WILD-PATHNAMES, when;;;copying from A; to ~; then sub-directory A.B; should end up;;;as B; on target, not A.B;;;;04.10.87 MBCFix :target-translate-wild-pathnames to correctly handle directory;;;merging, node by node, as well as sub-directory propagation.;;; 02.23.87 MBC    Fix :target-translate-wild-pathnames to avoid problem: Copy-File of;;; LOGICAL-HOST:DIR; to LM:DIR; results in output to LM:DIR.DIR;;;;02.18.87 MBCWhen in :TARGET-TRANSLATE-WILD-PATHNAME, translating destination;;;directories, pay attention to differences in the directories, so;;;MT:RESTORE-DIRECTORY won't flatten out subdirectories.(DEFUN PATHNAME-COMPONENT-MATCH (PATTERN SAMPLE WILD-ANY WILD-ONE &OPTIONAL RETURN-SPECS-FLAG &AUX SPECS) ;; If RETURN-SPECS-FLAG, we return a list of the chars or strings ;; that matched the wildcards, in the order they appeared, ;; or T if no wildcards but the pattern does match.  (COND    ((EQ PATTERN :WILD)     (IF RETURN-SPECS-FLAG (IF (CONSP SAMPLE) SAMPLE (LIST SAMPLE)) T))    ((SYMBOLP PATTERN) (EQ PATTERN SAMPLE))    ((NUMBERP PATTERN) (EQ PATTERN SAMPLE))    ((CONSP PATTERN)     (IF (AND (CONSP SAMPLE) (= (LENGTH PATTERN) (LENGTH SAMPLE)))       (LOOP FOR P IN PATTERN FOR S IN SAMPLE DO  (LET ((TEM (PATHNAME-COMPONENT-MATCH P S WILD-ANY WILD-ONE RETURN-SPECS-FLAG)))    (IF (NULL TEM)      (RETURN ()))    (UNLESS (EQ TEM T)      (SETQ SPECS (APPEND SPECS TEM))))  FINALLY (RETURN (OR SPECS T)))       (WHEN (STRINGP SAMPLE) (LET (RESULT)   (SETQ RESULT (PATHNAME-COMPONENT-MATCH (CAR PATTERN) SAMPLE WILD-ANY WILD-ONE   RETURN-SPECS-FLAG))   (IF (AND RESULT (CDR PATTERN))     (DOLIST (COMPONENT (CDR PATTERN) RESULT)       (IF (NEQ COMPONENT :WILD) (RETURN ()) (SETQ RESULT T)))     RESULT)))))    ((CONSP SAMPLE)     (IF (EQ (LENGTH SAMPLE) 1.)       (PATHNAME-COMPONENT-MATCH PATTERN (CAR SAMPLE) WILD-ANY WILD-ONE RETURN-SPECS-FLAG)       ()))    ((SYMBOLP SAMPLE) NIL)    (T     (DO ((P-PTR 0.)  (P-NEXT)  (P-CHAR WILD-ONE)  (S-PTR -1.)  (SET (LIST WILD-ANY WILD-ONE))) (NIL)       (SETQ P-NEXT (STRING-SEARCH-SET SET PATTERN P-PTR))       (COND ((>= S-PTR (LENGTH SAMPLE))  (LET ((OLD-S-PTR S-PTR))    (SETQ S-PTR  (SEARCH (THE STRING PATTERN) (THE STRING (STRING SAMPLE))  :FROM-END T :START1 P-PTR :START2 S-PTR :TEST #'CHAR-EQUAL))    (WHEN RETURN-SPECS-FLAG      (PUSH (SUBSEQ SAMPLE OLD-S-PTR S-PTR) SPECS)))) ((EQ P-CHAR WILD-ONE)  (AND RETURN-SPECS-FLAG (>= S-PTR 0.) (PUSH (AREF SAMPLE S-PTR) SPECS))  (SETQ S-PTR(AND;;; rla 8/12/86 - note that this is an obsolete positional calling sequence start1 start2 end1 end2 ;;; (STRING-EQUAL SAMPLE PATTERN (1+ S-PTR) P-PTR;;;       (+ 1. S-PTR (- (OR P-NEXT (LENGTH PATTERN)) P-PTR)) P-NEXT) (STRING-EQUAL SAMPLE PATTERN :start1 (1+ S-PTR) :start2 P-PTR       :end1 (+ 1. S-PTR (- (OR P-NEXT (LENGTH PATTERN)) P-PTR)) :end2 P-NEXT) (1+ S-PTR)))) ((NULL P-NEXT)  ;; Stuff at end following a star =>  ;;  win if tail of rest of string matches that stuff.  (LET ((OLD-S-PTR S-PTR))    (SETQ S-PTR  (SEARCH (THE STRING PATTERN) (THE STRING (STRING SAMPLE)) :START1 P-PTR  :START2 S-PTR :TEST #'CHAR-EQUAL :FROM-END T))    (WHEN RETURN-SPECS-FLAG      (PUSH (SUBSEQ SAMPLE OLD-S-PTR S-PTR) SPECS)))) (T  (LET ((OLD-S-PTR S-PTR))    (SETQ S-PTR  (SEARCH (THE STRING PATTERN) (THE STRING (STRING SAMPLE)) :START2 S-PTR  :START1 P-PTR :END1 P-NEXT :TEST #'CHAR-EQUAL));MBC 8-19-86    (WHEN RETURN-SPECS-FLAG      (PUSH (SUBSEQ SAMPLE OLD-S-PTR S-PTR) SPECS)))))       (UNLESS S-PTR (RETURN ()))       (INCF S-PTR (- (OR P-NEXT (LENGTH PATTERN)) P-PTR))       (UNLESS P-NEXT (RETURN (AND (= S-PTR (LENGTH SAMPLE)) (OR (NREVERSE SPECS) T))))       (SETQ P-CHAR (AREF PATTERN P-NEXT))       (SETQ P-PTR (1+ P-NEXT))))))(DEFMETHOD (PATHNAME :PATHNAME-MATCH) (PATHNAME &OPTIONAL (MATCH-HOST T))  (MULTIPLE-VALUE-BIND (W* W1)    (SEND SELF :INTERNAL-WILD-CHARACTERS)    (AND (OR (NOT MATCH-HOST) (EQ HOST (PATHNAME-HOST PATHNAME)))       (PATHNAME-COMPONENT-MATCH DEVICE (PATHNAME-DEVICE PATHNAME) W* W1)       (PATHNAME-COMPONENT-MATCH DIRECTORY (PATHNAME-DIRECTORY PATHNAME) W* W1)       (PATHNAME-COMPONENT-MATCH NAME (PATHNAME-NAME PATHNAME) W* W1)       (PATHNAME-COMPONENT-MATCH TYPE (PATHNAME-TYPE PATHNAME) W* W1)       (PATHNAME-COMPONENT-MATCH VERSION (PATHNAME-VERSION PATHNAME) W* W1))))  (DEFMETHOD (PATHNAME :PATHNAME-MATCH-SPECS) (PATHNAME)  (MULTIPLE-VALUE-BIND (W* W1)    (SEND SELF :INTERNAL-WILD-CHARACTERS)    (VALUES (PATHNAME-COMPONENT-MATCH DEVICE (PATHNAME-DEVICE PATHNAME) W* W1 T)    (PATHNAME-COMPONENT-MATCH DIRECTORY (PATHNAME-DIRECTORY PATHNAME) W* W1 T)    (PATHNAME-COMPONENT-MATCH NAME (PATHNAME-NAME PATHNAME) W* W1 T)    (PATHNAME-COMPONENT-MATCH TYPE (PATHNAME-TYPE PATHNAME) W* W1 T))))  (DEFMETHOD (PATHNAME :PATHNAME-MATCH-NO-DEVICE) (PATHNAME &OPTIONAL (MATCH-HOST T))  (MULTIPLE-VALUE-BIND (W* W1)    (SEND SELF :INTERNAL-WILD-CHARACTERS)    (AND (OR (NOT MATCH-HOST) (EQ HOST (PATHNAME-HOST PATHNAME)))       (PATHNAME-COMPONENT-MATCH DIRECTORY (PATHNAME-DIRECTORY PATHNAME) W* W1)       (PATHNAME-COMPONENT-MATCH NAME (PATHNAME-NAME PATHNAME) W* W1)       (PATHNAME-COMPONENT-MATCH TYPE (PATHNAME-TYPE PATHNAME) W* W1)       (OR (PATHNAME-COMPONENT-MATCH VERSION (PATHNAME-VERSION PATHNAME) W* W1)  (MEMBER VERSION '(:NEWEST :OLDEST) :TEST #'EQ)))))  (DEFMETHOD (PATHNAME :PATHNAME-MATCH-NO-VERSION-OR-DEVICE) (PATHNAME &OPTIONAL (MATCH-HOST T))  (MULTIPLE-VALUE-BIND (W* W1)    (SEND SELF :INTERNAL-WILD-CHARACTERS)    (AND (OR (NOT MATCH-HOST) (EQ HOST (PATHNAME-HOST PATHNAME)))       (PATHNAME-COMPONENT-MATCH DIRECTORY (PATHNAME-DIRECTORY PATHNAME) W* W1)       (PATHNAME-COMPONENT-MATCH NAME (PATHNAME-NAME PATHNAME) W* W1)       (PATHNAME-COMPONENT-MATCH TYPE (PATHNAME-TYPE PATHNAME) W* W1))))  (DEFMETHOD (PATHNAME :PATHNAME-MATCH-NO-VERSION) (PATHNAME &OPTIONAL (MATCH-HOST T))  (MULTIPLE-VALUE-BIND (W* W1)    (SEND SELF :INTERNAL-WILD-CHARACTERS)    (AND (OR (NOT MATCH-HOST) (EQ HOST (PATHNAME-HOST PATHNAME)))       (OR (EQ DEVICE :UNSPECIFIC) (NULL DEVICE)  (PATHNAME-COMPONENT-MATCH DEVICE (PATHNAME-DEVICE PATHNAME) W* W1))       (PATHNAME-COMPONENT-MATCH DIRECTORY (PATHNAME-DIRECTORY PATHNAME) W* W1)       (PATHNAME-COMPONENT-MATCH NAME (PATHNAME-NAME PATHNAME) W* W1)       (PATHNAME-COMPONENT-MATCH TYPE (PATHNAME-TYPE PATHNAME) W* W1))))  ;; Return a pathname component made from TARGET-PATTERN;; by replacing each wildcard with an element of SPECS(DEFUN PATHNAME-TRANSLATE-WILD-COMPONENT (TARGET-PATTERN DATA SPECS WILD-ANY WILD-ONE)  (COND    ((MEMBER TARGET-PATTERN '(:WILD :ROOT) :TEST #'EQ) DATA)    ((OR (NUMBERP TARGET-PATTERN) (SYMBOLP TARGET-PATTERN) (EQ SPECS T)) TARGET-PATTERN)    ((CONSP TARGET-PATTERN) (WHEN (ATOM DATA)      (SETQ DATA (CONS DATA ())))     (LOOP FOR ELT IN TARGET-PATTERN FOR FLAG = (EQ ELT :WILD) WHEN FLAG COLLECT(LET (OLD-SPECS)  (SETQ OLD-SPECS (CAR SPECS)SPECS (CDR SPECS))  OLD-SPECS)INTO THE-LIST ELSE COLLECT(MULTIPLE-VALUE-BIND (NEW-ELT SPECS-LEFT)  (PATHNAME-TRANSLATE-COMPONENT-FROM-SPECS ELT SPECS WILD-ANY WILD-ONE)  (SETQ SPECS SPECS-LEFT)  NEW-ELT)INTO THE-LIST FINALLY (RETURN THE-LIST)))    (T (PATHNAME-TRANSLATE-COMPONENT-FROM-SPECS TARGET-PATTERN SPECS WILD-ANY WILD-ONE))))  (DEFUN PATHNAME-TRANSLATE-COMPONENT-FROM-SPECS (PATTERN SPECS WILD-ANY WILD-ONE)  (DECLARE (VALUES TRANSLATED-COMPONENT SPECS-LEFT))  (LET ((TARGET-INDICES (PATHNAME-WILD-CHAR-INDICES PATTERN WILD-ANY WILD-ONE)))    (DO ((TIS TARGET-INDICES (CDR TIS)) (RESULT (MAKE-ARRAY 24. :TYPE ART-STRING :FILL-POINTER 0.)) (SPECS-LEFT SPECS) TI (PREV-TI -1. TI))(NIL)      (SETQ TI (CAR TIS))      (UNLESS (MINUSP PREV-TI)(STRING-NCONC RESULT (OR (POP SPECS-LEFT) "")))      (STRING-NCONC RESULT (SUBSEQ PATTERN (1+ PREV-TI) TI))      (UNLESS TI(RETURN (VALUES RESULT SPECS-LEFT))))))  (DEFUN PATHNAME-WILD-CHAR-INDICES (STRING &REST SET)  (IF (NOT (STRINGP STRING))    ()    (DO ((I (LENGTH STRING)) VALUES)(NIL)      (SETQ I (STRING-REVERSE-SEARCH-SET SET STRING I))      (UNLESS I(RETURN VALUES))      (PUSH I VALUES))))  (DEFUN WILD-COMPONENT (SPEC W* W1)  (IF (OR (POSITION W* (THE STRING (STRING SPEC)) :TEST #'CHAR-EQUAL)      (POSITION W1 (THE STRING (STRING SPEC)) :TEST #'CHAR-EQUAL))    T    ()))  (DEFMETHOD (PATHNAME :COMPONENT-CONTAINS-WILD) (SPEC)  "Checks if the component has a wild character anywhere in the pathname string"  (MULTIPLE-VALUE-BIND (W* W1)    (SEND SELF :INTERNAL-WILD-CHARACTERS)    (COND      ((STRINGP SPEC) (WILD-COMPONENT SPEC W* W1))      ((CONSP SPEC)       (DOLIST (ONE-SPEC SPEC) (WHEN (OR (WILD-COMPONENT ONE-SPEC W* W1) (EQ ONE-SPEC :WILD))   (RETURN T))))      (T (EQ SPEC :WILD)))))  (DEFMETHOD (PATHNAME :TRANSLATE-WILD-PATHNAME) (TARGET-PATTERN DATA-PATHNAME)  (SEND TARGET-PATTERN :TARGET-TRANSLATE-WILD-PATHNAME (OR TARGET-PATTERN SELF) DATA-PATHNAME))  ;;; New support.  4.8.87 MBC       (defun simply-remove-wilds (target-component wild-any wild-one)  (let (result)    (unless (consp target-component) (setf target-component (list target-component)))    (dolist (Node target-component result)      (case Node(:WILD);lose these since they could (Nil); generate unmanagable directories, like "" or NIL.(T (setf result       (append result        (list (PATHNAME-TRANSLATE-COMPONENT-FROM-SPECS       Node nil wild-any wild-one)))))))));NIL is there is no match spec.(DEFUN pathname-directory-fixed-part (pathname wild-string case-converter)  (let ((directory(funcall case-converter (send pathname :directory)))fixed-part)    (setf fixed-part  (cond    ((not (send pathname :directory-wild-p))     directory)    (t     (reverse       (dolist (Node directory) (if (SEND pathname :COMPONENT-CONTAINS-WILD Node)     (return fixed-part)     (setf fixed-part (cons Node fixed-part))))))))    (let ((fixed-length (length fixed-part))  (remainder directory))      (values fixed-part      (subst wild-string :WILD      (dotimes (i fixed-length remainder)       (setf remainder (cdr remainder))))))));;;;;;  This algorithm is very obtuse because it attempts to do two different;;;    things at once to make up for our lack of a :WILD-INFERIOR feature.;;;-  4.10.87 MBC;;;   First it preserves sub directories.  ;;;   ex. Given directory, "lm:SRC1.SRC2.SRC3.SRC4;" then,;;;  (copy-directory "lm:SRC1.SRC2;" "lm:TARGET1.TARGET2;") should propagate;;;       the directories SRC3 and SRC4 underneath TARGET1 and TARGET2 resulting;;;  in LM:TARGET1.TARGET2.SRC3.SRC4;;;;   Second it is merging wild patterns on a node by node basis.;;;   ex. Again Given directory, "lm:SRC1.SRC2.SRC3.SRC4;" then,;;;  (copy-directory "lm:S*.S*;" "lm:TARGET-*.TARGET-*;") should both merge;;;  SRC1.SRC2; to TARGET-RC1.TARGET-RC2; and propagate the subs, SRC3 and SRC4,;;;   resulting in LM:TARGET-RC1.TARGET-RC2.SRC3.SRC4;;;;   ;;;(DEFUN PATHNAME-TRANSLATE-WILD-DIRECTORY         (TARGET-PATTERN-PATHNAME SOURCE-INSTANCE-PATHNAME SOURCE-PATTERN-PATHNAME WILD-ANY WILD-ONE)  (let* ((case-converter (SEND TARGET-PATTERN-PATHNAME :TRANSLATION-CASE-CONVERTER)) (target-pattern-directory (funcall case-converter (send TARGET-PATTERN-PATHNAME :directory))) (source-instance-directory (funcall case-converter (send SOURCE-INSTANCE-PATHNAME :directory))) (source-pattern-directory (funcall case-converter (send SOURCE-PATTERN-PATHNAME :directory))) (wild-any-string (string wild-any)) target-instance target-wild-part source-fixed-part source-wild-part)    (cond      ;;; The actual source directory is at top level, so use target-directory.      ;;; Remove any wilds from the target just in case any are there.      ((MEMBER SOURCE-INSTANCE-DIRECTORY '(:WILD :ROOT) :TEST #'EQ)       (if (MEMBER TARGET-PATTERN-DIRECTORY '(:WILD :ROOT) :TEST #'EQ);4.22.87   source-instance-directory   (simply-remove-wilds target-pattern-directory wild-any wild-one)))            (T;easy cases done, now do the work       ;;; Somehow the Target Pattern Directory is a single node, correct this.       (unless (listp target-pattern-directory) (setf target-pattern-directory (list target-pattern-directory)))       ;;; Somehow the Source Pattern Directory is a single node, correct this.       (unless (listp source-pattern-directory) (setf source-pattern-directory (list source-pattern-directory)))              ;;; Seperate the fixed (non-wild) pattern portion from the wild portion.       (multiple-value-setq (target-instance target-wild-part) (pathname-directory-fixed-part target-pattern-pathname wild-any-string case-converter))              (multiple-value-setq (source-fixed-part source-wild-part) (pathname-directory-fixed-part source-pattern-pathname wild-any-string case-converter))              ;;; Modify the source instance directory to be only the portion that       ;;; was NOT derived from wild cards in the source pattern.       (let ((fixed-length (length source-fixed-part))     (remainder source-instance-directory)) (setf source-instance-directory        (dotimes (i fixed-length remainder) (setf remainder (cdr remainder)))))              (if (consp source-instance-directory)   (progn     (if (atom source-wild-part) (setf source-wild-part (list wild-any-string)))     (if (atom target-wild-part) (setf target-wild-part (list wild-any-string)))     (dotimes (i (length source-instance-directory) target-instance)       (setf target-instance     (append       target-instance       (list (let* ((tp-node (nth i target-wild-part))(si-node (nth i source-instance-directory))(sp-node (or (nth i source-wild-part) (string wild-any)))(match-spec (PATHNAME-COMPONENT-MATCH sp-node si-node wild-any wild-one T)))   (cond     ((or (null match-spec) (symbolp match-spec));could be NIL or T      si-node);degenerate case, so just use source-instance node.     (T      (if tp-node  (PATHNAME-TRANSLATE-COMPONENT-FROM-SPECS tp-node match-spec wild-any wild-one)  si-node)))))))))      (if (send target-pattern-pathname :directory-wild-p)       (simply-remove-wilds target-pattern-directory;no source pattern left to merge so..    wild-any wild-one);remove wilds from target dir spec.       target-pattern-directory))))))(DEFMETHOD (PATHNAME :TARGET-TRANSLATE-WILD-PATHNAME) (SOURCE-PATTERN DATA-PATHNAME)  (MULTIPLE-VALUE-BIND (W* W1)      (SEND SELF :INTERNAL-WILD-CHARACTERS)    (LET ((CASE-CONVERTER (SEND SELF :TRANSLATION-CASE-CONVERTER))  (source-pattern (send source-pattern :translated-pathname)));2.23.87      (MULTIPLE-VALUE-BIND (DEV-SPECS nil NAME-SPECS TYPE-SPECS)  (SEND SOURCE-PATTERN :PATHNAME-MATCH-SPECS DATA-PATHNAME)(MAKE-PATHNAME :HOST HOST :RAW-DEVICE       (PATHNAME-TRANSLATE-WILD-COMPONENT DEVICE (FUNCALL CASE-CONVERTER  (PATHNAME-DEVICE    DATA-PATHNAME)) (FUNCALL CASE-CONVERTER DEV-SPECS) W* W1)       :RAW-DIRECTORY       (PATHNAME-TRANSLATE-WILD-DIRECTORY self data-pathname source-pattern W* W1)       :RAW-NAME       (PATHNAME-TRANSLATE-WILD-COMPONENT NAME (FUNCALL CASE-CONVERTER  (PATHNAME-NAME DATA-PATHNAME)) (FUNCALL CASE-CONVERTER NAME-SPECS) W* W1)       (IF (EQ TYPE :WILD)   :TYPE   :RAW-TYPE)       (IF (EQ TYPE :WILD)   (SEND DATA-PATHNAME :CANONICAL-TYPE)   (PATHNAME-TRANSLATE-WILD-COMPONENT     TYPE     (FUNCALL CASE-CONVERTER      (PATHNAME-TYPEDATA-PATHNAME))     (FUNCALL CASE-CONVERTER TYPE-SPECS)     W* W1))       :VERSION (IF (EQ VERSION :WILD)    (PATHNAME-VERSION DATA-PATHNAME)    VERSION))))))  ;; Returns function that converts interchange case into this flavor's raw case.(DEFMETHOD (PATHNAME :TRANSLATION-CASE-CONVERTER) ()  #'(LAMBDA (X)      X))  ;; Returns two values, the wild-any char for this flavor and the wild-one char.(DEFMETHOD (PATHNAME :INTERNAL-WILD-CHARACTERS) ()  (VALUES #\* #\?))  (DEFMETHOD (LOGICAL-PATHNAME :PATHNAME-MATCH) (PATHNAME &OPTIONAL (MATCH-HOST T))  (MULTIPLE-VALUE-BIND (W* W1)      (SEND SELF ':INTERNAL-WILD-CHARACTERS)    (AND (OR (NOT MATCH-HOST)     (EQ HOST (PATHNAME-HOST PATHNAME))) (PATHNAME-COMPONENT-MATCH DEVICE (PATHNAME-DEVICE PATHNAME) W* W1) (PATHNAME-COMPONENT-MATCH DIRECTORY (PATHNAME-DIRECTORY PATHNAME) W* W1) (PATHNAME-COMPONENT-MATCH NAME (PATHNAME-NAME PATHNAME) W* W1) (PATHNAME-COMPONENT-MATCH TYPE (PATHNAME-TYPE PATHNAME) W* W1) (PATHNAME-COMPONENT-MATCH VERSION (PATHNAME-VERSION PATHNAME) W* W1))))(DEFMETHOD (LOGICAL-PATHNAME :PATHNAME-MATCH-SPECS) (PATHNAME)  (MULTIPLE-VALUE-BIND (W* W1)      (SEND SELF ':INTERNAL-WILD-CHARACTERS)    (VALUES      (PATHNAME-COMPONENT-MATCH DEVICE (PATHNAME-DEVICE PATHNAME) W* W1 T)      (PATHNAME-COMPONENT-MATCH DIRECTORY (PATHNAME-DIRECTORY PATHNAME) W* W1 T)      (PATHNAME-COMPONENT-MATCH NAME (PATHNAME-NAME PATHNAME) W* W1 T)      (PATHNAME-COMPONENT-MATCH TYPE (PATHNAME-TYPE PATHNAME) W* W1 T))))(DEFMETHOD (LOGICAL-PATHNAME :PATHNAME-MATCH-NO-VERSION) (PATHNAME &OPTIONAL (MATCH-HOST T))  (MULTIPLE-VALUE-BIND (W* W1)      (SEND SELF ':INTERNAL-WILD-CHARACTERS)    (AND (OR (NOT MATCH-HOST)     (EQ HOST (PATHNAME-HOST PATHNAME))) (OR (EQ DEVICE :UNSPECIFIC) (NULL DEVICE)     (PATHNAME-COMPONENT-MATCH DEVICE (PATHNAME-DEVICE PATHNAME) W* W1)) (PATHNAME-COMPONENT-MATCH DIRECTORY (PATHNAME-DIRECTORY PATHNAME) W* W1) (PATHNAME-COMPONENT-MATCH NAME (PATHNAME-NAME PATHNAME) W* W1) (PATHNAME-COMPONENT-MATCH TYPE (PATHNAME-TYPE PATHNAME) W* W1))))(DEFMETHOD (LOGICAL-PATHNAME :PATHNAME-MATCH-NO-DEVICE) (PATHNAME &OPTIONAL (MATCH-HOST T))  (MULTIPLE-VALUE-BIND (W* W1)    (SEND SELF :INTERNAL-WILD-CHARACTERS)    (AND (OR (NOT MATCH-HOST) (EQ HOST (PATHNAME-HOST PATHNAME)))       (PATHNAME-COMPONENT-MATCH DIRECTORY (PATHNAME-DIRECTORY PATHNAME) W* W1)       (PATHNAME-COMPONENT-MATCH NAME (PATHNAME-NAME PATHNAME) W* W1)       (PATHNAME-COMPONENT-MATCH TYPE (PATHNAME-TYPE PATHNAME) W* W1)       (OR (PATHNAME-COMPONENT-MATCH VERSION (PATHNAME-VERSION PATHNAME) W* W1)  (MEMBER VERSION '(:NEWEST :OLDEST) :TEST #'EQ)))))   FILE-COMPUTER) ": " STRING)))))  ;;;;;; Replace get-list-of-directories with this simple verify, since get-.. never;;; returned anything significant anyways. 3.9.87(defun verify-list-of-directories (pathname)  (MULTIPLE-VALUE-BIND (GOOD WILD)      (SEND PATHNAME :PARSE-DIRECTORY-WILD-SPECS (SEND PATHNAME :DIRECTORY))    (unless WILD      (unless (eq (car good) :root);Root is Never WILD, but don't probe it.(unless (send pathname :PROBE-DIRECTORY);3.9.87 MBC  (ferror 'fs:directory-not-found "Directory not found"  pathname))))    (VALUES (LIST PATHNAME) NIL)));;;;(DEFUN GET-LIST-OF-DIRECTORIES-1 (PATHNAME);;;;  (MULTIPLE-VALUE-BIND (GOOD WILD);;;;      (SEND PATHNAME :PARSE-DIRECTORY-WILD-SPECS (SEND PATHNAME :DIRECTORY));;;;    (IF WILD;;;;(LET ((DLIST;;;;(APPLY #'DIRECTORY-LIST (SEND PATHNAME :NEW-PATHNAME :DIRECTORY GOOD) '(:NOERROR)))