Hardcopy to printer

sources/COREIO

@@ -1,17 +1,13 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 5-Jun-2022 00:14:07" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>sources>COREIO.;17
 57355  
+
(FILECREATED "11-Sep-2025 16:49:07" {WMEDLEY}<sources>COREIO.;18
 56903  
 
-      :CHANGES-TO (FNS \CORE.OPENFILE)
+      :EDIT-BY rmk
 
-      :PREVIOUS-DATE " 4-Jun-2022 16:30:20" 
-{DSK}<users>kaplan>local>medley3.5>working-medley>sources>COREIO.;16)
+      :CHANGES-TO (FNS \CORE.DIRECTORYNAMEP)
 
+      :PREVIOUS-DATE " 5-Jun-2022 00:14:07" {WMEDLEY}<sources>COREIO.;17)
 
-(* ; "
-Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation.
-")
 
 (PRETTYCOMPRINT COREIOCOMS)
 
@@ -91,8 +87,13 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation.
           (RETURN (fetch
 IOFILEFULLNAME of
 INFOBLOCK])
 
 (\CORE.DIRECTORYNAMEP

-  [LAMBDA (DIRNAME DEV)                                      (* ; "Edited 18-Jan-2022 11:17 by rmk")

-                                                             (* ; "Edited 10-Jan-2022 22:33 by rmk")

+  [LAMBDA (DIRNAME DEV)
+
+    (* ;; "Edited 11-Sep-2025 16:48 by rmk")

+
+    (* ;; "Edited 18-Jan-2022 11:17 by rmk")

+
+    (* ;; "Edited 10-Jan-2022 22:33 by rmk")

 
     (* ;; 
 
 "Edited  9-Jan-2022 12:42 by rmk: Using the new FILEDIRCASEARRAY so that slashes and brackets match")

@@ -103,22 +104,20 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation.
 
     (CL:WHEN DIRNAME
 
-        (* ;; "The DIRNAME could be just {CORE}, which always is OK, or {CORE}xxx.  If the latter, then we want it to be a directory and not a file  (assuming that xxx and xxx> can't both exist.")

+        (* ;; "Returns NIL for a DIRNAME of just {CORE},  or {CORE}xxx.  If the latter, then we want it to be a directory and not a file  (assuming that xxx and xxx> can't both exist.")

 
-        (IF
 (EQ (CHARCODE })
-                (NTHCHARCODE DIRNAME -1))
-          ELSE
 (CL:UNLESS (MEMB (NTHCHARCODE DIRNAME -1)
-                                (CHARCODE (> /)))
-                   (SETQ DIRNAME (CONCAT DIRNAME ">"))) 
+        [LET [(DIR (FILENAMEFIELD DIRNAME 'DIRECTORY]
+             (CL:WHEN DIR
+                 (SETQ DIR (CONCAT DIR ">"))
 
-               (* ;; "DIRPOS because caller may not have stripped off the device. This will match the first < or / (or >)")

+                 (* ;; "DIRPOS because caller may not have stripped off the device. This will match the first < or / (or >)")

 
-               (FOR
 ENTRY (DIRPOS _ (STRPOS "<" DIRNAME 1 NIL NIL NIL FILEDIRCASEARRAY))
-                  FIRST
 (CL:UNLESS (EQ DIRPOS 1)
-                            (SETQ DIRNAME (SUBSTRING DIRNAME DIRPOS)))
-                  IN
 (CDR (FETCH
 COREDIRECTORY OF
 DEV)) WHEN
 (STRPOS DIRNAME (CAR ENTRY)
-                                                                    1 NIL T NIL FILEDIRCASEARRAY)
-                  DO
 (RETURN T))))])
+                 (FOR
 ENTRY (DIRPOS _ (STRPOS "<" DIRNAME 1 NIL NIL NIL FILEDIRCASEARRAY))
+                    FIRST
 (CL:UNLESS (EQ DIRPOS 1)
+                              (SETQ DIRNAME (SUBSTRING DIRNAME DIRPOS)))
+                    IN
 (CDR (FETCH
 COREDIRECTORY OF
 DEV))
+                    WHEN
 (STRPOS DIRNAME (CAR ENTRY)
+                                1 NIL T NIL FILEDIRCASEARRAY) DO
 (RETURN T)))])])
 
 (\CORE.FINDPAGE

   [LAMBDA (STREAM PN)
                                    (* bvm%: "20-Apr-85 13:32")

@@ -997,19 +996,17 @@ Copyright (c) 1981-1988, 1990, 1993, 1999, 2018 by Venue & Xerox Corporation.
 (LOCALVARS . T)
 )
 )
-(PUTPROPS COREIO COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
-1993 1999 2018))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (1717 46448 (\CORE.CLOSEFILE 1727 . 2500) (\CORE.DELETEFILE 2502 . 4488) (
-\CORE.DIRECTORYNAMEP 4490 . 6171) (\CORE.FINDPAGE 6173 . 9402) (\CORE.GENERATEFILES 9404 . 11991) (
-\CORE.NEXTFILEFN 11993 . 12492) (\CORE.FILEINFOFN 12494 . 12723) (\CORE.GETFILEHANDLE 12725 . 14879) (
-\CORE.GETFILEINFO 14881 . 15844) (\CORE.GETFILEINFO.FROM.INFOBLOCK 15846 . 17383) (\CORE.GETFILENAME 
-17385 . 19674) (\CORE.GETINFOBLOCK 19676 . 22299) (\CORE.NAMESCAN 22301 . 23848) (\CORE.NAMESEGMENT 
-23850 . 24287) (\CORE.OPENFILE 24289 . 27681) (\COREFILE.SETPARAMETERS 27683 . 29864) (
-\CORE.PACKFILENAME 29866 . 30261) (\CORE.RELEASEPAGES 30263 . 30864) (\CORE.SETFILEPTR 30866 . 31965) 
-(\CORE.UPDATEOF 31967 . 33596) (\CORE.BACKFILEPTR 33598 . 35806) (\CORE.SETEOFPTR 35808 . 37677) (
-\CORE.SETACCESSTIME 37679 . 38304) (\CORE.SETFILEINFO 38306 . 40608) (\CORE.GETNEXTBUFFER 40610 . 
-44566) (\CORE.UNPACKFILENAME 44568 . 46446)) (46449 50082 (COREDEVICE 46459 . 46630) (
-\CREATECOREDEVICE 46632 . 50080)) (50083 52497 (\NODIRCOREFDEV 50093 . 50690) (\NODIRCORE.OPENFILE 
-50692 . 52495)))))
+  (FILEMAP (NIL (1572 46115 (\CORE.CLOSEFILE 1582 . 2355) (\CORE.DELETEFILE 2357 . 4343) (
+\CORE.DIRECTORYNAMEP 4345 . 5838) (\CORE.FINDPAGE 5840 . 9069) (\CORE.GENERATEFILES 9071 . 11658) (
+\CORE.NEXTFILEFN 11660 . 12159) (\CORE.FILEINFOFN 12161 . 12390) (\CORE.GETFILEHANDLE 12392 . 14546) (
+\CORE.GETFILEINFO 14548 . 15511) (\CORE.GETFILEINFO.FROM.INFOBLOCK 15513 . 17050) (\CORE.GETFILENAME 
+17052 . 19341) (\CORE.GETINFOBLOCK 19343 . 21966) (\CORE.NAMESCAN 21968 . 23515) (\CORE.NAMESEGMENT 
+23517 . 23954) (\CORE.OPENFILE 23956 . 27348) (\COREFILE.SETPARAMETERS 27350 . 29531) (
+\CORE.PACKFILENAME 29533 . 29928) (\CORE.RELEASEPAGES 29930 . 30531) (\CORE.SETFILEPTR 30533 . 31632) 
+(\CORE.UPDATEOF 31634 . 33263) (\CORE.BACKFILEPTR 33265 . 35473) (\CORE.SETEOFPTR 35475 . 37344) (
+\CORE.SETACCESSTIME 37346 . 37971) (\CORE.SETFILEINFO 37973 . 40275) (\CORE.GETNEXTBUFFER 40277 . 
+44233) (\CORE.UNPACKFILENAME 44235 . 46113)) (46116 49749 (COREDEVICE 46126 . 46297) (
+\CREATECOREDEVICE 46299 . 49747)) (49750 52164 (\NODIRCOREFDEV 49760 . 50357) (\NODIRCORE.OPENFILE 
+50359 . 52162)))))
 STOP