hash p write pathname (#1612)

* #P"pathname" reads in as pathname
* #P"pathname" used for printing pathnames
* remake to remove extraneous reprint of CMLPATHNAMECOMS

Author: masinter

sources/CMLPATHNAME

@@ -1,12 +1,10 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-
(FILECREATED " 1-May-2023 07:12:28" {DSK}<home>larry>il>medley>sources>CMLPATHNAME.;5
 30540  
+
(FILECREATED " 9-Apr-2024 12:59:40" {DSK}<home>larry>il>medley>sources>CMLPATHNAME.;2
 32347  
 
       :EDIT-BY "lmm"
 
-      :CHANGES-TO (FNS PATHNAME)
-
-      :PREVIOUS-DATE "30-Apr-2023 14:00:37" {DSK}<home>larry>il>medley>sources>CMLPATHNAME.;4)
+      :PREVIOUS-DATE "23-Mar-2024 22:31:11" {DSK}<home>larry>il>medley>sources>CMLPATHNAME.;1)
 
 
 (PRETTYCOMPRINT CMLPATHNAMECOMS)
@@ -40,8 +38,8 @@
         (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                (ADDVARS (NLAMA)
                       (NLAML)
-                      (LAMA CL:ENOUGH-NAMESTRING CL:HOST-NAMESTRING FILE-NAME CL:MERGE-PATHNAMES 
-                            PATHNAME %%PRINT-DIRECTORY-COMPONENT CL:MAKE-PATHNAME %%PRINT-PATHNAME])
+                      (LAMA CL:ENOUGH-NAMESTRING CL:MERGE-PATHNAMES CL:MAKE-PATHNAME %%PRINT-PATHNAME
+                            ])
 
 
 
@@ -84,8 +82,10 @@
 (DEFINEQ
 
 (%%PRINT-PATHNAME

-(CL:LAMBDA (S STREAM D) (* hdj "19-Sep-86 15:49") (DECLARE (IGNORE D)) (CL:FORMAT STREAM "#.(~S ~S)" (QUOTE PATHNAME) (CL:NAMESTRING S)))
-)
+  (CL:LAMBDA (S STREAM D)
                                    (* ; "Edited 23-Mar-2024 22:25 by lmm")

+                                                             (* hdj "19-Sep-86 15:49")

+         (DECLARE
 (IGNORE D))
+         (CL:FORMAT STREAM "#P~S" (CL:NAMESTRING
 S))))
 
 (CL:MAKE-PATHNAME

   (CL:LAMBDA (&KEY DEFAULTS (HOST NIL HOSTP)
@@ -500,21 +500,62 @@
 
 (ADDTOVAR NLAML
 )
 
+(ADDTOVAR LAMA
 CL:ENOUGH-NAMESTRING CL:MERGE-PATHNAMES CL:MAKE-PATHNAME %%PRINT-PATHNAME)
+)
+(PRETTYCOMPRINT CMLPATHNAMECOMS)
+
+(RPAQQ CMLPATHNAMECOMS

+       [
+        (* ;; "Common Lisp pathname functions")

+
+        (PROP FILETYPE CMLPATHNAME)
+        (COMS 
+              (* ;; "useful macros")

+
+              (FUNCTIONS %%WILD-NAME %%COMPONENT-STRING))
+        (STRUCTURES PATHNAME DIRECTORY-COMPONENT)
+        (FNS %%PRINT-PATHNAME CL:MAKE-PATHNAME %%PRINT-DIRECTORY-COMPONENT)
+        (FUNCTIONS CL:PATHNAME-HOST CL:PATHNAME-DEVICE CL:PATHNAME-DIRECTORY CL:PATHNAME-NAME 
+               CL:PATHNAME-TYPE CL:PATHNAME-VERSION)
+        (FNS PATHNAME CL:MERGE-PATHNAMES FILE-NAME CL:HOST-NAMESTRING CL:ENOUGH-NAMESTRING 
+             %%NUMERIC-STRING-P)
+        (FUNCTIONS CL:NAMESTRING CL:PARSE-NAMESTRING CL:TRUENAME)
+        (FUNCTIONS %%MAKE-PATHNAME)
+        (FUNCTIONS %%PATHNAME-EQUAL %%DIRECTORY-COMPONENT-EQUAL)
+        (FUNCTIONS %%INITIALIZE-DEFAULT-PATHNAME)
+        (VARIABLES *DEFAULT-PATHNAME-DEFAULTS*)
+        (COMS 
+              (* ;; "Interlisp-D compatibility")

+
+              (FUNCTIONS INTERLISP-NAMESTRING UNPACKPATHNAME.STRING))
+        (FUNCTIONS CL:FILE-NAMESTRING CL:DIRECTORY-NAMESTRING)
+        (DECLARE%: DONTEVAL@LOAD DOCOPY (P (%%INITIALIZE-DEFAULT-PATHNAME)))
+        (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
+               (ADDVARS (NLAMA)
+                      (NLAML)
+                      (LAMA CL:ENOUGH-NAMESTRING CL:HOST-NAMESTRING FILE-NAME CL:MERGE-PATHNAMES 
+                            PATHNAME %%PRINT-DIRECTORY-COMPONENT CL:MAKE-PATHNAME %%PRINT-PATHNAME])
+(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
+
+(ADDTOVAR NLAMA
 )
+
+(ADDTOVAR NLAML
 )
+
 (ADDTOVAR LAMA
 CL:ENOUGH-NAMESTRING CL:HOST-NAMESTRING FILE-NAME CL:MERGE-PATHNAMES PATHNAME 
                      %%PRINT-DIRECTORY-COMPONENT CL:MAKE-PATHNAME %%PRINT-PATHNAME)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2012 2143 (%%WILD-NAME 2012 . 2143)) (2145 2224 (%%COMPONENT-STRING 2145 . 2224)) (2829
- 8600 (%%PRINT-PATHNAME 2839 . 3000) (CL:MAKE-PATHNAME 3002 . 7752) (%%PRINT-DIRECTORY-COMPONENT 7754
- . 8598)) (8602 8795 (CL:PATHNAME-HOST 8602 . 8795)) (8797 8996 (CL:PATHNAME-DEVICE 8797 . 8996)) (
-8998 9206 (CL:PATHNAME-DIRECTORY 8998 . 9206)) (9208 9401 (CL:PATHNAME-NAME 9208 . 9401)) (9403 9596 (
-CL:PATHNAME-TYPE 9403 . 9596)) (9598 9800 (CL:PATHNAME-VERSION 9598 . 9800)) (9801 15390 (PATHNAME 
-9811 . 10268) (CL:MERGE-PATHNAMES 10270 . 12356) (FILE-NAME 12358 . 12499) (CL:HOST-NAMESTRING 12501
- . 12690) (CL:ENOUGH-NAMESTRING 12692 . 15157) (%%NUMERIC-STRING-P 15159 . 15388)) (15392 19145 (
-CL:NAMESTRING 15392 . 19145)) (19147 22618 (CL:PARSE-NAMESTRING 19147 . 22618)) (22620 23623 (
-CL:TRUENAME 22620 . 23623)) (23625 23817 (%%MAKE-PATHNAME 23625 . 23817)) (23819 24456 (
-%%PATHNAME-EQUAL 23819 . 24456)) (24458 24915 (%%DIRECTORY-COMPONENT-EQUAL 24458 . 24915)) (24917 
-25540 (%%INITIALIZE-DEFAULT-PATHNAME 24917 . 25540)) (25630 25797 (INTERLISP-NAMESTRING 25630 . 25797)
-) (25799 28692 (UNPACKPATHNAME.STRING 25799 . 28692)) (28694 29951 (CL:FILE-NAMESTRING 28694 . 29951))
- (29953 30151 (CL:DIRECTORY-NAMESTRING 29953 . 30151)))))
+  (FILEMAP (NIL (1912 2043 (%%WILD-NAME 1912 . 2043)) (2045 2124 (%%COMPONENT-STRING 2045 . 2124)) (2729
+ 8653 (%%PRINT-PATHNAME 2739 . 3053) (CL:MAKE-PATHNAME 3055 . 7805) (%%PRINT-DIRECTORY-COMPONENT 7807
+ . 8651)) (8655 8848 (CL:PATHNAME-HOST 8655 . 8848)) (8850 9049 (CL:PATHNAME-DEVICE 8850 . 9049)) (
+9051 9259 (CL:PATHNAME-DIRECTORY 9051 . 9259)) (9261 9454 (CL:PATHNAME-NAME 9261 . 9454)) (9456 9649 (
+CL:PATHNAME-TYPE 9456 . 9649)) (9651 9853 (CL:PATHNAME-VERSION 9651 . 9853)) (9854 15443 (PATHNAME 
+9864 . 10321) (CL:MERGE-PATHNAMES 10323 . 12409) (FILE-NAME 12411 . 12552) (CL:HOST-NAMESTRING 12554
+ . 12743) (CL:ENOUGH-NAMESTRING 12745 . 15210) (%%NUMERIC-STRING-P 15212 . 15441)) (15445 19198 (
+CL:NAMESTRING 15445 . 19198)) (19200 22671 (CL:PARSE-NAMESTRING 19200 . 22671)) (22673 23676 (
+CL:TRUENAME 22673 . 23676)) (23678 23870 (%%MAKE-PATHNAME 23678 . 23870)) (23872 24509 (
+%%PATHNAME-EQUAL 23872 . 24509)) (24511 24968 (%%DIRECTORY-COMPONENT-EQUAL 24511 . 24968)) (24970 
+25593 (%%INITIALIZE-DEFAULT-PATHNAME 24970 . 25593)) (25683 25850 (INTERLISP-NAMESTRING 25683 . 25850)
+) (25852 28745 (UNPACKPATHNAME.STRING 25852 . 28745)) (28747 30004 (CL:FILE-NAMESTRING 28747 . 30004))
+ (30006 30204 (CL:DIRECTORY-NAMESTRING 30006 . 30204)))))
 STOP