(FILECREATED " 9-Jan-87 19:51:54" {ERIS}<LISPUSERS>KOTO>LOOKUPINFILES.;5 14420
changes to: (FNS Lookup-CacheFile)
previous date: " 1-Dec-86 14:55:02" {ERIS}<LISPUSERS>KOTO>LOOKUPINFILES.;4)
(* Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LOOKUPINFILESCOMS)
(RPAQQ LOOKUPINFILESCOMS ((* * Fast lookup in files) (FNS AddFileToList Lookup-RecacheFile
Lookup-WhenOpenedFn Lookup-WhenClosedFn Lookup-KillProcess Lookup-CacheFile Lookup-CacheFiles
Lookup-TitleMenuFn Lookup-EditFile LookupString MakeLookupWindow NextOccurrenceInFiles
ShowLookUpString) (VARS *LookupPrompt*) (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) (* dgb:
"25-Nov-86 09:24")
(* * The OPENFN for the Phone lookup window)
(OPENW w)
(TERPRI (GETPROMPTWINDOW w))
(TERPRI (GETPROMPTWINDOW w))
(ADD.PROCESS (BQUOTE (LookupString (\, w)))
(QUOTE NAME)
(WINDOWPROP w (QUOTE ProcessName))
(QUOTE WINDOW)
(GETPROMPTWINDOW w])
(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) (* dgb:
"19-Nov-86 01:24")
(* * 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))
(DEL.PROCESS proc])
(Lookup-CacheFile
(LAMBDA (entry msgStream) (* smL " 9-Jan-87 19:50") (LET* (localFile strm textStream (file (fetch (
Lookup-CacheRecord fileName) of entry)) (oldStream (fetch (Lookup-CacheRecord openStream) of entry)))
(WINDOWPROP window (QUOTE lastFileIndex) NIL) (WINDOWPROP window (QUOTE lastEntryIndex) NIL) (if
oldStream then (CLOSEF? oldStream) (DELFILE (fetch (Lookup-CacheRecord 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) (* dgb:
"25-Nov-86 09:45")
(SELECTQ [MENU (LOADTIMECONSTANT (create MENU
ITEMS ←(QUOTE (("Edit File" (QUOTE Edit)
"Edit current file, at current position")
("Add new file" (QUOTE
AddFile)
"Add specified file to list")
("Recache files in core"
(QUOTE Recache))
("Recache just this file"
(QUOTE RecacheFile)
"Recache file specified in title"]
(AddFile (AddFileToList window))
(Recache (Lookup-CacheFiles window T))
(RecacheFile (Lookup-RecacheFile window))
(Edit (Lookup-EditFile window))
NIL])
(Lookup-EditFile
[LAMBDA (window) (* dgb:
"26-Nov-86 08:15")
(LET [(w (TEDIT (MKATOM (CAR (NTH (WINDOWPROP window (QUOTE FileList))
(WINDOWPROP window (QUOTE lastFileIndex]
(TEDIT.NORMALIZECARET w (TEDIT.SETSEL w (WINDOWPROP window (QUOTE lastEntryIndex))
0))
w])
(LookupString
[LAMBDA (mainWindow) (* dgb:
"19-Nov-86 09:29")
(* * The main program for the Phone-Directory)
(OPENW mainWindow)
(LET ((w (GETPROMPTWINDOW mainWindow)))
(TTYDISPLAYSTREAM w)
(TTY.PROCESS (THIS.PROCESS))
(OR (WINDOWPROP mainWindow (QUOTE CacheForFiles))
(Lookup-CacheFiles mainWindow))
(bind name
do (SETQ name (TTYIN *LookupPrompt* NIL NIL (QUOTE (STRING NORAISE))
NIL NIL NIL NIL))
(COND
[(NULL name)
(LET [(oldName (WINDOWPROP mainWindow (QUOTE searchString]
(if oldName
then (PRINTOUT w *LookupPrompt* oldName T)
(ShowLookUpString oldName mainWindow (WINDOWPROP
mainWindow
(QUOTE lastFileIndex))
(ADD1 (OR (WINDOWPROP mainWindow
(QUOTE
lastEntryIndex))
0]
(T (ShowLookUpString name mainWindow)))
until (NOT (OPENWP w])
(MakeLookupWindow
[LAMBDA (fileList processName editRegion iconBM iconMask iconPosition)
(* dgb:
"26-Nov-86 18:39")
(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)
(if (AND iconBM iconMask)
then [WINDOWPROP window (QUOTE ICONFN)
(BQUOTE (LAMBDA (w icon)
(OR icon (ICONW (\, iconBM)
(\, iconMask)
(QUOTE (\, iconPosition))
T]
else (AND iconPosition (WINDOWPROP window (QUOTE ICONPOSITION)
iconPosition)))
(* * 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 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) (* dgb:
"11-Nov-86 20:37")
(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)))
0])
(ShowLookUpString
[LAMBDA (name-or-string window lst-index start-pos) (* dgb:
"20-Nov-86 11:23")
(OR lst-index (SETQ lst-index 1))
(OR start-pos (SETQ start-pos 1))
(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 1))
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: ")
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD Lookup-CacheRecord (fileName inCoreName openStream textStream textLength))
]
)
(PUTPROPS LOOKUPINFILES COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (713 14156 (AddFileToList 723 . 1609) (Lookup-RecacheFile 1611 . 2300) (
Lookup-WhenOpenedFn 2302 . 2781) (Lookup-WhenClosedFn 2783 . 3439) (Lookup-KillProcess 3441 . 3940) (
Lookup-CacheFile 3942 . 5070) (Lookup-CacheFiles 5072 . 6166) (Lookup-TitleMenuFn 6168 . 7022) (
Lookup-EditFile 7024 . 7442) (LookupString 7444 . 8581) (MakeLookupWindow 8583 . 11639) (
NextOccurrenceInFiles 11641 . 12119) (ShowLookUpString 12121 . 14154)))))
STOP