(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "17-Mar-2022 12:13:30" {DSK}kaplan>Local>medley3.5>my-medley>sources>SPELLFILE.;5 16467 :CHANGES-TO (FNS SPELLFILE FINDFILE) :PREVIOUS-DATE "16-Mar-2022 20:02:22" {DSK}kaplan>Local>medley3.5>my-medley>sources>SPELLFILE.;2) (* ; " Copyright (c) 1986, 1990, 1992 by Venue & Xerox Corporation. ") (PRETTYCOMPRINT SPELLFILECOMS) (RPAQQ SPELLFILECOMS ((* "File name spelling correction") (FNS FINDFILE SPELLFILE SPELLFILE.MATCHINGDIRS SPELLFILE.SPELL SPELLFILE.SPELL1 SPELLFILE1 SPELLFILEDIR) (GLOBALVARS USERNAME) (INITVARS (NOFILESPELLFLG T)) [DECLARE%: DONTEVAL@LOAD DOCOPY (ADDVARS (ERRORTYPELST (23 (SPELLFILE (CADR ERRORMESS) NIL NOFILESPELLFLG] (ADDVARS (DIRECTORIES)))) (* "File name spelling correction") (DEFINEQ (FINDFILE [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. ") (COND ((AND (OR (NULL DIRLST) (UNPACKFILENAME.STRING FILE 'DIRECTORY)) (INFILEP FILE))) (T (SPELLFILE FILE T NSFLG DIRLST]) (SPELLFILE [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)) (* ;; "This does the FOO to FOO>FOO correction, with only directory scanning and no other transformations.") (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 (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) (* ;; "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] (COND ([for X in FILEDATES thereis (AND (OR (EQ (CDR X) SPELLVAL) (EQ (CDR X) FILE)) (STREQUAL (CAR X) (FILEDATE SPELLVAL] (* ;; "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] ((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 ( 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 (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))) (* ;; "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]) (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)))) ) (SPELLFILE.SPELL [LAMBDA (HOST DIRECTORY NAME EXTENSION VERSION ROOTNAME RELATIVEDIRECTORY SUBDIRECTORY) (* ; "Edited 28-Apr-92 13:58 by jds") (* ;; "Try to spelling-correct ROOTNAME against existing files. HOST DIRECTORY NAME EXTENSION VERSION are the unpacked fields of the originally supplied file, while ROOTNAME is just the name/extension we are willing to fix up.") (* ;;  "For efficiency, assume that either the name or the extension, but not both, is misspelled.") (COND ([AND VERSION (NOT (AND (FIXP VERSION) (IGREATERP VERSION 0] (* ; "Can't deal with funny versions") (SETQ VERSION NIL))) (RESETLST (* ;  "RESETLST is for the \GENERATEFILES inside SPELLFILE.SPELL1") (OR (COND (EXTENSION (* ;  "If non-null extension, then try all extensions of files with this name.") (SPELLFILE.SPELL1 HOST DIRECTORY NAME '* VERSION ROOTNAME RELATIVEDIRECTORY SUBDIRECTORY))) (SPELLFILE.SPELL1 HOST DIRECTORY '* EXTENSION VERSION ROOTNAME RELATIVEDIRECTORY SUBDIRECTORY)))]) (SPELLFILE.SPELL1 (LAMBDA (HOST DIRECTORY NAME EXTENSION VERSION ROOTNAME RELATIVEDIRECTORY SUBDIRECTORY) (* ; "Edited 27-Nov-90 13:58 by nm") (* ;;; "Try to spelling-correct ROOTNAME against all the files matching the fields supplied.") (DECLARE (SPECVARS VERSION)) (* ; "Used by SPELLFILE1") (LET ((SPELLFILE (ARRAY 2))) (SETA SPELLFILE 2 (\GENERATEFILES (PACKFILENAME.STRING (QUOTE HOST) HOST (QUOTE DIRECTORY) DIRECTORY (QUOTE RELATIVEDIRECTORY) RELATIVEDIRECTORY (QUOTE SUBDIRECTORY) SUBDIRECTORY (QUOTE NAME) NAME (QUOTE EXTENSION) EXTENSION (QUOTE VERSION) (OR VERSION "")) NIL (QUOTE RESETLST))) (* ; "If no version specified, enumerate only highest version") (SETA SPELLFILE 1 (FUNCTION SPELLFILE1)) (FIXSPELL ROOTNAME NIL SPELLFILE (QUOTE NO-MESSAGE)))) ) (SPELLFILE1 [LAMBDA (ARR) (* ; "Edited 28-Apr-92 15:10 by jds") (* ;; "Name generator for a FIXSPELL -- generates files for a given host/directory, but returns names with the host/directory stripped off for fixspell matching.") (DECLARE (USEDFREE VERSION)) (PROG (FL NAME1 EXT1 VERS#1) LP (COND ([NULL (SETQ FL (\GENERATENEXTFILE (ELT ARR 2) (NULL VERSION] (RETURN))) (for FIELDS on (UNPACKFILENAME.STRING FL) by (CDDR FIELDS) do (* ;  "Ignore host and directory, assuming we only generate appropriate ones.") (SELECTQ (CAR FIELDS) (NAME (SETQ NAME1 (CADR FIELDS))) (EXTENSION (SETQ EXT1 (CADR FIELDS))) (VERSION (SETQ VERS#1 (CADR FIELDS))) NIL)) [COND ([OR (NOT VERSION) (AND VERS#1 (EQ VERSION (MKATOM VERS#1] (* ;  "Skip if versions mismatch, so fixspell only works on names") (RETURN (PACKFILENAME.STRING 'NAME NAME1 'EXTENSION EXT1] (SETQ NAME1 (SETQ EXT1 (SETQ VERS#1 NIL))) (GO LP]) (SPELLFILEDIR (LAMBDA (DIR) (* rmk%: "13-NOV-81 22:13") (* If HOST, returns fullname of file on {HOST}DIR, otherwise searches the hosts associated with DIR for the first one with file.) (DECLARE (USEDFREE HOST DIRHOSTS NAME EXTENSION VERSION)) (COND (HOST (INFILEP (PACKFILENAME (QUOTE HOST) HOST (QUOTE DIRECTORY) DIR (QUOTE NAME) NAME (QUOTE EXTENSION) EXTENSION (QUOTE VERSION) VERSION))) (T (for H in (OR (CDR (FASSOC DIR DIRHOSTS)) (QUOTE (NIL))) when (SETQ H (INFILEP (PACKFILENAME (QUOTE HOST) H (QUOTE DIRECTORY) DIR (QUOTE NAME) NAME (QUOTE EXTENSION) EXTENSION (QUOTE VERSION) VERSION))) do (RETURN H))))) ) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS USERNAME) ) (RPAQ? NOFILESPELLFLG T) (DECLARE%: DONTEVAL@LOAD DOCOPY (ADDTOVAR ERRORTYPELST (23 (SPELLFILE (CADR ERRORMESS) NIL NOFILESPELLFLG))) ) (ADDTOVAR DIRECTORIES ) (PUTPROPS SPELLFILE COPYRIGHT ("Venue & Xerox Corporation" 1986 1990 1992)) (DECLARE%: DONTCOPY (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