(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 6-Sep-88 13:16:35" |{FS8:PARC:XEROX}<BOBROW>LISP>LOOKUPINFILES.;4| 14666
changes to%: (FNS LookupString)
previous date%: " 8-Jul-88 16:33:54" |{FS8:PARC:XEROX}<BOBROW>LISP>LOOKUPINFILES.;3|)
(* "
Copyright (c) 1986, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT LOOKUPINFILESCOMS)
(RPAQQ LOOKUPINFILESCOMS
((* * Fast lookup in files)
(FNS AddFileToList Lookup-RecacheFile Lookup-WhenOpenedFn Lookup-RightbuttonFn
Lookup-WhenClosedFn Lookup-KillProcess Lookup-CacheFile Lookup-CacheFiles
Lookup-TitleMenuFn Lookup-EditFile LookupString MakeLookupWindow NextOccurrenceInFiles
ShowLookUpString)
(VARS *LookupPrompt* DEFAULT-LOOKUP-BITMAP DEFAULT-LOOKUP-MASK)
(DECLARE%: DONTCOPY (RECORDS Lookup-CacheRecord))))
(* * Fast lookup in files)
(DEFINEQ
(AddFileToList
(LAMBDA (window) (* dgb%: "25-Nov-86 10:17") (LET (entry fileName (msgStream (GETPROMPTWINDOW (GETPROMPTWINDOW window)))) (TTYDISPLAYSTREAM msgStream) (TTY.PROCESS (THIS.PROCESS)) (TERPRI msgStream) (SETQ fileName (TTYIN "New File: " NIL NIL (QUOTE (STRING NORAISE)) NIL NIL NIL NIL)) (if fileName then (WINDOWPROP window (QUOTE FileList) (CONS fileName (WINDOWPROP window (QUOTE FileList)))) (WINDOWPROP window (QUOTE CacheForFiles) (CONS (SETQ entry (create Lookup-CacheRecord fileName ← fileName)) (WINDOWPROP window (QUOTE CacheForFiles)))) (Lookup-CacheFile entry msgStream)) (CLOSEW msgStream)))
)
(Lookup-RecacheFile
(LAMBDA (window) (* dgb%: " 1-Dec-86 14:53") (LET ((index (WINDOWPROP window (QUOTE lastFileIndex))) (msgStream (GETPROMPTWINDOW window))) (TERPRI msgStream) (CLEARW window) (if index then (Lookup-CacheFile (CAR (NTH (WINDOWPROP window (QUOTE CacheForFiles)) index)) msgStream) (ShowLookUpString (WINDOWPROP window (QUOTE searchString)) window index 1) else (PRINTOUT msgStream T "No file selected" T)) (PRINTOUT msgStream "Caching done" T *LookupPrompt*)))
)
(Lookup-WhenOpenedFn
(LAMBDA (w) (* ; "Edited 8-Jul-88 11:07 by dgb:") (* * The OPENFN for the Phone lookup window) (OPENW w) (TERPRI (GETPROMPTWINDOW w)) (TERPRI (GETPROMPTWINDOW w)) (WINDOWPROP w (QUOTE RIGHTBUTTONFN) (QUOTE Lookup-RightbuttonFn)) (ADD.PROCESS (BQUOTE (LookupString (\, w))) (QUOTE NAME) (WINDOWPROP w (QUOTE ProcessName)) (QUOTE WINDOW) (GETPROMPTWINDOW w)))
)
(Lookup-RightbuttonFn
(LAMBDA (W s) (* ; "Edited 8-Jul-88 11:08 by dgb:") (SELECTQ (MENU (create MENU ITEMS ← (QUOTE (Move Shrink)))) (Move (MOVEW W)) (Shrink (SHRINKW W)) NIL))
)
(Lookup-WhenClosedFn
(LAMBDA (window) (* dgb%: "26-Nov-86 15:58") (* * Kill the phone directory process associated with the window and close the files.) (for f in (WINDOWPROP window (QUOTE CacheForFiles)) do (CLOSEF? (fetch openStream of f)) (DELFILE (fetch inCoreName of f))) (Lookup-KillProcess window) (WINDOWPROP window (QUOTE CacheForFiles) NIL) (WINDOWPROP window (QUOTE (QUOTE EXPANDFN)) NIL) (WINDOWPROP window (QUOTE OPENFN) NIL) window)
)
(Lookup-KillProcess
(LAMBDA (window) (* ; "Edited 8-Jul-88 12:27 by dgb:") (* * Kill the phone directory process associated with the window) (for w in (CONS window (ATTACHEDWINDOWS window)) do (LET ((proc (WINDOWPROP w (QUOTE PROCESS)))) (if (PROCESSP proc) then (if (TTY.PROCESSP proc) then (TTY.PROCESS T)) (OR (EQ proc (THIS.PROCESS)) (DEL.PROCESS proc))))))
)
(Lookup-CacheFile
(LAMBDA (entry msgStream) (* ; "Edited 8-Jul-88 15:55 by dgb:") (LET* (localFile strm textStream (file (fetch fileName of entry)) (oldStream (fetch openStream of entry))) (WINDOWPROP window (QUOTE lastFileIndex) NIL) (WINDOWPROP window (QUOTE lastEntryIndex) NIL) (if oldStream then (CLOSEF? oldStream) (DELFILE (fetch inCoreName of entry))) (if file then (SETQ localFile (PACKFILENAME.STRING (QUOTE HOST) (QUOTE CORE) (QUOTE VERSION) NIL (QUOTE BODY) file)) (SETQ file (PACKFILENAME (QUOTE VERSION) NIL (QUOTE BODY) file)) (COND ((FINDFILE file) (PRINTOUT msgStream "Caching: " (FILENAMEFIELD file (QUOTE NAME))) (COPYFILE file localFile) (create Lookup-CacheRecord smashing entry fileName ← file openStream ← (SETQ strm (OPENSTREAM localFile (QUOTE INPUT))) textStream ← (SETQ textStream (OPENTEXTSTREAM strm)) inCoreName ← (FULLNAME strm) textLength ← (fetch TEXTLEN of (TEXTOBJ textStream))) (PRINTOUT msgStream T)) (T (SETQ localFile NIL) (PRINTOUT msgStream file " not found" T) (create Lookup-CacheRecord smashing entry fileName ← file))))))
)
(Lookup-CacheFiles
(LAMBDA (window reprintPromptFlg) (* dgb%: "26-Nov-86 18:41") (* * Cache the phone directory files in core) (LET ((msgStream (GETPROMPTWINDOW window))) (printout msgStream T "Caching files in core..." T) (for elt in (WINDOWPROP window (QUOTE CacheForFiles)) do (CLOSEF? (fetch openStream of elt)) (DELFILE (fetch inCoreName of elt))) (WINDOWPROP window (QUOTE CacheForFiles) (for file in (WINDOWPROP window (QUOTE FileList)) collect (create Lookup-CacheRecord fileName ← (OR (FULLNAME file) (PROGN (PRINTOUT msgStream file " not found" T) NIL))))) (for entry in (WINDOWPROP window (QUOTE CacheForFiles)) do (Lookup-CacheFile entry msgStream)) (printout msgStream "Caching done" T) (AND reprintPromptFlg (PRIN1 *LookupPrompt* msgStream))))
)
(Lookup-TitleMenuFn
(LAMBDA (window) (* ; "Edited 8-Jul-88 15:57 by dgb:") (SELECTQ (MENU (LOADTIMECONSTANT (create MENU ITEMS ← (QUOTE (("Edit file named in window title" (QUOTE Edit) "Edit file named in window title" (SUBITEMS ("Select file to edit" (PROGN (WINDOWPROP window (QUOTE lastFileIndex) NIL) (QUOTE Edit))))) ("Add new file" (QUOTE AddFile) "Add specified file to list") ("Recache file named in window title" (QUOTE RecacheFile) "Recache file named in window title" (SUBITEMS ("Recache all files" (QUOTE Recache))))))))) (AddFile (AddFileToList window)) (Recache (Lookup-CacheFiles window T)) (RecacheFile (Lookup-RecacheFile window)) (Edit (Lookup-EditFile window)) NIL))
)
(Lookup-EditFile
(LAMBDA (window) (* ; "Edited 8-Jul-88 11:02 by dgb:") (LET* ((file (COND ((WINDOWPROP window (QUOTE lastFileIndex)) (CAR (NTH (WINDOWPROP window (QUOTE FileList)) (WINDOWPROP window (QUOTE lastFileIndex))))) (T (MENU (create MENU ITEMS ← (WINDOWPROP window (QUOTE FileList))))))) (w (AND file (TEDIT (MKATOM file)))) (n (WINDOWPROP window (QUOTE lastEntryIndex)))) (AND file n (TEDIT.NORMALIZECARET w (TEDIT.SETSEL w n 0))) w))
)
(LookupString
[LAMBDA (mainWindow) (* ; "Edited 6-Sep-88 13:11 by dgb:")
(* * The main program for the LookupInFiles Program)
(OPENW mainWindow)
(LET ((w (GETPROMPTWINDOW mainWindow)))
(TTYDISPLAYSTREAM w)
(TTY.PROCESS (THIS.PROCESS))
(OR (WINDOWPROP mainWindow 'CacheForFiles)
(Lookup-CacheFiles mainWindow))
(bind lookup-string
do (WINDOWPROP mainWindow 'RIGHTBUTTONFN 'Lookup-RightbuttonFn)
(SETQ lookup-string (RESETVAR TTYINREADMACROS '((19 T CONS))
(TTYIN *LookupPrompt* NIL NIL '(STRING NORAISE)
NIL NIL NIL NIL)))
(COND
((LISTP lookup-string)
(SHRINKW mainWindow)
(PROCESS.RETURN))
[(NULL lookup-string)
(LET [(oldName (WINDOWPROP mainWindow 'searchString]
(if oldName
then (PRINTOUT w *LookupPrompt* oldName T)
(ShowLookUpString oldName mainWindow (WINDOWPROP mainWindow
'lastFileIndex)
(ADD1 (OR (WINDOWPROP mainWindow 'lastEntryIndex)
-1]
(T (ShowLookUpString lookup-string mainWindow))) until (NOT (OPENWP w])
(MakeLookupWindow
(LAMBDA (fileList processName editRegion iconBM iconMask iconPosition) (* ; "Edited 8-Jul-88 15:47 by dgb:") (* ;; "Compute defaults") (OR processName (SETQ processName (QUOTE Lookup))) (OR editRegion (SETQ editRegion (CREATEREGION 20 20 400 200))) (OR iconPosition (SETQ iconPosition (CREATEPOSITION 0 0))) (OR iconBM (SETQ iconBM DEFAULT-LOOKUP-BITMAP) (SETQ iconMask DEFAULT-LOOKUP-MASK)) (LET ((window (CREATEMENUEDWINDOW (create MENU CENTERFLG ← T MENUFONT ← (QUOTE (HELVETICA 12 BOLD)) ITEMS ← (QUOTE (("Next Occurrence" (QUOTE NEXT) "Find next occurrence of string."))) WHENSELECTEDFN ← (FUNCTION NextOccurrenceInFiles)) processName (QUOTE TOP) editRegion))) (* * Create Menued window with prompt) (GETPROMPTWINDOW window 2 (QUOTE (HELVETICA 12 BOLD))) (* * Use provided icon if given) (WINDOWPROP window (QUOTE TITLE) processName) (WINDOWPROP window (QUOTE ICONFN) (BQUOTE (LAMBDA (w icon) (OR icon (ICONW (\, iconBM) (\, iconMask) (QUOTE (\, iconPosition)) T))))) (* * Make mouse process independent of process running in this window) (WINDOWPROP window (QUOTE RIGHTBUTTONFN) (FUNCTION (LAMBDA (window) (if (EQ (THIS.PROCESS) (WINDOWPROP window (QUOTE PROCESS))) then (ADD.PROCESS (BQUOTE (DOWINDOWCOM (\, window)))) else (DOWINDOWCOM window))))) (* * Opening starts process, and checks if caching needed) (WINDOWADDPROP window (QUOTE OPENFN) (FUNCTION Lookup-WhenOpenedFn)) (WINDOWADDPROP window (QUOTE EXPANDFN) (FUNCTION Lookup-WhenOpenedFn)) (* * Shrinking and closing kills the process. Closing also closes all the files) (WINDOWPROP window (QUOTE CLOSEFN) (CONS (FUNCTION Lookup-WhenClosedFn) (WINDOWPROP window (QUOTE SHRINKFN)))) (WINDOWPROP window (QUOTE RIGHTBUTTONFN) (QUOTE Lookup-RightbuttonFn)) (WINDOWPROP window (QUOTE SHRINKFN) (CONS (FUNCTION Lookup-KillProcess) (WINDOWPROP window (QUOTE SHRINKFN)))) (* * Fix title menu for this TEDIT window) (OPENTEXTSTREAM "" window NIL NIL (QUOTE (READONLY T TEDIT.TITLEMENUFN Lookup-TitleMenuFn))) (WINDOWPROP window (QUOTE TEDIT.TITLEMENUFN) (QUOTE Lookup-TitleMenuFn)) (* * Cache FileList in Window) (WINDOWPROP window (QUOTE FileList) (MKLIST fileList)) (* * Store name for PSW) (WINDOWPROP window (QUOTE ProcessName) processName) (* * This should be default for attached window) (for w1 in (ALLATTACHEDWINDOWS window) do (WINDOWPROP w1 (QUOTE PASSTOMAINCOMS) T)) (SHRINKW window) window))
)
(NextOccurrenceInFiles
(LAMBDA (item menu button) (* ; "Edited 8-Jul-88 11:21 by dgb:") (LET ((window (MAINWINDOW (WFROMMENU menu)))) (ShowLookUpString (WINDOWPROP window (QUOTE searchString)) window (OR (NUMBERP (WINDOWPROP window (QUOTE lastFileIndex))) 1) (ADD1 (OR (NUMBERP (WINDOWPROP window (QUOTE lastEntryIndex))) -1)))))
)
(ShowLookUpString
(LAMBDA (name-or-string window lst-index start-pos) (* ; "Edited 8-Jul-88 11:27 by dgb:") (OR lst-index (SETQ lst-index 1)) (OR start-pos (SETQ start-pos 0)) (WINDOWPROP window (QUOTE searchString) name-or-string) (for elt in (NTH (WINDOWPROP window (QUOTE CacheForFiles)) lst-index) as file-index from lst-index bind pos openStream sel textStream when (SETQ openStream (fetch openStream of elt)) do (if (NOT (OPENP openStream)) then (OPENSTREAM openStream (QUOTE INPUT)) (WINDOWPROP window (QUOTE lastFileIndex) NIL)) (if (SETQ pos (FILEPOS name-or-string openStream start-pos (fetch textLength of elt) NIL NIL UPPERCASEARRAY)) then (WINDOWPROP window (QUOTE lastEntryIndex) pos) (SETQ sel (TEDIT.SETSEL (SETQ textStream (fetch textStream of elt)) (ADD1 pos) (NCHARS name-or-string))) (if (EQP file-index (WINDOWPROP window (QUOTE lastFileIndex))) then (TEDIT.NORMALIZECARET textStream sel) else (WINDOWPROP window (QUOTE TITLE) (CONCAT "Looking in: " (fetch fileName of elt))) (WINDOWPROP window (QUOTE lastFileIndex) file-index) (OPENTEXTSTREAM textStream window NIL NIL (QUOTE (READONLY T)))) (RETURN (TEDIT.SET.SEL.LOOKS sel (QUOTE PENDINGDEL))) else (SETQ start-pos 0)) finally (WINDOWPROP window (QUOTE lastFileIndex) NIL) (WINDOWPROP window (QUOTE lastEntryIndex) NIL) (TEDIT.SETSEL (OPENTEXTSTREAM (CONCAT name-or-string " not found.") window NIL NIL (QUOTE (READONLY T))) 1 (NCHARS name-or-string) (QUOTE RIGHT) T)))
)
)
(RPAQQ *LookupPrompt* "Lookup String: ")
(RPAQQ DEFAULT-LOOKUP-BITMAP #*(62 66)OOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLN@@@@@@@@@@@@@ALL@@@@@@@@@@@@@@LL@@@@@@@@@@@@@@LL@@@@@@@@@@@@@@LL@@OOH@@@@@@@@@LL@COON@@@@@@@@@LL@GOOO@@@@@@@@@LL@OOOOH@@@@@@@@LLAOOOOL@@@@@@@@LLAOOOOL@@@@@@@@LLAOOOOL@@@@@@@@LLCOOOON@@@@@@@@LLCOOOON@@@@@@@@LLCOOOON@@@@D@@@LLCOOOON@@@@N@A@LLCOOOON@@@AO@C@LLCOOOON@@@COHG@LLCOOOON@@@GOLO@LLAOOOOL@@@OONO@LLAOOOOL@@AOOOG@LLAOOOOL@@COOOK@LL@OOOOH@@GOOOM@LL@GOOO@@@OOOOO@LL@COON@@AOOOOO@LL@@OOH@@COOOON@LL@L@@@@@GOOOOL@LL@N@@@@@GOOOOH@LL@OON@@@COOOO@@LL@OOO@@@AOOON@@LL@OOOH@@@OOOL@@LL@OOOL@@@GOOH@@LL@OOON@@@COO@@@LL@OOOO@@@AON@@@LL@OOOOH@@@OL@@@LL@OOOOL@@NGH@@@LL@OOOON@AOC@@@@LL@OOOOO@COH@@@@LL@OOOOOHGOH@@@@LL@OOOOOLOOH@@@@LL@OOOOOOOO@@@@@LL@OOOOOOON@@@@@LL@OOOOOOOL@@@@@LL@OOOOOOOH@@@@@LL@OOONOOO@@@@@@LL@OOONGON@@@@@@LL@OOONCOL@@@@@@LL@OOONAOH@@@@@@LL@OOON@O@@@@@@@LL@GOON@F@@@@@@@LL@COON@@@@@@@@@LL@AOON@@@@@@@@@LL@@OON@@@@@@@@@LL@@GON@@@@@@@@@LL@@CON@@@@@@@@@LL@@AON@@@@@@@@@LL@@@ON@@@@@@@@@LL@@@GN@@@@@@@@@LL@@@CN@@@@@@@@@LL@@@@@@@@@@@@@@LL@@@@@@@@@@@@@@LL@@@@@@@@@@@@@@LN@@@@@@@@@@@@@ALOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOL
)
(RPAQQ DEFAULT-LOOKUP-MASK #*(62 66)OOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOLOOOOOOOOOOOOOOOL
)
(DECLARE%: DONTCOPY
(DECLARE%: EVAL@COMPILE
(RECORD Lookup-CacheRecord (fileName inCoreName openStream textStream textLength))
)
)
(PUTPROPS LOOKUPINFILES COPYRIGHT ("Xerox Corporation" 1986 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (945 12190 (AddFileToList 955 . 1577) (Lookup-RecacheFile 1579 . 2062) (
Lookup-WhenOpenedFn 2064 . 2449) (Lookup-RightbuttonFn 2451 . 2635) (Lookup-WhenClosedFn 2637 . 3089)
(Lookup-KillProcess 3091 . 3459) (Lookup-CacheFile 3461 . 4534) (Lookup-CacheFiles 4536 . 5299) (
Lookup-TitleMenuFn 5301 . 5993) (Lookup-EditFile 5995 . 6447) (LookupString 6449 . 8011) (
MakeLookupWindow 8013 . 10397) (NextOccurrenceInFiles 10399 . 10735) (ShowLookUpString 10737 . 12188))
)))
STOP