Rmk31 Move all TMAX* files to TMAX>TMAX* (#750)
* MACHINEINDEPENDENT: better searching for foo-fie FINDFILE-WITH-EXTENSIONS, DOFILESLOAD * MEDLEY-UTILS, PRINTFN: WHEREIS/PF know about foo>foo-fie * WHERE-IS: Just MAKEFILE-NEW to get FUNCTIONS into the filemap * ACE does LOADCOMP itself * MACHINEINDEPENDENT: FINDFILE-WITH-EXTENSIONS recognized SUBDIRECTORY * SPELLFILE: Calls FINDFILE-WITH-EXTENSIONS at the top So FINDFILE and FILE-NOT-FOUND will consider FOO>FOO-FIE for file FOO-FIE * WINDOWOBJ: Missing GETFN does WHEREIS #748 * TMAX*: Localize IMAGEFNS The various IMAGEFNS were defined on TMAX itself, not on the file where the functions were (esp GETFN). Also fixed some dependencies. With new WINDOWOBJ, TMAX.TEDIT finds its image objects. * Move TMAX files to TMAX> Given the WHEREIS change for GETFN and the FINDFILE-WITH-EXTENSIONS in SPELLFILE, TEDIT(TMAX.TEDIT) opens and all of its imageobjects are found and loaded from the TMAX> files. * Push relocated files again: (COPYFILES screwed up) * Delete TMAX.INDEX garbage file
This commit is contained in:
rmkaplan
GitHub
@@ -1,10 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "17-Feb-2022 23:20:01" {DSK}<home>larry>medley>sources>MACHINEINDEPENDENT.;2 113592
|
||||
(FILECREATED "17-Mar-2022 12:05:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>MACHINEINDEPENDENT.;24 113260
|
||||
|
||||
:CHANGES-TO (FNS FINDFILE-WITH-EXTENSIONS)
|
||||
|
||||
:PREVIOUS-DATE " 5-Aug-2021 21:01:33" {DSK}<home>larry>medley>sources>MACHINEINDEPENDENT.;1)
|
||||
:PREVIOUS-DATE "15-Mar-2022 11:50:25"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>MACHINEINDEPENDENT.;23)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -286,174 +288,177 @@ with the terms of said license.
|
||||
|
||||
(DOFILESLOAD
|
||||
[LAMBDA (FILES)
|
||||
(DECLARE (USEDFREE LDFLG)) (* ; "Edited 4-May-88 14:23 by bvm")
|
||||
(* ; "does the work of FILESLOAD")
|
||||
(DECLARE (USEDFREE LDFLG)) (* ; "Edited 15-Mar-2022 00:48 by rmk")
|
||||
(* ; "Edited 4-May-88 14:23 by bvm")
|
||||
(* ; "does the work of FILESLOAD")
|
||||
(for FILE inside FILES bind DIRS LOADOPTIONSFLG FORCEDEXT? NOERRORFLG WORD FULL
|
||||
(FN _ 'LOAD?)
|
||||
(EXT _ :COMPILED)
|
||||
(FN _ 'LOAD?)
|
||||
(EXT _ :COMPILED)
|
||||
first [COND
|
||||
((BOUNDP 'LDFLG)
|
||||
((BOUNDP 'LDFLG)
|
||||
|
||||
(* ;; "Under a load; give priority to directory of currently loading file. ")
|
||||
(* ;; "Under a load; give priority to directory of currently loading file. ")
|
||||
|
||||
(LET ((INPUTNAME (FULLNAME *STANDARD-INPUT*)))
|
||||
(if (AND (NEQ INPUTNAME *STANDARD-INPUT*)
|
||||
(NEQ INPUTNAME T))
|
||||
then (* ;
|
||||
"If reading from terminal or nameless stream, don't do this.")
|
||||
(SETQ DIRS (CONS (PACKFILENAME.STRING 'VERSION NIL 'NAME NIL
|
||||
'EXTENSION NIL 'BODY INPUTNAME)
|
||||
(CONS T DIRECTORIES)))
|
||||
(SETQ LOADOPTIONSFLG LDFLG]
|
||||
(LET ((INPUTNAME (FULLNAME *STANDARD-INPUT*)))
|
||||
(if (AND (NEQ INPUTNAME *STANDARD-INPUT*)
|
||||
(NEQ INPUTNAME T))
|
||||
then (* ;
|
||||
"If reading from terminal or nameless stream, don't do this.")
|
||||
(SETQ DIRS (CONS (PACKFILENAME.STRING 'VERSION NIL 'NAME NIL
|
||||
'EXTENSION NIL 'BODY INPUTNAME)
|
||||
(CONS T DIRECTORIES)))
|
||||
(SETQ LOADOPTIONSFLG LDFLG]
|
||||
join
|
||||
(COND
|
||||
[(OR (LITATOM FILE)
|
||||
(STRINGP FILE)) (* ; "A file to do something with")
|
||||
(STRINGP FILE)) (* ; "A file to do something with")
|
||||
(PROG NIL
|
||||
(COND
|
||||
((AND (EQ FN 'LOAD?)
|
||||
(GETPROP (ROOTFILENAME FILE)
|
||||
'FILEDATES)) (* ; "Already loaded")
|
||||
'FILEDATES)) (* ; "Already loaded")
|
||||
(RETURN)))
|
||||
LP (COND
|
||||
[(SETQ FULL (SELECTQ EXT
|
||||
(NIL (* ; "No extension to guide us")
|
||||
(FINDFILE FILE T DIRS))
|
||||
(:COMPILED (* ;
|
||||
"Look for some sort of compiled file, or failing that a source")
|
||||
(NIL (* ; "No extension to guide us")
|
||||
(FINDFILE-WITH-EXTENSIONS FILE DIRS))
|
||||
(:COMPILED (* ;
|
||||
"Look for some sort of compiled file, or failing that a source")
|
||||
(OR (FINDFILE-WITH-EXTENSIONS FILE DIRS
|
||||
*COMPILED-EXTENSIONS*)
|
||||
(AND (NOT FORCEDEXT?)
|
||||
(FINDFILE FILE T DIRS))))
|
||||
(PROGN (* ;
|
||||
"Look for explicitly supplied extension")
|
||||
(FINDFILE (PACKFILENAME.STRING 'BODY FILE 'EXTENSION EXT)
|
||||
T DIRS]
|
||||
(FINDFILE-WITH-EXTENSIONS FILE DIRS))))
|
||||
(PROGN (* ;
|
||||
"Look for explicitly supplied extension, decoded from a previous list element.")
|
||||
(FINDFILE-WITH-EXTENSIONS (PACKFILENAME.STRING
|
||||
'BODY FILE 'EXTENSION EXT)
|
||||
DIRS]
|
||||
(NOERRORFLG (RETURN))
|
||||
((AND (SETQ FILE (CL:CERROR "Forget about loading ~A"
|
||||
"File ~A not found~@[ on~{ ~A~}~]" FILE DIRS))
|
||||
(OR (LITATOM FILE)
|
||||
(STRINGP FILE))) (* ; "User RETURNed a new file name")
|
||||
(STRINGP FILE))) (* ; "User RETURNed a new file name")
|
||||
(GO LP))
|
||||
(T (* ;
|
||||
"if proceed from ERROR, blow off loading this file")
|
||||
(T (* ;
|
||||
"if proceed from ERROR, blow off loading this file")
|
||||
(RETURN)))
|
||||
(RETURN (LIST (SELECTQ FN
|
||||
(CHECKIMPORTS (* ;
|
||||
"LOADOPTIONSFLG has a different meaning for imports")
|
||||
(CHECKIMPORTS (* ;
|
||||
"LOADOPTIONSFLG has a different meaning for imports")
|
||||
(CHECKIMPORTS FULL T)
|
||||
FULL)
|
||||
(LOAD? (* ;
|
||||
"already weeded out the ones with filedates")
|
||||
(LOAD? (* ;
|
||||
"already weeded out the ones with filedates")
|
||||
(LOAD FULL LOADOPTIONSFLG))
|
||||
(CL:FUNCALL FN FULL LOADOPTIONSFLG]
|
||||
(T (while (LISTP FILE)
|
||||
do (SELECTQ (CAR FILE)
|
||||
(LOADCOMP (SETQQ FN LOADCOMP?)
|
||||
(SETQ LOADOPTIONSFLG NIL)
|
||||
(SETQ EXT NIL))
|
||||
(LOADFROM (SETQQ FN LOADFROM)
|
||||
(SETQ EXT NIL))
|
||||
(FROM (pop FILE)
|
||||
[SETQ DIRS (MKLIST (COND
|
||||
((OR (EQ (SETQ WORD (CAR FILE))
|
||||
'VALUEOF)
|
||||
(COND
|
||||
((AND (EQ WORD 'VALUE)
|
||||
(EQ (CADR FILE)
|
||||
'OF))
|
||||
(pop FILE)
|
||||
T)))
|
||||
(LOADCOMP (SETQQ FN LOADCOMP?)
|
||||
(SETQ LOADOPTIONSFLG NIL)
|
||||
(SETQ EXT NIL))
|
||||
(LOADFROM (SETQQ FN LOADFROM)
|
||||
(SETQ EXT NIL))
|
||||
(FROM (pop FILE)
|
||||
[SETQ DIRS (MKLIST (COND
|
||||
((OR (EQ (SETQ WORD (CAR FILE))
|
||||
'VALUEOF)
|
||||
(COND
|
||||
((AND (EQ WORD 'VALUE)
|
||||
(EQ (CADR FILE)
|
||||
'OF))
|
||||
(pop FILE)
|
||||
(EVAL (CAR FILE)))
|
||||
((AND (SELCHARQ (CHCON1 WORD)
|
||||
(({ <)
|
||||
NIL)
|
||||
T)
|
||||
[BOUNDP (SETQ WORD
|
||||
(PACK* WORD 'DIRECTORIES]
|
||||
(SETQ WORD (EVALV WORD)))
|
||||
(* ;
|
||||
"KLUDGE: Turns, e.g., (FROM LISPUSERS) into (FROM VALUEOF LISPUSERSDIRECTORIES)")
|
||||
WORD)
|
||||
(T (CAR FILE])
|
||||
(COMPILED (SETQ FORCEDEXT? T)
|
||||
(SETQ EXT :COMPILED))
|
||||
(LOAD (SETQQ FN LOAD?))
|
||||
((EXTENSION EXT)
|
||||
(SETQ FILE (LISTP (CDR FILE)))
|
||||
(SETQ EXT (CAR FILE)))
|
||||
((SOURCE SYMBOLIC)
|
||||
(SETQ EXT NIL))
|
||||
(IMPORT (SETQQ FN CHECKIMPORTS)
|
||||
(SETQ EXT NIL))
|
||||
(NOERROR (SETQ NOERRORFLG T))
|
||||
(COND
|
||||
((FMEMB (CAR FILE)
|
||||
LOADOPTIONS)
|
||||
(SETQ LOADOPTIONSFLG (CAR FILE)))
|
||||
(T (* ; "invalid option in FILESLOAD")
|
||||
NIL)))
|
||||
(pop FILE))
|
||||
T)))
|
||||
(pop FILE)
|
||||
(EVAL (CAR FILE)))
|
||||
((AND (SELCHARQ (CHCON1 WORD)
|
||||
(({ <)
|
||||
NIL)
|
||||
T)
|
||||
[BOUNDP (SETQ WORD (PACK* WORD 'DIRECTORIES]
|
||||
(SETQ WORD (EVALV WORD)))
|
||||
(* ;
|
||||
"KLUDGE: Turns, e.g., (FROM LISPUSERS) into (FROM VALUEOF LISPUSERSDIRECTORIES)")
|
||||
WORD)
|
||||
(T (CAR FILE])
|
||||
(COMPILED (SETQ FORCEDEXT? T)
|
||||
(SETQ EXT :COMPILED))
|
||||
(LOAD (SETQQ FN LOAD?))
|
||||
((EXTENSION EXT)
|
||||
(SETQ FILE (LISTP (CDR FILE)))
|
||||
(SETQ EXT (CAR FILE)))
|
||||
((SOURCE SYMBOLIC)
|
||||
(SETQ EXT NIL))
|
||||
(IMPORT (SETQQ FN CHECKIMPORTS)
|
||||
(SETQ EXT NIL))
|
||||
(NOERROR (SETQ NOERRORFLG T))
|
||||
(COND
|
||||
((FMEMB (CAR FILE)
|
||||
LOADOPTIONS)
|
||||
(SETQ LOADOPTIONSFLG (CAR FILE)))
|
||||
(T (* ; "invalid option in FILESLOAD")
|
||||
NIL)))
|
||||
(pop FILE))
|
||||
NIL])
|
||||
|
||||
(FINDFILE-WITH-EXTENSIONS
|
||||
[LAMBDA (FILE DIRLST EXTENSIONS) (* ; "Edited 17-Feb-2022 23:15 by larry")
|
||||
(* ; "Edited 8-Dec-86 17:57 by bvm")
|
||||
[LAMBDA (FILE DIRLST EXTENSIONS)
|
||||
|
||||
(* ;;; "Search for FILE on the directories contained in DIRLST, where NIL and T refer to the login and connected dirs, respectively. On each directory, prefer files having extension found in EXTENSIONS in the indicated order. If FILE already has an extension, EXTENSIONS is ignored; if FILE already has a host/dir, DIRLST is ignored.")
|
||||
(* ;; "Edited 17-Mar-2022 12:05 by rmk: NIL in EXTENSIONS matches no-extension")
|
||||
|
||||
(if FILE
|
||||
then
|
||||
(PROG ((FIELDS (UNPACKFILENAME.STRING FILE))
|
||||
NM DIR&FIELDS HASDIRECTORY HASEXTENSION VAL)
|
||||
(for TAIL on FIELDS by (CDDR TAIL)
|
||||
do (SELECTQ (CAR TAIL)
|
||||
(EXTENSION (SETQ HASEXTENSION T))
|
||||
((HOST DEVICE DIRECTORY)
|
||||
(SETQ HASDIRECTORY T))
|
||||
(NAME (SETQ NM (CADR TAIL))
|
||||
[if (SETQ VAL (STRPOS "-" NM))
|
||||
then (SETQ NM (SUBSTRING NM 1 (IMINUS VAL 1])
|
||||
NIL))
|
||||
[if HASDIRECTORY
|
||||
then
|
||||
(* ;; "Don't search dirs, just look where it says")
|
||||
(* ;; "Edited 17-Feb-2022 23:15 by larry")
|
||||
|
||||
(if HASEXTENSION
|
||||
then (SETQ VAL (INFILEP FILE))
|
||||
else (for EXT in EXTENSIONS
|
||||
when [SETQ VAL (INFILEP (PACKFILENAME.STRING
|
||||
`(EXTENSION ,EXT ,@FIELDS]
|
||||
do (GO RET)))
|
||||
else
|
||||
(for DIR inside (OR DIRLST (if DIRECTORIES
|
||||
then (CONS T (REMOVE T DIRECTORIES))
|
||||
else T))
|
||||
do
|
||||
[SETQ DIR&FIELDS (SELECTQ DIR
|
||||
(NIL (* ; "Login dir")
|
||||
`(DIRECTORY ,(DIRECTORYNAME NIL)
|
||||
,@FIELDS))
|
||||
(T (* ; "Connected dir")
|
||||
FIELDS)
|
||||
`(DIRECTORY ,DIR ,@FIELDS]
|
||||
(SETQ VAL
|
||||
(if HASEXTENSION
|
||||
then (if (SETQ VAL (INFILEP (PACKFILENAME.STRING DIR&FIELDS)))
|
||||
then (GO RET))
|
||||
else
|
||||
(for EXT in EXTENSIONS
|
||||
when [SETQ VAL
|
||||
(OR [INFILEP (PACKFILENAME.STRING `(EXTENSION ,EXT ,@DIR&FIELDS]
|
||||
(AND NM DIR (NEQ DIR T)
|
||||
(NULL DIRLST)
|
||||
(INFILEP (PACKFILENAME.STRING
|
||||
`(DIRECTORY ,(CONCAT DIR ">" NM)
|
||||
EXTENSION
|
||||
,EXT
|
||||
,@FIELDS] do (GO RET]
|
||||
RET (RETURN VAL])
|
||||
(* ;; "Edited 8-Dec-86 17:57 by bvm")
|
||||
|
||||
(* ;; "Search for FILE on the directories contained in DIRLST (or DIRECTORIES), where NIL and T refer to the login and connected dirs, respectively.")
|
||||
|
||||
(* ;;; "On each directory, prefer files having extension found in EXTENSIONS in the indicated order.")
|
||||
|
||||
(* ;;; "If FILE already has an extension, EXTENSIONS is ignored.")
|
||||
|
||||
(* ;;; "If FILE already has a host/dir, DIRLST is ignored, only FILE's directory is considered.")
|
||||
|
||||
(* ;;; "For a file FOO or FOO-FIE, then for each directory DIR in DIRLST, DIRLST is interpreted also as including DIR>FOO. ")
|
||||
|
||||
(CL:WHEN FILE
|
||||
(LET ((FIELDS (UNPACKFILENAME.STRING FILE))
|
||||
NM VAL HPOS HASDIRECTORY)
|
||||
(FOR TAIL ON FIELDS BY (CDDR TAIL) DO (SELECTQ (CAR TAIL)
|
||||
(EXTENSION (SETQ EXTENSIONS (CADR TAIL)))
|
||||
((DIRECTORY HOST DEVICE RELATIVEDIRECTORY
|
||||
SUBDIRECTORY)
|
||||
(SETQ HASDIRECTORY T))
|
||||
(NAME (SETQ NM (CADR TAIL)))
|
||||
NIL))
|
||||
(CL:UNLESS EXTENSIONS
|
||||
(SETQ EXTENSIONS (CONS NIL)))
|
||||
[IF HASDIRECTORY
|
||||
THEN (SETQ DIRLST (PACKFILENAME.STRING 'NAME NIL 'EXTENSION NIL 'VERSION NIL
|
||||
'BODY FILE))
|
||||
ELSEIF DIRLST
|
||||
ELSE
|
||||
(* ;; "Default to DIRECTORIES but promote T to the beginning.")
|
||||
|
||||
(SETQ DIRLST (CONS T (REMOVE T DIRECTORIES]
|
||||
(CL:WHEN (SETQ HPOS (STRPOS "-" NM))
|
||||
(SETQ NM (SUBSTRING NM 1 (SUB1 HPOS))))
|
||||
[find DIR inside DIRLST
|
||||
suchthat (CL:WHEN (MEMB DIR '(T NIL)) (* ; "Flesh out T and NIL")
|
||||
(SETQ DIR (DIRECTORYNAME DIR)))
|
||||
|
||||
(* ;;
|
||||
"The stuff about NM is so that a file FOO-FUM will match FOO>FOO-FUM and FOO will match FOO>FOO.")
|
||||
|
||||
(find EXT inside EXTENSIONS
|
||||
suchthat (SETQ VAL
|
||||
(OR [INFILEP (PACKFILENAME.STRING `(DIRECTORY ,DIR EXTENSION
|
||||
,EXT
|
||||
,@FIELDS]
|
||||
(INFILEP (PACKFILENAME.STRING
|
||||
`(DIRECTORY ,(CONCAT DIR ">" NM)
|
||||
EXTENSION
|
||||
,EXT
|
||||
,@FIELDS]
|
||||
VAL))])
|
||||
|
||||
(READ-FILECREATED
|
||||
[LAMBDA (STREAM) (* ; "Edited 19-Sep-2020 20:39 by rmk:")
|
||||
@@ -2383,23 +2388,23 @@ This has little hope of working any more.")
|
||||
(PUTPROPS MACHINEINDEPENDENT COPYRIGHT ("Venue & Xerox Corporation" T 1983 1984 1985 1986 1987 1988
|
||||
1989 1990 1991 2021 2022))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (12807 26116 (LOAD? 12817 . 14668) (FILESLOAD 14670 . 14959) (DOFILESLOAD 14961 . 22209)
|
||||
(FINDFILE-WITH-EXTENSIONS 22211 . 25672) (READ-FILECREATED 25674 . 26114)) (26233 31554 (DMPHASH
|
||||
26243 . 27837) (HASHOVERFLOW 27839 . 31552)) (32310 63647 (BKBUFS 32320 . 33439) (CHANGENAME 33441 .
|
||||
33702) (CHNGNM 33704 . 35552) (CLBUFS 35554 . 36827) (DEFINE 36829 . 37553) (FNS.PUTDEF 37555 . 40970)
|
||||
(EQMEMB 40972 . 41154) (EQUALN 41156 . 41985) (FNCHECK 41987 . 43994) (FNTYP1 43996 . 44093) (LCSKIP
|
||||
44095 . 44939) (MAPRINT 44941 . 45887) (MKLIST 45889 . 46039) (NAMEFIELD 46041 . 47566) (NLIST 47568
|
||||
. 47903) (PRINTBELLS 47905 . 48031) (PROMPTCHAR 48033 . 49923) (RAISEP 49925 . 50186) (READFILE 50188
|
||||
. 52532) (READLINE 52534 . 57974) (REMPROPLIST 57976 . 58864) (RESETBUFS 58866 . 59316) (TAB 59318 .
|
||||
59914) (UNSAVED1 59916 . 61021) (WRITEFILE 61023 . 62765) (CLOSE-AND-MAYBE-DELETE 62767 . 63111) (
|
||||
UNSAFE.TO.MODIFY 63113 . 63645)) (65971 68915 (FILEDATE 65981 . 68913)) (69145 92884 (FILEMAP 69155 .
|
||||
69625) (\PARSE-FILE-HEADER 69627 . 73442) (GET-ENVIRONMENT-AND-FILEMAP 73444 . 75671) (
|
||||
LOOKUP-ENVIRONMENT-AND-FILEMAP 75673 . 77864) (GET-FILEMAP-FROM-FILECREATED 77866 . 78690) (
|
||||
\FILEMAP-HASHOVERFLOW 78692 . 83356) (FLUSHFILEMAPS 83358 . 83981) (LISPSOURCEFILEP 83983 . 85162) (
|
||||
GETFILEMAP 85164 . 85583) (PUTFILEMAP 85585 . 87776) (UPDATEFILEMAP 87778 . 92882)) (93550 97136 (
|
||||
LVLPRINT 93560 . 93733) (LVLPRIN1 93735 . 93917) (LVLPRIN2 93919 . 94151) (LVLPRIN 94153 . 95167) (
|
||||
LVLPRIN0 95169 . 97134)) (97170 102087 (FLUSHRIGHT 97180 . 97995) (PRINTPARA 97997 . 99095) (
|
||||
PRINTPARA1 99097 . 102085)) (102123 104408 (SUBLIS 102133 . 102741) (SUBPAIR 102743 . 103971) (DSUBLIS
|
||||
103973 . 104406)) (104431 105031 (CONSTANTOK 104441 . 105029)) (106784 107489 (NLAMBDA.ARGS 106794 .
|
||||
107487)))))
|
||||
(FILEMAP (NIL (12853 25784 (LOAD? 12863 . 14714) (FILESLOAD 14716 . 15005) (DOFILESLOAD 15007 . 22139)
|
||||
(FINDFILE-WITH-EXTENSIONS 22141 . 25340) (READ-FILECREATED 25342 . 25782)) (25901 31222 (DMPHASH
|
||||
25911 . 27505) (HASHOVERFLOW 27507 . 31220)) (31978 63315 (BKBUFS 31988 . 33107) (CHANGENAME 33109 .
|
||||
33370) (CHNGNM 33372 . 35220) (CLBUFS 35222 . 36495) (DEFINE 36497 . 37221) (FNS.PUTDEF 37223 . 40638)
|
||||
(EQMEMB 40640 . 40822) (EQUALN 40824 . 41653) (FNCHECK 41655 . 43662) (FNTYP1 43664 . 43761) (LCSKIP
|
||||
43763 . 44607) (MAPRINT 44609 . 45555) (MKLIST 45557 . 45707) (NAMEFIELD 45709 . 47234) (NLIST 47236
|
||||
. 47571) (PRINTBELLS 47573 . 47699) (PROMPTCHAR 47701 . 49591) (RAISEP 49593 . 49854) (READFILE 49856
|
||||
. 52200) (READLINE 52202 . 57642) (REMPROPLIST 57644 . 58532) (RESETBUFS 58534 . 58984) (TAB 58986 .
|
||||
59582) (UNSAVED1 59584 . 60689) (WRITEFILE 60691 . 62433) (CLOSE-AND-MAYBE-DELETE 62435 . 62779) (
|
||||
UNSAFE.TO.MODIFY 62781 . 63313)) (65639 68583 (FILEDATE 65649 . 68581)) (68813 92552 (FILEMAP 68823 .
|
||||
69293) (\PARSE-FILE-HEADER 69295 . 73110) (GET-ENVIRONMENT-AND-FILEMAP 73112 . 75339) (
|
||||
LOOKUP-ENVIRONMENT-AND-FILEMAP 75341 . 77532) (GET-FILEMAP-FROM-FILECREATED 77534 . 78358) (
|
||||
\FILEMAP-HASHOVERFLOW 78360 . 83024) (FLUSHFILEMAPS 83026 . 83649) (LISPSOURCEFILEP 83651 . 84830) (
|
||||
GETFILEMAP 84832 . 85251) (PUTFILEMAP 85253 . 87444) (UPDATEFILEMAP 87446 . 92550)) (93218 96804 (
|
||||
LVLPRINT 93228 . 93401) (LVLPRIN1 93403 . 93585) (LVLPRIN2 93587 . 93819) (LVLPRIN 93821 . 94835) (
|
||||
LVLPRIN0 94837 . 96802)) (96838 101755 (FLUSHRIGHT 96848 . 97663) (PRINTPARA 97665 . 98763) (
|
||||
PRINTPARA1 98765 . 101753)) (101791 104076 (SUBLIS 101801 . 102409) (SUBPAIR 102411 . 103639) (DSUBLIS
|
||||
103641 . 104074)) (104099 104699 (CONSTANTOK 104109 . 104697)) (106452 107157 (NLAMBDA.ARGS 106462 .
|
||||
107155)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Dec-2021 13:28:13" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>PRINTFN.;31 13158
|
||||
(FILECREATED "15-Mar-2022 00:20:04" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>PRINTFN.;33 13501
|
||||
|
||||
changes to%: (FNS PFCOPYBYTES)
|
||||
:CHANGES-TO (FNS FINDFNDEF)
|
||||
|
||||
previous date%: "17-Oct-2021 18:00:43"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>PRINTFN.;29)
|
||||
:PREVIOUS-DATE "12-Mar-2022 12:52:42"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>PRINTFN.;32)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -127,21 +127,24 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
(TERPRI DSTFIL))])
|
||||
|
||||
(FINDFNDEF
|
||||
[LAMBDA (FN FROMFILE) (* bvm%: "27-Aug-86 16:27")
|
||||
[LAMBDA (FN FROMFILE)
|
||||
|
||||
(* * "Locates FNS definition of FN on FROMFILE. If found, returns a list (file start end type); if file not found, returns symbol FILE.NOT.FOUND; if file found but not fn, returns full name of file that was found")
|
||||
(* ;; "Edited 15-Mar-2022 00:18 by rmk: Changed FINDFILE to FINDFILE-WITH-EXTENSIONS")
|
||||
(* bvm%: "27-Aug-86 16:27")
|
||||
|
||||
(* ;;; "Locates FNS definition of FN on FROMFILE. If found, returns a list (file start end type); if file not found, returns symbol FILE.NOT.FOUND; if file found but not fn, returns full name of file that was found")
|
||||
|
||||
(* * "Locates FNS definition of FN on FROMFILE. If found, returns a list (file start end type); if file not found, returns symbol FILE.NOT.FOUND; if file found but not fn, returns full name of file that was found")
|
||||
|
||||
(LET (FULL MAP VALUE)
|
||||
(COND
|
||||
((NOT (SETQ FULL (FINDFILE FROMFILE T)))
|
||||
((NOT (SETQ FULL (FINDFILE-WITH-EXTENSIONS FROMFILE)))
|
||||
'FILE.NOT.FOUND)
|
||||
[(COND
|
||||
((SETQ MAP (OR (GETFILEMAP FULL)
|
||||
(LOADFILEMAP FULL)))
|
||||
|
||||
(* First clause is quick check when the file already has a map.
|
||||
LOADFILEMAP will find file map, rebuild if necessary and rewrite it on file if
|
||||
updatemapflg is T.)
|
||||
(* ;; "First clause is quick check when the file already has a map. LOADFILEMAP will find file map, rebuild if necessary and rewrite it on file if updatemapflg is T.")
|
||||
|
||||
(AND (for GROUP in (CDR MAP) thereis (SETQ VALUE (FASSOC FN GROUP)))
|
||||
(LIST FULL (CADR VALUE)
|
||||
@@ -277,6 +280,6 @@ Copyright (c) 1986-1987, 1990, 1999, 2018, 2021 by Venue & Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS PRINTFN COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1999 2018 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1107 11292 (PF 1117 . 3812) (PF* 3814 . 4108) (PRINTFN 4110 . 4680) (PRINTFNDEF 4682 .
|
||||
5865) (FINDFNDEF 5867 . 6891) (PFCOPYBYTES 6893 . 11042) (DISPLAYP 11044 . 11290)))))
|
||||
(FILEMAP (NIL (1102 11635 (PF 1112 . 3807) (PF* 3809 . 4103) (PRINTFN 4105 . 4675) (PRINTFNDEF 4677 .
|
||||
5860) (FINDFNDEF 5862 . 7234) (PFCOPYBYTES 7236 . 11385) (DISPLAYP 11387 . 11633)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,13 +1,15 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "28-Apr-92 15:38:21" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>SPELLFILE.;4| 16123
|
||||
|
||||
changes to%: (FNS FINDFILE SPELLFILE SPELLFILE.SPELL SPELLFILE1)
|
||||
(FILECREATED "17-Mar-2022 12:13:30" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SPELLFILE.;5 16467
|
||||
|
||||
previous date%: "27-Nov-90 14:57:57" |{PELE:MV:ENVOS}<LISPCORE>SOURCES>SPELLFILE.;3|)
|
||||
:CHANGES-TO (FNS SPELLFILE FINDFILE)
|
||||
|
||||
:PREVIOUS-DATE "16-Mar-2022 20:02:22"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>SPELLFILE.;2)
|
||||
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1986, 1990, 1992 by Venue & Xerox Corporation. All rights reserved.
|
||||
Copyright (c) 1986, 1990, 1992 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT SPELLFILECOMS)
|
||||
@@ -29,7 +31,7 @@ Copyright (c) 1986, 1990, 1992 by Venue & Xerox Corporation. All rights reserve
|
||||
(DEFINEQ
|
||||
|
||||
(FINDFILE
|
||||
[LAMBDA (FILE NSFLG DIRLST) (* ; "Edited 14-Mar-91 21:54 by bvm")
|
||||
[LAMBDA (FILE NSFLG DIRLST) (* ; "Edited 14-Mar-91 21:54 by bvm")
|
||||
|
||||
(* ;; "If file has an explicit directory on it and that file exists, don't fool around with the directory packing in SPELLFILE, simply return. ")
|
||||
|
||||
@@ -40,151 +42,159 @@ Copyright (c) 1986, 1990, 1992 by Venue & Xerox Corporation. All rights reserve
|
||||
(T (SPELLFILE FILE T NSFLG DIRLST])
|
||||
|
||||
(SPELLFILE
|
||||
[LAMBDA (FILE NOPRINTFLG NSFLG DIRLST) (* ; "Edited 27-Nov-90 14:13 by nm")
|
||||
[LAMBDA (FILE NOPRINTFLG NSFLG DIRLST)
|
||||
|
||||
(* ;; "Edited 17-Mar-2022 12:13 by rmk: added FINDFILE-WITH-EXTENSIONS at the top, for FILE-NOT-FOUND and FINDFILE")
|
||||
|
||||
(* ;; "Edited 27-Nov-90 14:13 by nm")
|
||||
|
||||
(DECLARE (SPECVARS NAME EXTENSION VERSION SPELLVAL DIRHOSTS HOST)
|
||||
(GLOBALVARS \FILEDEVICENAMES))
|
||||
(PROG (SPELLVAL VAL DIRHOSTS HOST DEVICE DIRECTORY RELATIVEDIRECTORY SUBDIRECTORY NAME EXTENSION
|
||||
VERSION FILEDATES (FIELDS (UNPACKFILENAME.STRING FILE))
|
||||
(DIRS (OR DIRLST DIRECTORIES))
|
||||
(APPFLG 'MUST-APPROVE)
|
||||
(NSFLG (OR NSFLG NOSPELLFLG (NULL DWIMFLG)))
|
||||
(ROOTNAME FILE))
|
||||
(OR FILE (RETURN))
|
||||
FLDLP
|
||||
(COND
|
||||
(FIELDS (SELECTQ (CAR FIELDS)
|
||||
(NAME (SETQ NAME (CADR FIELDS)))
|
||||
(VERSION (SETQ VERSION (CADR FIELDS)))
|
||||
(EXTENSION (SETQ EXTENSION (CADR FIELDS)))
|
||||
(DIRECTORY (SETQ DIRECTORY (CADR FIELDS)))
|
||||
(RELATIVEDIRECTORY
|
||||
(SETQ RELATIVEDIRECTORY (CADR FIELDS)))
|
||||
(SUBDIRECTORY (SETQ SUBDIRECTORY (CADR FIELDS)))
|
||||
(HOST (SETQ HOST (CADR FIELDS)))
|
||||
(DEVICE
|
||||
(* ;;
|
||||
"Pseudo-devices FOO: can be used to denote a list of directories")
|
||||
|
||||
(OR [AND (NULL DEVICE)
|
||||
(NULL DIRECTORY)
|
||||
(SETQ DIRS (GETPROP (SETQ DEVICE (CADR FIELDS))
|
||||
'DIRECTORIES]
|
||||
(RETURN)))
|
||||
(RETURN))
|
||||
(SETQ FIELDS (CDDR FIELDS))
|
||||
(GO FLDLP)))
|
||||
[AND HOST (COND
|
||||
((HOSTNAMEP HOST))
|
||||
([AND (NOT NSFLG)
|
||||
(SETQ HOST (FIXSPELL HOST NIL \FILEDEVICENAMES 'NO-MESSAGE]
|
||||
(AND (SETQ VAL (INFILEP (PACKFILENAME.STRING 'HOST HOST 'BODY FILE)))
|
||||
(GO RET)))
|
||||
(T (* ;
|
||||
"It is pointless to go on if we don't have a valid host.")
|
||||
(RETURN NIL]
|
||||
[COND
|
||||
((OR HOST DEVICE DIRECTORY RELATIVEDIRECTORY SUBDIRECTORY VERSION)
|
||||
(* ;; "This does the FOO to FOO>FOO correction, with only directory scanning and no other transformations.")
|
||||
|
||||
(* ;; "ROOTNAME is what fixspell gets called on. important that extra characters get stripped out so that spelling corrector metric is applied to what is really being corrected, otherwise, e.g. with directory supplied, any two short names will match")
|
||||
|
||||
(SETQ ROOTNAME (MKATOM (PACKFILENAME 'NAME NAME 'EXTENSION EXTENSION]
|
||||
[COND
|
||||
([AND (NEQ ROOTNAME FILE)
|
||||
(NULL DIRLST)
|
||||
(SETQ FILEDATES (GETPROP ROOTNAME 'FILEDATES))
|
||||
(SETQ SPELLVAL (OR (INFILEP ROOTNAME)
|
||||
(AND VERSION (OR DIRECTORY HOST)
|
||||
(INFILEP (PACKFILENAME.STRING 'DIRECTORY DIRECTORY
|
||||
'RELATIVEDIRECTORY RELATIVEDIRECTORY
|
||||
'SUBDIRECTORY SUBDIRECTORY 'HOST HOST
|
||||
'NAME NAME 'EXTENSION EXTENSION]
|
||||
(OR (FINDFILE-WITH-EXTENSIONS FILE DIRLST)
|
||||
(PROG (SPELLVAL VAL DIRHOSTS HOST DEVICE DIRECTORY RELATIVEDIRECTORY SUBDIRECTORY NAME
|
||||
EXTENSION VERSION FILEDATES (FIELDS (UNPACKFILENAME.STRING FILE))
|
||||
(DIRS (OR DIRLST DIRECTORIES))
|
||||
(APPFLG 'MUST-APPROVE)
|
||||
(NSFLG (OR NSFLG NOSPELLFLG (NULL DWIMFLG)))
|
||||
(ROOTNAME FILE)
|
||||
(NAMESUBDIR))
|
||||
(OR FILE (RETURN))
|
||||
FLDLP
|
||||
(COND
|
||||
([for X in FILEDATES thereis (AND (OR (EQ (CDR X)
|
||||
SPELLVAL)
|
||||
(EQ (CDR X)
|
||||
FILE))
|
||||
(STREQUAL (CAR X)
|
||||
(FILEDATE SPELLVAL]
|
||||
(FIELDS (SELECTQ (CAR FIELDS)
|
||||
(NAME (SETQ NAME (CADR FIELDS)))
|
||||
(VERSION (SETQ VERSION (CADR FIELDS)))
|
||||
(EXTENSION (SETQ EXTENSION (CADR FIELDS)))
|
||||
(DIRECTORY (SETQ DIRECTORY (CADR FIELDS)))
|
||||
(RELATIVEDIRECTORY
|
||||
(SETQ RELATIVEDIRECTORY (CADR FIELDS)))
|
||||
(SUBDIRECTORY (SETQ SUBDIRECTORY (CADR FIELDS)))
|
||||
(HOST (SETQ HOST (CADR FIELDS)))
|
||||
(DEVICE
|
||||
(* ;;
|
||||
"Pseudo-devices FOO: can be used to denote a list of directories")
|
||||
|
||||
(* ;; "attacks problem where sombody wants a specific file, e.g. makefile wants the source, the file is around, but with a different verson number, e.g. was ftped from maxc, and user didnt loadfrom symbolic but instead just started editing with compiled file having been loaded. This is a rare case; users should LOADFROM! Also, since we don't know where this fully-qualified name came from, we must ask for correction.")
|
||||
(OR [AND (NULL DEVICE)
|
||||
(NULL DIRECTORY)
|
||||
(SETQ DIRS (GETPROP (SETQ DEVICE (CADR FIELDS))
|
||||
'DIRECTORIES]
|
||||
(RETURN)))
|
||||
(RETURN))
|
||||
(SETQ FIELDS (CDDR FIELDS))
|
||||
(GO FLDLP)))
|
||||
[AND HOST (COND
|
||||
((HOSTNAMEP HOST))
|
||||
([AND (NOT NSFLG)
|
||||
(SETQ HOST (FIXSPELL HOST NIL \FILEDEVICENAMES 'NO-MESSAGE]
|
||||
(AND (SETQ VAL (INFILEP (PACKFILENAME.STRING 'HOST HOST 'BODY FILE)))
|
||||
(GO RET)))
|
||||
(T (* ;
|
||||
"It is pointless to go on if we don't have a valid host.")
|
||||
(RETURN NIL]
|
||||
[COND
|
||||
((OR HOST DEVICE DIRECTORY RELATIVEDIRECTORY SUBDIRECTORY VERSION)
|
||||
|
||||
(SETQ VAL SPELLVAL) (* ;
|
||||
"works by looking to see if latest verson of rootname in fact has same filedate as requested file.")
|
||||
(GO RET]
|
||||
[COND
|
||||
[DIRECTORY (COND
|
||||
((DIRECTORYNAMEP DIRECTORY HOST) (* ;
|
||||
"User supplied directory is valid")
|
||||
(GO SPELLNAME)))
|
||||
(* ;; "ROOTNAME is what fixspell gets called on. important that extra characters get stripped out so that spelling corrector metric is applied to what is really being corrected, otherwise, e.g. with directory supplied, any two short names will match")
|
||||
|
||||
(* ;; "Try to spelling correct directory with hostname stripped off for spelling metric. If HOST, then only consider directories on that host. Otherwise, keep a list of the hosts associated with the host-free directories.")
|
||||
(SETQ ROOTNAME (MKATOM (PACKFILENAME 'NAME NAME 'EXTENSION EXTENSION]
|
||||
[COND
|
||||
([AND (NEQ ROOTNAME FILE)
|
||||
(NULL DIRLST)
|
||||
(SETQ FILEDATES (GETPROP ROOTNAME 'FILEDATES))
|
||||
(SETQ SPELLVAL (OR (INFILEP ROOTNAME)
|
||||
(AND VERSION (OR DIRECTORY HOST)
|
||||
(INFILEP (PACKFILENAME.STRING 'DIRECTORY DIRECTORY
|
||||
'RELATIVEDIRECTORY RELATIVEDIRECTORY
|
||||
'SUBDIRECTORY SUBDIRECTORY
|
||||
'HOST HOST 'NAME NAME 'EXTENSION
|
||||
EXTENSION]
|
||||
(COND
|
||||
([for X in FILEDATES thereis (AND (OR (EQ (CDR X)
|
||||
SPELLVAL)
|
||||
(EQ (CDR X)
|
||||
FILE))
|
||||
(STREQUAL (CAR X)
|
||||
(FILEDATE SPELLVAL]
|
||||
|
||||
(COND
|
||||
([AND (NOT NSFLG)
|
||||
(SETQ DIRS (SPELLFILE.MATCHINGDIRS DIRS HOST))
|
||||
(SETQ VAL (FIXSPELL DIRECTORY NIL DIRS 'NO-MESSAGE NIL
|
||||
(FUNCTION (LAMBDA (DIR)
|
||||
(* ;; "attacks problem where sombody wants a specific file, e.g. makefile wants the source, the file is around, but with a different verson number, e.g. was ftped from maxc, and user didnt loadfrom symbolic but instead just started editing with compiled file having been loaded. This is a rare case; users should LOADFROM! Also, since we don't know where this fully-qualified name came from, we must ask for correction.")
|
||||
|
||||
(SETQ VAL SPELLVAL) (* ;
|
||||
"works by looking to see if latest verson of rootname in fact has same filedate as requested file.")
|
||||
(GO RET]
|
||||
[COND
|
||||
[DIRECTORY (COND
|
||||
((DIRECTORYNAMEP DIRECTORY HOST)
|
||||
(* ; "User supplied directory is valid")
|
||||
(GO SPELLNAME)))
|
||||
|
||||
(* ;; "Try to spelling correct directory with hostname stripped off for spelling metric. If HOST, then only consider directories on that host. Otherwise, keep a list of the hosts associated with the host-free directories.")
|
||||
|
||||
(COND
|
||||
([AND (NOT NSFLG)
|
||||
(SETQ DIRS (SPELLFILE.MATCHINGDIRS DIRS HOST))
|
||||
(SETQ VAL (FIXSPELL DIRECTORY NIL DIRS 'NO-MESSAGE NIL
|
||||
(FUNCTION (LAMBDA (DIR)
|
||||
(* ;
|
||||
"Check file only for directories that are close enough")
|
||||
(AND (SETQ DIR (SPELLFILEDIR DIR))
|
||||
(RETFROM 'FIXSPELL DIR]
|
||||
(GO RET))
|
||||
(T (RETURN]
|
||||
(T
|
||||
(* ;; "Here if directory wasn't specified in the filename. Search only directories on DIRS which match HOST, if specified.")
|
||||
"Check file only for directories that are close enough")
|
||||
(AND (SETQ DIR (SPELLFILEDIR DIR))
|
||||
(RETFROM 'FIXSPELL DIR]
|
||||
(GO RET))
|
||||
(T (RETURN]
|
||||
((FINDFILE-WITH-EXTENSIONS))
|
||||
(T
|
||||
(* ;; "Here if directory wasn't specified in the filename. Search only directories on DIRS which match HOST, if specified.")
|
||||
|
||||
(for DIR in DIRS when [PROGN (SELECTQ DIR
|
||||
((NIL T)
|
||||
(SETQ DIR (DIRECTORYNAME DIR T)))
|
||||
NIL)
|
||||
(AND [OR (NULL HOST)
|
||||
(STREQUAL HOST (LISTGET
|
||||
(
|
||||
(for DIR in DIRS when [PROGN (SELECTQ DIR
|
||||
((NIL T)
|
||||
(SETQ DIR (DIRECTORYNAME DIR T)))
|
||||
NIL)
|
||||
(AND [OR (NULL HOST)
|
||||
(STREQUAL HOST (LISTGET (
|
||||
UNPACKFILENAME.STRING
|
||||
DIR)
|
||||
'HOST]
|
||||
(SETQ VAL (INFILEP (PACKFILENAME.STRING
|
||||
'DIRECTORY DIR
|
||||
'RELATIVEDIRECTORY
|
||||
RELATIVEDIRECTORY
|
||||
'SUBDIRECTORY
|
||||
SUBDIRECTORY
|
||||
'NAME NAME
|
||||
'EXTENSION
|
||||
EXTENSION
|
||||
'VERSION VERSION]
|
||||
do [SETQ APPFLG (COND
|
||||
'HOST]
|
||||
(SETQ VAL (INFILEP (PACKFILENAME.STRING
|
||||
'DIRECTORY DIR
|
||||
'RELATIVEDIRECTORY
|
||||
RELATIVEDIRECTORY
|
||||
'SUBDIRECTORY SUBDIRECTORY
|
||||
'NAME NAME 'EXTENSION
|
||||
EXTENSION 'VERSION VERSION]
|
||||
do [SETQ APPFLG (COND
|
||||
(NOPRINTFLG 'NO-MESSAGE)
|
||||
(T 'NEEDNOTAPPROVE]
|
||||
(GO RET]
|
||||
(COND
|
||||
([AND (NULL DIRLST)
|
||||
[LISTP (SETQ VAL (GETPROP FILE 'FILEDATES]
|
||||
(FMEMB [CDR (LISTP (CAR (LISTP (GETPROP FILE 'FILE]
|
||||
'(LOADFNS T))
|
||||
(LITATOM (CDAR VAL))
|
||||
(SETQ VAL (INFILEP (PACKFILENAME.STRING 'VERSION NIL 'BODY (CDAR VAL]
|
||||
[SETQ APPFLG (COND
|
||||
(NOPRINTFLG 'NO-MESSAGE)
|
||||
(T 'NEEDNOTAPPROVE]
|
||||
(GO RET)))
|
||||
SPELLNAME
|
||||
(COND
|
||||
([OR NSFLG (NOT (SETQ VAL (SPELLFILE.SPELL HOST DIRECTORY NAME EXTENSION VERSION
|
||||
ROOTNAME RELATIVEDIRECTORY SUBDIRECTORY]
|
||||
(RETURN)))
|
||||
(GO RET]
|
||||
(COND
|
||||
([AND (NULL DIRLST)
|
||||
[LISTP (SETQ VAL (GETPROP FILE 'FILEDATES]
|
||||
(FMEMB [CDR (LISTP (CAR (LISTP (GETPROP FILE 'FILE]
|
||||
'(LOADFNS T))
|
||||
(LITATOM (CDAR VAL))
|
||||
(SETQ VAL (INFILEP (PACKFILENAME.STRING 'VERSION NIL 'BODY (CDAR VAL]
|
||||
[SETQ APPFLG (COND
|
||||
(NOPRINTFLG 'NO-MESSAGE)
|
||||
(T 'NEEDNOTAPPROVE]
|
||||
(GO RET)))
|
||||
SPELLNAME
|
||||
(COND
|
||||
([OR NSFLG (NOT (SETQ VAL (SPELLFILE.SPELL HOST DIRECTORY NAME EXTENSION VERSION
|
||||
ROOTNAME RELATIVEDIRECTORY SUBDIRECTORY]
|
||||
(RETURN)))
|
||||
|
||||
(* ;; "SPELLFILE1 and hence FIXSPELL return name without host/directory, since matching against ROOTNAME; hence, the packfilename below")
|
||||
(* ;; "SPELLFILE1 and hence FIXSPELL return name without host/directory, since matching against ROOTNAME; hence, the packfilename below")
|
||||
|
||||
[COND
|
||||
((NEQ FILE ROOTNAME)
|
||||
(SETQ VAL (MKATOM (PACKFILENAME 'BODY VAL 'HOST HOST 'DIRECTORY DIRECTORY
|
||||
'RELATIVEDIRECTORY RELATIVEDIRECTORY 'SUBDIRECTORY
|
||||
SUBDIRECTORY 'VERSION VERSION]
|
||||
RET (RETURN (AND (OR (EQ APPFLG 'NO-MESSAGE)
|
||||
(FIXSPELL1 FILE VAL (EQ APPFLG 'MUST-APPROVE)
|
||||
NIL APPFLG))
|
||||
VAL])
|
||||
[COND
|
||||
((NEQ FILE ROOTNAME)
|
||||
(SETQ VAL (MKATOM (PACKFILENAME 'BODY VAL 'HOST HOST 'DIRECTORY DIRECTORY
|
||||
'RELATIVEDIRECTORY RELATIVEDIRECTORY 'SUBDIRECTORY
|
||||
SUBDIRECTORY 'VERSION VERSION]
|
||||
RET (RETURN (AND (OR (EQ APPFLG 'NO-MESSAGE)
|
||||
(FIXSPELL1 FILE VAL (EQ APPFLG 'MUST-APPROVE)
|
||||
NIL APPFLG))
|
||||
VAL])
|
||||
|
||||
(SPELLFILE.MATCHINGDIRS
|
||||
(LAMBDA (DIRS HOST) (* bvm%: "26-DEC-81 17:01") (COND (HOST (for DIR DHOST in DIRS when (EQ HOST (LISTGET (SETQ DIR (OR (LISTP DIR) (UNPACKFILENAME (SELECTQ DIR ((NIL T) (DIRECTORYNAME DIR T)) DIR)))) (QUOTE HOST))) collect (LISTGET DIR (QUOTE DIRECTORY)))) (T (for DIR UDIR DHOST in DIRS unless (PROG1 (MEMB (SETQ DIR (LISTGET (SETQ UDIR (OR (LISTP DIR) (UNPACKFILENAME (SELECTQ DIR ((NIL T) (DIRECTORYNAME DIR T)) DIR)))) (QUOTE DIRECTORY))) $$VAL) (AND (SETQ DHOST (LISTGET UDIR (QUOTE HOST))) (NCONC1 (OR (FASSOC DIR DIRHOSTS) (CAR (push DIRHOSTS (CONS DIR)))) DHOST))) collect DIR))))
|
||||
@@ -257,13 +267,13 @@ Copyright (c) 1986, 1990, 1992 by Venue & Xerox Corporation. All rights reserve
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(ADDTOVAR ERRORTYPELST (23 (SPELLFILE (CADR ERRORMESS)
|
||||
NIL NOFILESPELLFLG)))
|
||||
NIL NOFILESPELLFLG)))
|
||||
)
|
||||
|
||||
(ADDTOVAR DIRECTORIES )
|
||||
(PUTPROPS SPELLFILE COPYRIGHT ("Venue & Xerox Corporation" 1986 1990 1992))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (993 15750 (FINDFILE 1003 . 1452) (SPELLFILE 1454 . 10927) (SPELLFILE.MATCHINGDIRS 10929
|
||||
. 11548) (SPELLFILE.SPELL 11550 . 12964) (SPELLFILE.SPELL1 12966 . 13735) (SPELLFILE1 13737 . 15125)
|
||||
(SPELLFILEDIR 15127 . 15748)))))
|
||||
(FILEMAP (NIL (983 16098 (FINDFILE 993 . 1446) (SPELLFILE 1448 . 11275) (SPELLFILE.MATCHINGDIRS 11277
|
||||
. 11896) (SPELLFILE.SPELL 11898 . 13312) (SPELLFILE.SPELL1 13314 . 14083) (SPELLFILE1 14085 . 15473)
|
||||
(SPELLFILEDIR 15475 . 16096)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
@@ -1,11 +1,11 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "20-Dec-2021 23:47:45" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>WINDOWOBJ.;5 27781
|
||||
(FILECREATED "17-Mar-2022 22:48:26" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>WINDOWOBJ.;7 27963
|
||||
|
||||
:CHANGES-TO (FNS COPYINSERT)
|
||||
:CHANGES-TO (FNS READIMAGEOBJ)
|
||||
|
||||
:PREVIOUS-DATE "18-Dec-2021 20:09:33"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>WINDOWOBJ.;3)
|
||||
:PREVIOUS-DATE "20-Dec-2021 23:47:45"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>WINDOWOBJ.;5)
|
||||
|
||||
|
||||
(* ; "
|
||||
@@ -313,55 +313,51 @@ Copyright (c) 1986-1987, 1990-1991, 1993 by Venue & Xerox Corporation.
|
||||
of FROM])
|
||||
|
||||
(READIMAGEOBJ
|
||||
[LAMBDA (STREAM GETFN NOERROR DATANBYTES) (* rrb "18-Mar-86 11:35")
|
||||
[LAMBDA (STREAM GETFN NOERROR DATANBYTES)
|
||||
|
||||
(* ;; "Edited 17-Mar-2022 22:47 by rmk: Added WHEREIS as a last resort.")
|
||||
(* rrb "18-Mar-86 11:35")
|
||||
(DECLARE (SPECVARS UNDERREADIMAGEOBJ))
|
||||
|
||||
(* ;; "Reads an IMAGEOBJ, using GETFN. Verifies that the GETFN is legitimate")
|
||||
|
||||
(* ;; "the variable UNDERREADIMAGEOBJ is used in HVBAKREAD to determine if it should do a validity check on the function which is read from the file.")
|
||||
|
||||
(LET* ((ENTRY (ASSOC GETFN IMAGEOBJGETFNS))
|
||||
(SUPPORTFILE (LISTGET (CDR ENTRY)
|
||||
'FILE))
|
||||
(UNDERREADIMAGEOBJ T))
|
||||
[COND
|
||||
((OR (NOT GETFN)
|
||||
(NOT (GETD GETFN))
|
||||
(NOT ENTRY))
|
||||
(* ;; "rmk: I'm not sure that it makes sense for GETFN to be NIL, as 86 code allowed. Presumably an image object without a GETFN should never have been written.")
|
||||
|
||||
(* ;; "This function wasn't specified in the IMAGEOBJTYPES list, or isn't defined. Try loading the support file.")
|
||||
(LET (SUPPORTFILE (UNDERREADIMAGEOBJ T))
|
||||
(DECLARE (SPECVARS UNDERREADIMAGEOBJ))
|
||||
|
||||
(COND
|
||||
((AND SUPPORTFILE (MOUSECONFIRM (CONCAT "Trying to read an IMAGEOBJ with GETFN "
|
||||
GETFN ". Shall I load the support file, "
|
||||
SUPPORTFILE "?")
|
||||
NIL NIL NIL)) (* ;
|
||||
"Ask if the user wants to load the support file.")
|
||||
(DOFILESLOAD (LIST SUPPORTFILE)) (* ; "LOAD the file")
|
||||
]
|
||||
(COND
|
||||
[(OR (NOT GETFN)
|
||||
(NOT (GETD GETFN))
|
||||
(NOT (ASSOC GETFN IMAGEOBJGETFNS))) (* ;
|
||||
"Still no support for this kind of IMAGEOBJ. Encapsulate it in something safe.")
|
||||
(COND
|
||||
(NOERROR (* ;
|
||||
"The caller doesn't want errors if there's a failure.")
|
||||
NIL)
|
||||
(T (LET* [(OBJ (IMAGEOBJCREATE NIL (ENCAPSULATEDIMAGEFNS GETFN]
|
||||
(* ; "Build an ENCAPSULATED imageobj.")
|
||||
(IMAGEOBJPROP OBJ 'FILE (FULLNAME STREAM)
|
||||
STREAM) (* ;
|
||||
"Remember which file it came from so that it could be written back out.")
|
||||
(IMAGEOBJPROP OBJ 'FILEPTR (GETFILEPTR STREAM))
|
||||
(IMAGEOBJPROP OBJ 'OBJSIZE DATANBYTES)
|
||||
(* ;; "Typically,the file containing the GETFN has already been loaded. If not, it could be the case that the GETFN and its file were pushed on the list for future reference (now), but the file wasn't loaded then. We need to download it. Or if not there or not there with a file, and we can find the file containing the GETFN in the WHEREIS database, load that file.")
|
||||
|
||||
(* ;; "If we find the file with the GETFN but that file doesn't also contain the IMAGEFNS variable, we're screwed. That's why we apply the GETFN under an NLSETQ")
|
||||
|
||||
(CL:WHEN (AND GETFN (NOT (GETD GETFN))
|
||||
[SETQ SUPPORTFILE (OR (LISTGET (CDR (ASSOC GETFN IMAGEOBJGETFNS))
|
||||
'FILE)
|
||||
(CAR (WHEREIS GETFN 'FNS T))
|
||||
(CAR (WHEREIS GETFN 'FUNCTIONS T]
|
||||
(MOUSECONFIRM (CONCAT "Trying to read an IMAGEOBJ with GETFN " GETFN
|
||||
". Shall I load the support file, " SUPPORTFILE "?")
|
||||
NIL NIL NIL))
|
||||
(DOFILESLOAD (LIST SUPPORTFILE)))
|
||||
(COND
|
||||
[(AND GETFN (GETD GETFN)
|
||||
(CAR (NLSETQ (APPLY* GETFN STREAM]
|
||||
(NOERROR NIL)
|
||||
(T (* ;
|
||||
"Still no support for this kind of IMAGEOBJ. Encapsulate it in something safe.")
|
||||
(LET [(OBJ (IMAGEOBJCREATE NIL (ENCAPSULATEDIMAGEFNS GETFN]
|
||||
(IMAGEOBJPROP OBJ 'FILE (FULLNAME STREAM)
|
||||
STREAM) (* ;
|
||||
"Remember which file it came from so that it could be written back out.")
|
||||
(IMAGEOBJPROP OBJ 'FILEPTR (GETFILEPTR STREAM))
|
||||
(* ; "And where on the file")
|
||||
(IMAGEOBJPROP OBJ 'UNKNOWNGETFN GETFN)
|
||||
(AND DATANBYTES (SETFILEPTR STREAM (PLUS (GETFILEPTR STREAM)
|
||||
DATANBYTES)))
|
||||
(* ; "And the name of its GETFN")
|
||||
OBJ]
|
||||
(T (APPLY* GETFN STREAM])
|
||||
(IMAGEOBJPROP OBJ 'OBJSIZE DATANBYTES)
|
||||
(IMAGEOBJPROP OBJ 'UNKNOWNGETFN GETFN) (* ; "And the name of its GETFN")
|
||||
(AND DATANBYTES (SETFILEPTR STREAM (PLUS (GETFILEPTR STREAM)
|
||||
DATANBYTES)))
|
||||
OBJ])
|
||||
|
||||
(WRITEIMAGEOBJ
|
||||
[LAMBDA (IMAGEOBJ STREAM) (* jds "19-Feb-85 09:36")
|
||||
@@ -531,11 +527,11 @@ Either delete this image object or load its support files." IMAGEOBJ)
|
||||
)
|
||||
(PUTPROPS WINDOWOBJ COPYRIGHT ("Venue & Xerox Corporation" 1986 1987 1990 1991 1993))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (4895 20996 (COPYINSERT 4905 . 6432) (IMAGEBOX 6434 . 6614) (IMAGEFNSCREATE 6616 . 7811)
|
||||
(IMAGEFNSP 7813 . 8054) (IMAGEOBJCREATE 8056 . 8601) (IMAGEOBJP 8603 . 8844) (IMAGEOBJPROP 8846 .
|
||||
14738) (\IMAGEUSERPROP 14740 . 15334) (HPRINT.IMAGEOBJ 15336 . 15925) (COPYIMAGEOBJ 15927 . 16670) (
|
||||
READIMAGEOBJ 16672 . 19642) (WRITEIMAGEOBJ 19644 . 20994)) (21210 27417 (
|
||||
ENCAPSULATEDOBJ.BUTTONEVENTINFN 21220 . 22356) (ENCAPSULATEDOBJ.PUTFN 22358 . 23473) (
|
||||
ENCAPSULATEDOBJ.DISPLAYFN 23475 . 25088) (ENCAPSULATEDOBJ.IMAGEBOXFN 25090 . 25978) (
|
||||
ENCAPSULATEDIMAGEFNS 25980 . 27415)))))
|
||||
(FILEMAP (NIL (4897 21178 (COPYINSERT 4907 . 6434) (IMAGEBOX 6436 . 6616) (IMAGEFNSCREATE 6618 . 7813)
|
||||
(IMAGEFNSP 7815 . 8056) (IMAGEOBJCREATE 8058 . 8603) (IMAGEOBJP 8605 . 8846) (IMAGEOBJPROP 8848 .
|
||||
14740) (\IMAGEUSERPROP 14742 . 15336) (HPRINT.IMAGEOBJ 15338 . 15927) (COPYIMAGEOBJ 15929 . 16672) (
|
||||
READIMAGEOBJ 16674 . 19824) (WRITEIMAGEOBJ 19826 . 21176)) (21392 27599 (
|
||||
ENCAPSULATEDOBJ.BUTTONEVENTINFN 21402 . 22538) (ENCAPSULATEDOBJ.PUTFN 22540 . 23655) (
|
||||
ENCAPSULATEDOBJ.DISPLAYFN 23657 . 25270) (ENCAPSULATEDOBJ.IMAGEBOXFN 25272 . 26160) (
|
||||
ENCAPSULATEDIMAGEFNS 26162 . 27597)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user