1
0
mirror of synced 2026-01-27 12:52:06 +00:00

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
2022-04-23 21:36:23 -07:00
committed by GitHub
parent f9f1038efb
commit 1eccc2e59b
37 changed files with 821 additions and 773 deletions

View File

@@ -1,13 +1,13 @@
(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL")
(IL:FILECREATED "13-Jun-90 01:24:39" IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;2| 17489
(DEFINE-FILE-INFO PACKAGE "XEROX-COMMON-LISP" READTABLE "XCL" BASE 10)
IL:|changes| IL:|to:| (IL:VARS IL:WHERE-ISCOMS)
(IL:FILECREATED "11-Mar-2022 22:40:32" 
IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>WHERE-IS.;2| 17501
IL:|previous| IL:|date:| " 6-Jun-88 18:42:35"
IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
:PREVIOUS-DATE "13-Jun-90 01:24:39"
IL:|{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>WHERE-IS.;1|)
; Copyright (c) 1987, 1988, 1990 by Venue & Xerox Corporation. All rights reserved.
; Copyright (c) 1987-1988, 1990 by Venue & Xerox Corporation.
(IL:PRETTYCOMPRINT IL:WHERE-ISCOMS)
@@ -17,7 +17,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(REQUIRE "CASH-FILE" "CASH-FILE.DFASL"))
(IL:COMS
(IL:* IL:|;;| "run time code")
(IL:* IL:|;;| "run time code")
(IL:FUNCTIONS HASH-FILE-WHERE-IS HASH-FILE-TYPES-OF GET-WHERE-IS-ENTRIES
WHERE-IS-READ-FN ADD-WHERE-IS-DATABASES ADD-WHERE-IS-DATABASE
@@ -26,7 +26,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(IL:VARIABLES *WHERE-IS-CASH-FILES* *WHERE-IS-CASH-SIZE*))
(IL:COMS
(IL:* IL:|;;| "notice time code")
(IL:* IL:|;;| "notice time code")
(IL:FUNCTIONS WHERE-IS-NOTICE WHERE-IS-NOTICE-INTERNAL WHERE-IS-FILES
WHERE-IS-DEFAULT-DEFINE-TYPES WHERE-IS-NAMESTRING WHERE-IS-READ-COMS
@@ -48,16 +48,16 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(DEFUN HASH-FILE-WHERE-IS (NAME TYPE)
(IL:* IL:|;;| "return a list of file names containing NAME of TYPE ")
(IL:* IL:|;;| "return a list of file names containing NAME of TYPE ")
(REMOVE-DUPLICATES (MAPCAN #'(LAMBDA (ENTRY)
(CDR (ASSOC TYPE ENTRY)))
(GET-WHERE-IS-ENTRIES NAME))
(GET-WHERE-IS-ENTRIES NAME))
:TEST
'STRING=))
(DEFUN HASH-FILE-TYPES-OF (NAME &OPTIONAL (POSSIBLE-TYPES (WHERE-IS-DEFAULT-DEFINE-TYPES)))
(LET ((ENTRIES (GET-WHERE-IS-ENTRIES NAME))
(DEFUN HASH-FILE-TYPES-OF (NAME &OPTIONAL (POSSIBLE-TYPES (WHERE-IS-DEFAULT-DEFINE-TYPES)))
(LET ((ENTRIES (GET-WHERE-IS-ENTRIES NAME))
(TYPES NIL))
(DOLIST (TYPE POSSIBLE-TYPES)
(DOLIST (ENTRY ENTRIES)
@@ -68,7 +68,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(DEFUN GET-WHERE-IS-ENTRIES (NAME)
(IL:* IL:|;;| "return a list of all entries for name in *WHERE-IS-CASH-FILES*")
(IL:* IL:|;;| "return a list of all entries for name in *WHERE-IS-CASH-FILES*")
(MAPLIST #'(LAMBDA (TAIL)
(LET ((DATABASE (CAR TAIL)))
@@ -81,8 +81,8 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(HASH-FILE (CASH-FILE:CASH-FILE-HASH-FILE
CASH-FILE)))
(IL:* IL:|;;|
 "install our read function in hash file")
(IL:* IL:|;;|
 "install our read function in hash file")
(SETF (HASH-FILE::HASH-FILE-KEY-READ-FN
HASH-FILE)
@@ -91,29 +91,29 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
HASH-FILE)
#'WHERE-IS-READ-FN)
(IL:* IL:|;;|
 "smash CASH-FILE into *WHERE-IS-CASH-FILES*")
(IL:* IL:|;;|
 "smash CASH-FILE into *WHERE-IS-CASH-FILES*")
(SETF (CAR TAIL)
CASH-FILE))))
(NIL NIL :REPORT "Delete from the databases known to WHERE-IS?"
(DEL-WHERE-IS-DATABASE DATABASE)
(DEL-WHERE-IS-DATABASE DATABASE)
NIL))))
*WHERE-IS-CASH-FILES*))
(DEFUN WHERE-IS-READ-FN (STREAM)
(IL:* IL:|;;;| "the :KEY-READ-FN & :VALUE-READ-FN for WHERE-IS hash files.")
(IL:* IL:|;;;| "the :KEY-READ-FN & :VALUE-READ-FN for WHERE-IS hash files.")
(HANDLER-CASE
(IL:* IL:|;;| "use the default read function")
(IL:* IL:|;;| "use the default read function")
(HASH-FILE::DEFAULT-READ-FN STREAM)
(IL:* IL:|;;| "Quietly handle MISSING-PACKAGE errors by returning the condition.")
(IL:* IL:|;;| "Quietly handle MISSING-PACKAGE errors by returning the condition.")
(IL:* IL:|;;| "This allows us to have files in our database which we havn't loaded.")
(IL:* IL:|;;| "This allows us to have files in our database which we havn't loaded.")
(MISSING-PACKAGE (CONDITION)
CONDITION)))
@@ -126,18 +126,18 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
"add PATHNAME to the databases known to WHERE-IS"
(LET ((NEW-PATHNAME (PATHNAME PATHNAME)))
(IL:* IL:|;;| "first delete & close the old one (if any)")
(IL:* IL:|;;| "first delete & close the old one (if any)")
(DEL-WHERE-IS-DATABASE NEW-PATHNAME)
(DEL-WHERE-IS-DATABASE NEW-PATHNAME)
(IL:* IL:|;;| "now add the new one")
(IL:* IL:|;;| "now add the new one")
(PUSH NEW-PATHNAME *WHERE-IS-CASH-FILES*)
NEW-PATHNAME))
(DEFUN DEL-WHERE-IS-DATABASE (DATABASE)
(LET ((FOUND (FIND-IF #'(LAMBDA (ELEMENT)
(SAME-WHERE-IS-DATABASE DATABASE ELEMENT))
(SAME-WHERE-IS-DATABASE DATABASE ELEMENT))
*WHERE-IS-CASH-FILES*)))
(WHEN FOUND
(SETQ *WHERE-IS-CASH-FILES* (DELETE FOUND *WHERE-IS-CASH-FILES* :TEST 'EQ))
@@ -154,7 +154,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(LET ((PATHNAME-X (COERCE-TO-PATHAME X))
(PATHNAME-Y (COERCE-TO-PATHAME Y)))
(IL:* IL:|;;| "do a case & version insensitive comparison")
(IL:* IL:|;;| "do a case & version insensitive comparison")
(AND (EQUALP (PATHNAME-HOST PATHNAME-X)
(PATHNAME-HOST PATHNAME-Y))
@@ -174,8 +174,8 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(LET ((CASH-FILE:CASH-FILE (FIRST TAIL)))
(IF (CASH-FILE:CASH-FILE-P CASH-FILE:CASH-FILE)
(IL:* IL:|;;|
 "make sure we'll get latest version on re-boot")
(IL:* IL:|;;|
 "make sure we'll get latest version on re-boot")
(SETF (FIRST TAIL)
(MAKE-PATHNAME :VERSION :NEWEST :DEFAULTS
@@ -200,11 +200,11 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(DEFUN WHERE-IS-NOTICE (DATABASE-FILE &KEY (FILES "*.;")
(NEW NIL)
(DEFINE-TYPES (WHERE-IS-DEFAULT-DEFINE-TYPES))
(HASH-FILE-SIZE *WHERE-IS-HASH-FILE-SIZE*)
(QUIET NIL)
(TEMP-FILE NIL))
(NEW NIL)
(DEFINE-TYPES (WHERE-IS-DEFAULT-DEFINE-TYPES))
(HASH-FILE-SIZE *WHERE-IS-HASH-FILE-SIZE*)
(QUIET NIL)
(TEMP-FILE NIL))
(LET* ((FILE (IF TEMP-FILE
(IF NEW
TEMP-FILE
@@ -215,22 +215,22 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(HASH-FILE:OPEN-HASH-FILE FILE :DIRECTION :IO)))
(HASH-FILE::*DELETE-OLD-VERSION-ON-REHASH* T))
(UNWIND-PROTECT
(DOLIST (PATHNAME (WHERE-IS-FILES FILES))
(DOLIST (PATHNAME (WHERE-IS-FILES FILES))
(UNLESS QUIET
(FORMAT T ";;; ~A ." (NAMESTRING PATHNAME)))
(LET ((NAMESTRING (WHERE-IS-NAMESTRING PATHNAME)))
(LET ((NAMESTRING (WHERE-IS-NAMESTRING PATHNAME)))
(IF (AND (NOT NEW)
(LET ((OLD-WRITE-DATE (WHERE-IS-GET-WRITE-DATE NAMESTRING
(LET ((OLD-WRITE-DATE (WHERE-IS-GET-WRITE-DATE NAMESTRING
HASH-FILE:HASH-FILE)))
(AND OLD-WRITE-DATE (= (FILE-WRITE-DATE PATHNAME)
OLD-WRITE-DATE))))
(UNLESS QUIET (FORMAT T " up to date.~%"))
(MULTIPLE-VALUE-BIND
(FILE-VARS VALUES)
(WHERE-IS-READ-COMS PATHNAME)
(WHERE-IS-READ-COMS PATHNAME)
(WHEN FILE-VARS
(IL:* IL:|;;| "bind the filevars s.t. IL:INFILECOMS? will find them")
(IL:* IL:|;;| "bind the filevars s.t. IL:INFILECOMS? will find them")
(PROGV FILE-VARS VALUES
(UNLESS QUIET (PRINC "."))
@@ -238,12 +238,12 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(LET ((NAMES (IL:INFILECOMS? NIL TYPE (FIRST FILE-VARS))))
(WHEN (CONSP NAMES)
(IL:* IL:|;;| "IL:INFILECOMS? sometimes returns T.")
(IL:* IL:|;;| "IL:INFILECOMS? sometimes returns T.")
(DOLIST (NAME NAMES)
(WHERE-IS-NOTICE-INTERNAL NAME TYPE NAMESTRING
(WHERE-IS-NOTICE-INTERNAL NAME TYPE NAMESTRING
HASH-FILE:HASH-FILE))))))
(WHERE-IS-SET-WRITE-DATE NAMESTRING PATHNAME HASH-FILE:HASH-FILE)
(WHERE-IS-SET-WRITE-DATE NAMESTRING PATHNAME HASH-FILE:HASH-FILE)
(UNLESS QUIET
(PRINC ". done.")
(TERPRI)))))))
@@ -261,16 +261,16 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(DEFUN WHERE-IS-NOTICE-INTERNAL (NAME TYPE FILE-NAME HASH-FILE:HASH-FILE)
(IL:* IL:|;;| "note that NAME is defined as TYPE on FILE-NAME in HASH-FILE ")
(IL:* IL:|;;| "note that NAME is defined as TYPE on FILE-NAME in HASH-FILE ")
(IL:* IL:|;;| "we keep an ALIST for each name, indexed by type")
(IL:* IL:|;;| "we keep an ALIST for each name, indexed by type")
(LET* ((ALIST (HASH-FILE:GET-HASH-FILE NAME HASH-FILE:HASH-FILE))
(OLD-ENTRY (ASSOC TYPE ALIST :TEST 'EQUAL))
(OLD-FILES (CDR OLD-ENTRY)))
(UNLESS (MEMBER FILE-NAME OLD-FILES)
(IL:* IL:|;;| "this optimization helps a lot when re-noticing a file ")
(IL:* IL:|;;| "this optimization helps a lot when re-noticing a file ")
(SETF (HASH-FILE:GET-HASH-FILE NAME HASH-FILE:HASH-FILE)
(CONS (CONS TYPE (CONS FILE-NAME OLD-FILES))
@@ -278,9 +278,9 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(DEFUN WHERE-IS-FILES (FILES)
(IL:* IL:|;;| "expand the FILES argument to WHERE-IS-NOTICE")
(IL:* IL:|;;| "expand the FILES argument to WHERE-IS-NOTICE")
(IL:* IL:|;;| "allow: non-LIST, file names & file patterns")
(IL:* IL:|;;| "allow: non-LIST, file names & file patterns")
(MAPCAN #'(LAMBDA (PATTERN)
(LET ((PATHNAME (PROBE-FILE PATTERN)))
@@ -289,7 +289,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(CASE IL:MAKESYSNAME
(:LYRIC
(IL:* IL:|;;| "CL:DIRECTORY is broken in Lyric")
(IL:* IL:|;;| "CL:DIRECTORY is broken in Lyric")
(IL:DIRECTORY PATTERN))
(OTHERWISE (DIRECTORY PATTERN))))))
@@ -300,7 +300,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(DEFUN WHERE-IS-DEFAULT-DEFINE-TYPES ()
(MAPCAN #'(LAMBDA (TYPE)
(IL:* IL:|;;| "ignore aliases and types on *WHERE-IS-IGNORE-DEFINE-TYPES*")
(IL:* IL:|;;| "ignore aliases and types on *WHERE-IS-IGNORE-DEFINE-TYPES*")
(UNLESS (OR (CONSP TYPE)
(MEMBER TYPE *WHERE-IS-IGNORE-DEFINE-TYPES*))
@@ -309,7 +309,7 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(DEFUN WHERE-IS-NAMESTRING (PATHNAME)
(IL:* IL:|;;| "return a namestring for PATHNAME containing only the NAME & TYPE fields ")
(IL:* IL:|;;| "return a namestring for PATHNAME containing only the NAME & TYPE fields ")
(NAMESTRING (MAKE-PATHNAME :HOST NIL :NAME (PATHNAME-NAME PATHNAME)
:TYPE
@@ -320,11 +320,11 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(DEFUN WHERE-IS-READ-COMS (PATHNAME)
(IL:* IL:|;;;| "returns as first value a list of the filevars on PATHNAME, as second value a list of the values for these filevars.")
(IL:* IL:|;;;| "returns as first value a list of the filevars on PATHNAME, as second value a list of the values for these filevars.")
(IL:RESETLST
(IL:* IL:|;;| "make sure all IL:LOADVARS get undone")
(IL:* IL:|;;| "make sure all IL:LOADVARS get undone")
(IL:RESETSAVE (IL:RESETUNDO))
(DO ((IL:LOAD-VERBOSE-STREAM 'NIL)
@@ -354,20 +354,20 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(DOLIST (FILE-VAR QUEUE)
(IF (MEMBER FILE-VAR ALL-FILE-VARS :TEST 'EQ)
(IL:* IL:|;;| "don't want to load any twice")
(IL:* IL:|;;| "don't want to load any twice")
(SETF QUEUE (DELETE FILE-VAR QUEUE :TEST 'EQ)))))))
(DEFUN WHERE-IS-SET-WRITE-DATE (NAMESTRING PATHNAME HASH-FILE:HASH-FILE)
(IL:* IL:|;;| "store the write date as a bogus entry on the file")
(IL:* IL:|;;| "store the write date as a bogus entry on the file")
(WHERE-IS-NOTICE-INTERNAL NAMESTRING 'SI::WRITE-DATE (FILE-WRITE-DATE PATHNAME)
(WHERE-IS-NOTICE-INTERNAL NAMESTRING 'SI::WRITE-DATE (FILE-WRITE-DATE PATHNAME)
HASH-FILE:HASH-FILE))
(DEFUN WHERE-IS-GET-WRITE-DATE (NAMESTRING HASH-FILE:HASH-FILE)
(IL:* IL:|;;| "retrieve write date stored for NAMESTRING in HASH-FILE:HASH-FILE")
(IL:* IL:|;;| "retrieve write date stored for NAMESTRING in HASH-FILE:HASH-FILE")
(CADR (ASSOC 'SI::WRITE-DATE (HASH-FILE:GET-HASH-FILE NAMESTRING HASH-FILE:HASH-FILE))))
@@ -381,5 +381,13 @@ IL:|{DSK}<usr>local>lde>lispcore>library>WHERE-IS.;1|)
(IL:PUTPROPS IL:WHERE-IS IL:FILETYPE :COMPILE-FILE)
(IL:PUTPROPS IL:WHERE-IS IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1990))
(IL:DECLARE\: IL:DONTCOPY
(IL:FILEMAP (NIL)))
(IL:FILEMAP (NIL (1758 2090 (HASH-FILE-WHERE-IS 1758 . 2090)) (2092 2485 (HASH-FILE-TYPES-OF 2092 .
2485)) (2487 4652 (GET-WHERE-IS-ENTRIES 2487 . 4652)) (4654 5169 (WHERE-IS-READ-FN 4654 . 5169)) (5171
5327 (ADD-WHERE-IS-DATABASES 5171 . 5327)) (5329 5716 (ADD-WHERE-IS-DATABASE 5329 . 5716)) (5718 6197
(DEL-WHERE-IS-DATABASE 5718 . 6197)) (6199 7351 (SAME-WHERE-IS-DATABASE 6199 . 7351)) (7353 8560 (
CLOSE-WHERE-IS-FILES 7353 . 8560)) (8818 12235 (WHERE-IS-NOTICE 8818 . 12235)) (12237 12981 (
WHERE-IS-NOTICE-INTERNAL 12237 . 12981)) (12983 13719 (WHERE-IS-FILES 12983 . 13719)) (13721 14086 (
WHERE-IS-DEFAULT-DEFINE-TYPES 13721 . 14086)) (14088 14507 (WHERE-IS-NAMESTRING 14088 . 14507)) (14509
16521 (WHERE-IS-READ-COMS 14509 . 16521)) (16523 16794 (WHERE-IS-SET-WRITE-DATE 16523 . 16794)) (
16796 17046 (WHERE-IS-GET-WRITE-DATE 16796 . 17046)))))
IL:STOP

Binary file not shown.