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,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
|
||||
|
||||
Reference in New Issue
Block a user