(FILECREATED " 1-Dec-86 14:55:02" {PHYLUM}<BOBROW>LISP>LOOKUPINFILES.;10 15066
changes to: (FNS Lookup-RecacheFile Lookup-CacheFile Lookup-WhenClosedFn Lookup-CacheFiles
MakeLookupWindow Lookup-EditFile Lookup-WhenOpenedFn Lookup-TitleMenuFn
AddFileToList)
(VARS LOOKUPINFILESCOMS)
previous date: "26-Nov-86 08:15:54" {PHYLUM}<BOBROW>LISP>LOOKUPINFILES.;8)
(* Copyright (c) 1986 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) (* dgb:
" 1-Dec-86 14:44")
(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 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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (915 14799 (AddFileToList 925 . 1811) (Lookup-RecacheFile 1813 . 2502) (
Lookup-WhenOpenedFn 2504 . 2983) (Lookup-WhenClosedFn 2985 . 3641) (Lookup-KillProcess 3643 . 4142) (
Lookup-CacheFile 4144 . 5713) (Lookup-CacheFiles 5715 . 6809) (Lookup-TitleMenuFn 6811 . 7665) (
Lookup-EditFile 7667 . 8085) (LookupString 8087 . 9224) (MakeLookupWindow 9226 . 12282) (
NextOccurrenceInFiles 12284 . 12762) (ShowLookUpString 12764 . 14797)))))
STOP