github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-15 20:46:19 +00:00
Code Issues Projects Releases Wiki Activity

(PATHNAME NIL) now errors; don't try to add it to whereis list (#1188)

Browse Source
This commit is contained in:
Larry Masinter
2023-07-07 11:41:56 -07:00
committed by GitHub
parent 871bbb735f
commit 6c6856efb9
6 changed files with 48 additions and 94 deletions
Download Patch File Download Diff File Expand all files Collapse all files

90
sources/CMLPATHNAME
View File

@@ -1,17 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Apr-2022 20:29:09" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>CMLPATHNAME.;3 32421
(FILECREATED " 1-May-2023 07:12:28" {DSK}<home>larry>il>medley>sources>CMLPATHNAME.;5 30540
:CHANGES-TO (VARS CMLPATHNAMECOMS)
:EDIT-BY "lmm"
:PREVIOUS-DATE "14-Jan-2022 11:40:58"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>CMLPATHNAME.;2)
:CHANGES-TO (FNS PATHNAME)
:PREVIOUS-DATE "30-Apr-2023 14:00:37" {DSK}<home>larry>il>medley>sources>CMLPATHNAME.;4)
(* ; "
Copyright (c) 1986-1988, 1990 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT CMLPATHNAMECOMS)
@@ -213,8 +209,13 @@ Copyright (c) 1986-1988, 1990 by Venue & Xerox Corporation.
(DEFINEQ
(PATHNAME
(CL:LAMBDA (THING) (* hdj " 2-Apr-86 11:01") (* ;; "Turns Thing into a pathname. Thing may be a string, symbol, stream, or pathname.") (CL:VALUES (CL:PARSE-NAMESTRING THING)))
)
(CL:LAMBDA (THING) (* ; "Edited 1-May-2023 07:04 by lmm")
(* hdj " 2-Apr-86 11:01")
(* ;; "Turns Thing into a pathname. Thing may be a string, symbol, stream, or pathname.")
[CL:CHECK-TYPE THING (OR STRING STREAM PATHNAME (AND CL:SYMBOL (NOT NULL]
(CL:VALUES (CL:PARSE-NAMESTRING THING))))
(CL:MERGE-PATHNAMES
(CL:LAMBDA (PATHNAME &OPTIONAL (DEFAULTS *DEFAULT-PATHNAME-DEFAULTS*) (DEFAULT-VERSION :NEWEST CL::VERSION-SPECIFIED-P)) (* ; "Edited 21-Aug-90 17:12 by nm") (* ;;; "Merge-Pathnames -- Public Returns a new pathname whose fields are the same as the fields in PATHNAME except that NIL fields are filled in from defaults. Type and Version field are only done if name field has to be done (see manual for explanation). Fills in unspecified slots of Pathname from Defaults (defaults to *default-pathname-defaults*). If the version remains unspecified, gets it from Default-Version.") (LET* ((PATH (PATHNAME PATHNAME)) (DEFAULT-PATH (PATHNAME DEFAULTS)) (HOST (OR (%%PATHNAME-HOST PATH) (%%PATHNAME-HOST DEFAULT-PATH))) (NAME (%%PATHNAME-NAME PATH)) (DEVICE (%%PATHNAME-DEVICE PATH)) (DIR (%%PATHNAME-DIRECTORY PATH)) (DEFAULT-DIR (%%PATHNAME-DIRECTORY DEFAULT-PATH)) DIREND DEFAULT-TYPE) (%%MAKE-PATHNAME HOST (OR DEVICE (%%PATHNAME-DEVICE DEFAULT-PATH)) (OR (AND DIR DEFAULT-DIR (CASE (%%DIRECTORY-COMPONENT-TYPE DIR) (:SUBDIRECTORY (CASE (SETQ DEFAULT-TYPE (%%DIRECTORY-COMPONENT-TYPE DEFAULT-DIR)) (:SUBDIRECTORY (* ; "Default is also a subdirectory, so explicit subdir overrides it") DIR) (T (* ; "Default is a full directory or a relative directory. Make sure to keep the type of the directory being same as the default one.") (CL:IF (EQ (%%DIRECTORY-COMPONENT-PATH DEFAULT-DIR) :WILD) (%%MAKE-DIRECTORY-COMPONENT :TYPE :RELATIVE :PATH (%%DIRECTORY-COMPONENT-PATH DIR)) (%%MAKE-DIRECTORY-COMPONENT :TYPE DEFAULT-TYPE :PATH (CL:CONCATENATE (QUOTE STRING) (%%DIRECTORY-COMPONENT-PATH DEFAULT-DIR) (CL:SECOND \FILENAME.SYNTAX) (%%DIRECTORY-COMPONENT-PATH DIR))))))) (T (CL:IF (NOT (EQ (%%DIRECTORY-COMPONENT-PATH DIR) :WILD)) DIR DEFAULT-DIR)))) DIR DEFAULT-DIR) (OR NAME (%%PATHNAME-NAME DEFAULT-PATH)) (OR (%%PATHNAME-TYPE PATH) (%%PATHNAME-TYPE DEFAULT-PATH)) (OR (%%PATHNAME-VERSION PATH) (CL:IF NAME (CL:IF CL::VERSION-SPECIFIED-P DEFAULT-VERSION :NEWEST) (OR (%%PATHNAME-VERSION DEFAULT-PATH) (CL:IF CL::VERSION-SPECIFIED-P DEFAULT-VERSION :NEWEST)))))))
@@ -502,61 +503,18 @@ Copyright (c) 1986-1988, 1990 by Venue & Xerox Corporation.
(ADDTOVAR LAMA CL:ENOUGH-NAMESTRING CL:HOST-NAMESTRING FILE-NAME CL:MERGE-PATHNAMES PATHNAME
%%PRINT-DIRECTORY-COMPONENT 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:MERGE-PATHNAMES
CL:MAKE-PATHNAME])
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA CL:ENOUGH-NAMESTRING CL:MERGE-PATHNAMES CL:MAKE-PATHNAME)
)
(PUTPROPS CMLPATHNAME COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1988 1990))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2107 2238 (%%WILD-NAME 2107 . 2238)) (2240 2319 (%%COMPONENT-STRING 2240 . 2319)) (2924
8695 (%%PRINT-PATHNAME 2934 . 3095) (CL:MAKE-PATHNAME 3097 . 7847) (%%PRINT-DIRECTORY-COMPONENT 7849
. 8693)) (8697 8890 (CL:PATHNAME-HOST 8697 . 8890)) (8892 9091 (CL:PATHNAME-DEVICE 8892 . 9091)) (
9093 9301 (CL:PATHNAME-DIRECTORY 9093 . 9301)) (9303 9496 (CL:PATHNAME-NAME 9303 . 9496)) (9498 9691 (
CL:PATHNAME-TYPE 9498 . 9691)) (9693 9895 (CL:PATHNAME-VERSION 9693 . 9895)) (9896 15220 (PATHNAME
9906 . 10098) (CL:MERGE-PATHNAMES 10100 . 12186) (FILE-NAME 12188 . 12329) (CL:HOST-NAMESTRING 12331
. 12520) (CL:ENOUGH-NAMESTRING 12522 . 14987) (%%NUMERIC-STRING-P 14989 . 15218)) (15222 18975 (
CL:NAMESTRING 15222 . 18975)) (18977 22448 (CL:PARSE-NAMESTRING 18977 . 22448)) (22450 23453 (
CL:TRUENAME 22450 . 23453)) (23455 23647 (%%MAKE-PATHNAME 23455 . 23647)) (23649 24286 (
%%PATHNAME-EQUAL 23649 . 24286)) (24288 24745 (%%DIRECTORY-COMPONENT-EQUAL 24288 . 24745)) (24747
25370 (%%INITIALIZE-DEFAULT-PATHNAME 24747 . 25370)) (25460 25627 (INTERLISP-NAMESTRING 25460 . 25627)
) (25629 28522 (UNPACKPATHNAME.STRING 25629 . 28522)) (28524 29781 (CL:FILE-NAMESTRING 28524 . 29781))
(29783 29981 (CL:DIRECTORY-NAMESTRING 29783 . 29981)))))
(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)))))
STOP

BIN
sources/CMLPATHNAME.LCOM
View File

Binary file not shown.

23
sources/MEDLEYDIR
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "22-Nov-2022 20:50:20" {DSK}<home>frank>il>medley>wmedley>sources>MEDLEYDIR.;10 10271
(FILECREATED "22-Apr-2023 11:53:53" {DSK}<home>larry>il>medley>sources>MEDLEYDIR.;2 9876
:CHANGES-TO (FNS MEDLEY-INIT-VARS)
:EDIT-BY "lmm"
:PREVIOUS-DATE "21-Nov-2022 17:31:30" {DSK}<home>frank>il>medley>wmedley>sources>MEDLEYDIR.;9
)
:CHANGES-TO (VARS MEDLEY-INIT-VARS)
:PREVIOUS-DATE "22-Nov-2022 20:50:20" {DSK}<home>larry>il>medley>sources>MEDLEYDIR.;1)
(PRETTYCOMPRINT MEDLEYDIRCOMS)
@@ -165,7 +166,7 @@
(RPAQQ MEDLEY-INIT-VARS
[[LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
([LISPUSERSDIRECTORIES (MEDLEYDIR '("library" "lispusers" "internal" "greetfiles" "doctools"]
[LISPSOURCEDIRECTORIES (MEDLEYDIR '("sources"]
(LISPSOURCEDIRECTORY (CAR LISPSOURCEDIRECTORIES))
(IRM.HOST&DIR (MEDLEYDIR '"docs/dinfo"))
@@ -190,17 +191,13 @@
(USERGREETFILES [LIST (CONS LOGINHOST/DIR '("INIT" COM))
(CONS LOGINHOST/DIR '("INIT"]
RESET)
(XCL::*WHERE-IS-CASH-FILES* (COND ((GETD 'XCL::ADD-WHERE-IS-DATABASE)
(SETQ XCL::*WHERE-IS-CASH-FILES* NIL)
(NLSETQ (XCL::ADD-WHERE-IS-DATABASE (MEDLEYDIR "loadups"
"WHEREIS.HASH"
NIL T)))
XCL::*WHERE-IS-CASH-FILES*])
(XCL::*WHERE-IS-CASH-FILES* (MEDLEYDIR '("loadups")
"whereis.hash" NIL T))))
(DECLARE%: EVAL@COMPILE DOCOPY
(ADDTOVAR GLOBALVARS MEDLEYDIR MEDLEY-INIT-VARS \SAVE.MEDLEYDIR DIRECTORIES)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1469 7896 (MEDLEY-INIT-VARS 1479 . 4957) (MEDLEYDIR 4959 . 6914) (MEDLEYSUBSTDIR 6916
. 7894)))))
(FILEMAP (NIL (1474 7901 (MEDLEY-INIT-VARS 1484 . 4962) (MEDLEYDIR 4964 . 6919) (MEDLEYSUBSTDIR 6921
. 7899)))))
STOP

BIN
sources/MEDLEYDIR.LCOM
View File

Binary file not shown.