(FILECREATED "11-Jun-87 16:40:48" {QV}<NOTECARDS>1.3K>NEXT>NCUTILITIES.;56 51666
changes to: (FNS NC.IDFromNumber)
previous date: " 8-Jun-87 16:54:37" {QV}<NOTECARDS>1.3K>NEXT>NCUTILITIES.;55)
(* Copyright (c) 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCUTILITIESCOMS)
(RPAQQ NCUTILITIESCOMS [(* * UTILITIES)
(GLOBALVARS WHOLEDISPLAY NC.OffScreenPosition \NC.NoBreakInReportError)
[VARS (\NC.NoBreakInReportError)
(NC.OffScreenPosition (QUOTE (1500 . 1500]
(* * Coercing functions)
(FNS NC.CoerceToCard NC.CardFromWindow)
(* * Auto loader)
(RECORDS AutoloadFnEntry)
(GLOBALVARS NC.AutoloadableFnsTable NC.AutoloadFnTableSize)
(VARS (NC.AutoloadFnTableSize 200)
(NC.AutoloadableFnsTable (HASHARRAY NC.AutoloadFnTableSize)))
(FNS NC.LookupAutoloadFnFile NC.StoreAutoloadFnFile NC.LoadFileFromDirectories)
(MACROS NC.ActivateCardAndDo NC.AutoloadApply NC.AutoloadApply*)
(P (NC.StoreAutoloadFnFile (FUNCTION NC.ConvertNoteFileVersion2To3)
(QUOTE NCCONVERTVERSION2TO3)
(QUOTE NOTECARDSDIRECTORIES)))
(* * Shorthand window fns)
(FNS WW FLASHW)
(* * Other stuff)
(GLOBALVARS NC.PrintMsgFont)
(INITVARS (NC.PrintMsgFont (FONTCREATE (QUOTE HELVETICA)
10)))
(MACROS NC.WithTopWindowsUnattached)
(MACROS ABORT.PROTECT NAMED-RESETLST NAMED-RESETSAVE NAMED-RESETUNSAVE)
(FNS NAMED-RESETLST NAMED-RESETSAVE NAMED-RESETRESTORE NAMED-RESETUNSAVE)
(FNS TEDIT.LIST.OF.OBJECTS WINDOW.FROM.TEDIT.THING WINDOW.OF.TEXTSTREAM NC.AskYesOrNo NC.YesP
FILDIR-EARLIEST FILDIR-VERSION GETMOUSEX GETMOUSEY LOWERLEFT
MBUTTON.NEXT.FIELD.AS.TEXT.OR.IMAGEOBJ NC.AskUser NC.AskUserResetWindow NC.ClearMsg
NC.GreyCard NC.IDFromNumber NC.MoveWindowOntoScreen NC.NotDaughterP
NC.MarkerMatchesCardP NC.PlaceMarkerP NC.ReportError NC.PrintMsg DFIRSTREMOVE
NC.HoldTTYProcess NC.GetShrunkenWin NC.CoerceToNoteFileStream NC.DrawInnerBox
NC.UnionListsOfLinks NC.ParseString NC.AppendStringToStream NC.CoerceToInterestedWindow)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA NAMED-RESETSAVE
NAMED-RESETLST)
(NLAML
NAMED-RESETUNSAVE)
(LAMA NC.PrintMsg])
(* * UTILITIES)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS WHOLEDISPLAY NC.OffScreenPosition \NC.NoBreakInReportError)
)
(RPAQQ \NC.NoBreakInReportError NIL)
(RPAQQ NC.OffScreenPosition (1500 . 1500))
(* * Coercing functions)
(DEFINEQ
(NC.CoerceToCard
(LAMBDA (CardIdentifier) (* rht: "15-Nov-85 16:58")
(* * Get the Card object corresponding to CardIdentifier.)
(LET (Window)
(AND CardIdentifier (COND
((NC.CardP CardIdentifier)
CardIdentifier)
((WINDOWP CardIdentifier)
(NC.CardFromWindow CardIdentifier))
((TEXTSTREAMP CardIdentifier)
(COND
((STREAMPROP CardIdentifier (QUOTE NoteCardObject)))
((WINDOWP (SETQ Window (WINDOW.FROM.TEDIT.THING CardIdentifier)))
(NC.CardFromWindow Window))))
(T (NC.ReportError "NC.CoerceToCard " (CONCAT
"Arg not Window or TextStream or Card: "
CardIdentifier))))))))
(NC.CardFromWindow
(LAMBDA (Window) (* fgh: "14-Nov-85 00:07")
(* * fgh 11/13/85 Updated to handle Card object.)
(WINDOWPROP Window (QUOTE NoteCardObject))))
)
(* * Auto loader)
[DECLARE: EVAL@COMPILE
(DATATYPE AutoloadFnEntry (FileName Directories))
]
(/DECLAREDATATYPE (QUOTE AutoloadFnEntry)
(QUOTE (POINTER POINTER))
(QUOTE ((AutoloadFnEntry 0 POINTER)
(AutoloadFnEntry 2 POINTER)))
(QUOTE 4))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.AutoloadableFnsTable NC.AutoloadFnTableSize)
)
(RPAQQ NC.AutoloadFnTableSize 200)
(RPAQ NC.AutoloadableFnsTable (HASHARRAY NC.AutoloadFnTableSize))
(DEFINEQ
(NC.LookupAutoloadFnFile
(LAMBDA (AutoloadFn) (* rht: " 6-Dec-85 12:53")
(* * Fetch the entry associated with given function from the autoload table.)
(GETHASH AutoloadFn NC.AutoloadableFnsTable)))
(NC.StoreAutoloadFnFile
(LAMBDA (AutoloadFn FileName Directories) (* rht: " 6-Dec-85 12:54")
(* * Store an entry in the autoload table for given AutoloadFn. It consists of FileName and Directories variable or
list or NIL.)
(PUTHASH AutoloadFn (create AutoloadFnEntry
FileName ← FileName
Directories ← Directories)
NC.AutoloadableFnsTable)))
(NC.LoadFileFromDirectories
[LAMBDA (FileName Directories QuietFlg) (* rht: "17-Apr-87 20:08")
(* * Try to load FileName from Directories. The latter can be a list in which case the elements should be directory
paths. It can be an atom in which case it should be a DIRECTORIES var. Or it can be NIL in which case it defaults
to the litatom NOTECARDSDIRECTORIES.)
(* * fgh 6/3/86 Now closes tty window after ts done.)
(* * rht 10/31/86: Changed "DIRECTORIES" to "Directories")
(* * rht 4/17/87: Now smashes PAGEFULLFN of tty window so that it'll scroll automatically. Also prints a message to
the tty window.)
(OR Directories (SETQ Directories (QUOTE NOTECARDSDIRECTORIES)))
(SETQ Directories (if (LISTP Directories)
then (LIST (QUOTE FROM)
Directories)
else (LIST (QUOTE FROM)
(QUOTE VALUEOF)
Directories)))
(RESETLST [RESETSAVE NIL (if (OPENWP (WFROMDS (TTYDISPLAYSTREAM)
T))
then (SETQ QuietFlg T)
(QUOTE (NILL))
else (BQUOTE (CLOSEW , (WFROMDS (TTYDISPLAYSTREAM]
[RESETSAVE NIL (if QuietFlg
then (QUOTE (NILL))
else (BQUOTE (WINDOWPROP , (WFROMDS (TTYDISPLAYSTREAM))
(QUOTE PAGEFULLFN)
,
(WINDOWPROP (WFROMDS (
TTYDISPLAYSTREAM))
(QUOTE PAGEFULLFN)
(QUOTE NILL]
(LET [(Window (WFROMDS (TTYDISPLAYSTREAM]
(if (NOT QuietFlg)
then (CLEARW Window)
(FLASHWINDOW Window)
(PRINTOUT Window "Attempting to autoload " FileName T))
(APPLY (QUOTE FILESLOAD)
(if NC.LOADFLG
then (BQUOTE ((, NC.LOADFLG ,@ Directories)
, FileName))
else (LIST Directories FileName)))
(NC.FixFileDates FileName])
)
(DECLARE: EVAL@COMPILE
[DEFMACRO NC.ActivateCardAndDo (Card &REST Forms)
(* * rht 10/15/86: This written by MarkM. I changed slightly so as to accept a list of
Forms rather than a singleton.)
(* * rht&pmi 11/24: Changed name of localvar.)
(BQUOTE (LET (($$ActiveFlg$$ (NC.ActiveCardP , Card)))
(OR $$ActiveFlg$$ (NC.GetNoteCard , Card))
(PROG1 (PROGN ,@ Forms)
(OR $$ActiveFlg$$ (NC.DeactivateCard , Card]
[DEFMACRO NC.AutoloadApply (Fn Args)
(* * Like NC.AutoloadApply* except takes single Args argument rather than spread.)
(BQUOTE (if (GETD , Fn)
then
(APPLY , Fn , Args)
else
(LET ((AutoloadFnEntry (NC.LookupAutoloadFnFile , Fn))
FileName)
(if AutoloadFnEntry then (NC.LoadFileFromDirectories
(SETQ FileName (fetch (AutoloadFnEntry FileName)
of AutoloadFnEntry))
(fetch (AutoloadFnEntry Directories)
of AutoloadFnEntry))
(if (GETD , Fn)
then
(APPLY , Fn , Args)
else
(NC.ReportError "NC.AutoloadApply"
(CONCAT "Loaded file " FileName
", but still no definition of "
, Fn)))
else
(NC.ReportError "NC.AutoloadApply" (CONCAT "No definition of " , Fn
" in table of autoloadable functions."]
[DEFMACRO NC.AutoloadApply* (Fn &REST args)
(* * First arg is name of function to apply. Rest are args. The fn name should be in the
global table with an accompanying file to autoload from.)
(BQUOTE (if (GETD , Fn)
then
(APPLY* , Fn ,@ args)
else
(LET ((AutoloadFnEntry (NC.LookupAutoloadFnFile , Fn))
FileName)
(if AutoloadFnEntry then (NC.LoadFileFromDirectories
(SETQ FileName (fetch (AutoloadFnEntry FileName)
of AutoloadFnEntry))
(fetch (AutoloadFnEntry Directories)
of AutoloadFnEntry))
(if (GETD , Fn)
then
(APPLY* , Fn ,@ args)
else
(NC.ReportError "NC.AutoloadApply*"
(CONCAT "Loaded file " FileName
", but still no definition of "
, Fn)))
else
(NC.ReportError "NC.AutoloadApply*" (CONCAT "No definition of " , Fn
" in table of autoloadable functions."]
)
(NC.StoreAutoloadFnFile (FUNCTION NC.ConvertNoteFileVersion2To3)
(QUOTE NCCONVERTVERSION2TO3)
(QUOTE NOTECARDSDIRECTORIES))
(* * Shorthand window fns)
(DEFINEQ
(WW
(LAMBDA (X Y) (* fgh: " 2-Apr-84 15:15")
(WHICHW X Y)))
(FLASHW
(LAMBDA (WIN? N FLASHINTERVAL SHADE) (* kirk: "15-Jul-86 08:51")
(* * kirk 15Jul86 Old name kept for historical and shorthand reasons)
(FLASHWINDOW WIN? N FLASHINTERVAL SHADE)))
)
(* * Other stuff)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.PrintMsgFont)
)
(RPAQ? NC.PrintMsgFont (FONTCREATE (QUOTE HELVETICA)
10))
(DECLARE: EVAL@COMPILE
(DEFMACRO NC.WithTopWindowsUnattached (MainWindow &BODY Forms)
(* * Run Forms after temporarily detaching windows attached to top of MainWindow. This code
was originally in Frank's NC.AttachNoteFileName function, but found to be more generally
useful.)
(BQUOTE (RESETLST [RESETSAVE NIL (BQUOTE (, [FUNCTION (LAMBDA (DescriptionList)
(* Reattach windows according
to information in a
description list.)
(for windowDescription in
DescriptionList do
(ATTACHWINDOW
(CAR windowDescription)
, MainWindow
(CAADR
windowDescription)
(CDADR
windowDescription))
(WINDOWPROP
(CAR windowDescription)
(QUOTE PASSTOMAINCOMS)
(CADDR
windowDescription]
,
(bind WA for window in (ATTACHEDWINDOWS ,
MainWindow)
when
[EQ (QUOTE TOP)
(CAR (SETQ WA (WINDOWPROP
window
(QUOTE WHEREATTACHED]
collect
(* Detach attached windows at the top of
the main window and retuirn a list
describing their attachment.)
(PROG1 (LIST window WA
(WINDOWPROP window
(QUOTE
PASSTOMAINCOMS)))
(DETACHWINDOW window]
,@ Forms)))
)
(DECLARE: EVAL@COMPILE
(DEFMACRO ABORT.PROTECT (MAIN-FORM CLEANUP-FORM)
(BQUOTE (RESETLST (RESETSAVE NIL (QUOTE (AND RESETSTATE , CLEANUP-FORM)))
, MAIN-FORM)))
[PUTPROPS NAMED-RESETLST MACRO ((X . Y)
(PROG (RESETY RESETZ (LISPXHIST LISPXHIST))
[NAMED-RESETRESTORE (QUOTE X)
(SETQ RESETZ (COND ((XNLSETQ (SETQ RESETY (PROGN . Y))
INTERNAL)
NIL)
(T (QUOTE ERROR]
(RETURN (COND (RESETZ (ERROR!))
(T RESETY]
(DEFMACRO NAMED-RESETSAVE (RESETHANDLE &REST FORMS)
(BQUOTE (LET (RESETITEM)
(SETQ , RESETHANDLE
(CONS [SETQ
RESETITEM ,
(COND
[(AND (ATOM (CAR FORMS))
(CAR FORMS))
(SUBPAIR (QUOTE (VAR VAL))
(CDR X)
(QUOTE (PROG1 [CONS (QUOTE VAR)
(CONS (STKSCAN (QUOTE VAR))
(EVAL (QUOTE VAR]
(SET (QUOTE VAR)
VAL]
[(CDR FORMS)
(BQUOTE (LIST , (CADR FORMS)
,
(CAR FORMS]
(T (BQUOTE (LIST (LIST [QUOTE , (COND ((EQ (CAAR FORMS)
(QUOTE SETQ))
(CAR (CADDAR FORMS)))
(T (CAAR FORMS]
,
(CAR FORMS]
, RESETHANDLE))
RESETITEM)))
[DEFMACRO NAMED-RESETUNSAVE (RESETHANDLE ITEMFORM)
(BQUOTE (LET ((ITEMLIST , ITEMFORM))
(for ITEM in ITEMLIST do (SET RESETHANDLE (DREMOVE ITEM , RESETHANDLE))
(COND ((LISTP (CAR ITEM))
[SETQ OLDVALUE (COND ((CDR ITEM)
(CADR ITEM))
(T (CADAR ITEM]
(APPLY (CAAR ITEM)
(CDAR ITEM)))
(T (SET (CAR ITEM)
(CDR ITEM]
)
(DEFINEQ
(NAMED-RESETLST
[NLAMBDA RESETX (* Randy.Gobbel "19-Mar-87 11:06")
(* NAMED-RESETLST and NAMED-RESETSAVE act just like the generic versions, except that they take a RESETHANDLE
argument. This allows the scope of RESETLSTs to overlap. The RESETHANDLE variable should be bound inside of a LET
or PROG to ensure that different processes do not collide in their use of this facility.)
(PROG (RESETY RESETZ (LISPXHIST LISPXHIST))
(SET (CAR RESETX)
NIL)
[NAMED-RESETRESTORE (CAR RESETX)
(COND
((SETQ RESETY (ERRORSET (CONS (QUOTE PROGN)
(CDR RESETX))
(QUOTE INTERNAL)))
NIL)
(T (QUOTE ERROR]
[COND
(RESETY (RETURN (CAR RESETY]
(ERROR!])
(NAMED-RESETSAVE
[NLAMBDA RESETX (* Randy.Gobbel "19-Mar-87 19:33")
(* for use under a NAMED-RESETLST. If RESETX is atmic, like RESETVAR, otherwise like RESETFORM, i.e. performs the
resetting and saving associated with these functions. The restoration aad errorset protectionis done by
NAMED-RESETLST. The item added to RESETHANDLE is returned for possible later use by NAMED-RESETUNSAVE.
When used a la RESETFORM, can take a second argument whose value (computed before firt argument) is restoration
form, e.g. (NAMED-RESETSAVE FOO (SETSEPR --) (LIST (QUOTE SETSEPR) (GETSEPR))) (NAMED-RESETSAVE FOO NIL form) means
just add value of form to FOO)
(LET ((RESETHANDLE (CAR RESETX))
RESETITEM)
(SETQ RESETX (CDR RESETX))
(SET RESETHANDLE (CONS [SETQ RESETITEM (COND
[(AND (CAR RESETX)
(ATOM (CAR RESETX)))
(PROG1 (CONS (CAR RESETX)
(CAR RESETX))
(SET (CAR RESETX)
(EVAL (CADR RESETX)
(QUOTE INTERNAL]
[(CDR RESETX)
(* CADR of the entry put on resetvarslst is the value of the saving form. The variable OLDVALUE is bound to this
value during restoration. This makes it more convenient for the estoration to be conditional, e.g. the user can
perform (RESETSAVE (FOO mumble) (QUOTE (AND pred (FIE OLDVALUE)))))
(LIST (EVAL (CADR RESETX))
(EVAL (CAR RESETX]
(T (LIST (LIST (COND
((EQ (CAAR RESETX)
(QUOTE SETQ))
(CAR (CADDAR RESETX)))
(T (CAAR RESETX)))
(EVAL (CAR RESETX]
(EVAL RESETHANDLE)))
RESETITEM])
(NAMED-RESETRESTORE
[LAMBDA (RESETHANDLE RESETSTATE) (* Randy.Gobbel "18-Mar-87 19:07")
(* Goes down RESETHANDLE doing restoration until it gets to NIL. RESETSTATE is either NIL, ERROR, or RESET,
depending on whether restoration is at normal (successful) completion of a NAMED-RESETLST, following an error or
control-E, or following a control-D)
(PROG (RESETZ OLDVALUE (VARSLST (EVAL RESETHANDLE)))
LP (COND
(VARSLST (SETQ RESETZ (CAR VARSLST))
(SETQ VARSLST (CDR VARSLST))
[COND
((LISTP (CAR RESETZ))
[SETQ OLDVALUE (COND
((CDR RESETZ)
(* occurs for RESETSAVE's when second aagument is specified. In this case, (CADR RESETZ) is the value of the saving
form, i.e. the first argument to RESETSAVE.)
(CADR RESETZ))
(T (CADAR RESETZ]
(APPLY (CAAR RESETZ)
(CDAR RESETZ)))
(T (SET (CAR RESETZ)
(CDR RESETZ]
(GO LP)))
(SET RESETHANDLE NIL])
(NAMED-RESETUNSAVE
[NLAMBDA (RESETHANDLE ITEMFORM) (* Randy.Gobbel "19-Mar-87 12:04")
(LET ((ITEMLIST (EVAL ITEMFORM)))
(for ITEM in ITEMLIST
do (SET RESETHANDLE (DREMOVE ITEM (EVAL RESETHANDLE)))
(COND
((LISTP (CAR ITEM))
[SETQ OLDVALUE (COND
((CDR ITEM)
(CADR ITEM))
(T (CADAR ITEM]
(APPLY (CAAR ITEM)
(CDAR ITEM)))
(T (SET (CAR ITEM)
(CDR ITEM])
)
(DEFINEQ
(TEDIT.LIST.OF.OBJECTS
(LAMBDA (TEXTOBJ TESTFN) (* rrb " 8-Jun-84 11:12")
(* Map thru all the pieces in a text stream, and
select the image objects paired with their character
positions)
(PROG ((OBJLIST (TCONC NIL)))
(TEDIT.MAPPIECES TEXTOBJ (FUNCTION (LAMBDA (CH# PC PC# OBL)
(COND
((AND PC (NEQ PC (QUOTE LASTPIECE))
(fetch POBJ of PC)
(OR (NULL TESTFN)
(APPLY* TESTFN (fetch POBJ of PC))))
(* If there is an imageobj in this piece, and it passes the caller's test -- if he gave us one -- then add it to
the list.)
(TCONC OBL (LIST (fetch POBJ of PC)
CH#))))))
OBJLIST)
(RETURN (CDAR OBJLIST)))))
(WINDOW.FROM.TEDIT.THING
(LAMBDA (W) (* fgh: "29-Mar-85 14:02")
(COND
((WINDOWP W))
((STREAMP W) (* We got passed a stream; find the window for it)
(WINDOW.OF.TEXTSTREAM W))
((type? TEXTOBJ W) (* We got a textobj; use its window)
(CAR (MKLIST (fetch \WINDOW of W))))
((NULL W) (* Create the window, if none is given.)
(CREATEW NIL "Editing Window"))
(T (ERROR W "not a window.")))))
(WINDOW.OF.TEXTSTREAM
(LAMBDA (TEXTSTREAM) (* fgh: "29-Mar-85 14:02")
(* returns the window in which a textstream is being
editted.)
(CAR (MKLIST (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM))))))
(NC.AskYesOrNo
(LAMBDA (Msg Prompt FirstTry ClearFirstFlg MainWindow DontCloseAtEndFlg DontClearAtEndFlg)
(* fgh: " 9-Jun-86 23:13")
(* * Get a Yes or No response from the user via keyboard or mouse. Return T if Yes answer and NIL otherwise.)
(* * kirk 3Feb86 tried unsuccessfully to put a RESETLST RESETSAVE around menu so aborts would close it.)
(* * fgh 6/8/86 Now uses NC.AttachPromptWindow in place of GETPROMPTWINDOW)
(LET (Menu MenuWindow PromptWin)
(* * Determine and open the prompt window if necessary)
(SETQ PromptWin (NC.PrintMsg MainWindow ClearFirstFlg Msg))
(* * Attach a yes/no menu to the prompt window)
(SETQ MenuWindow (ATTACHMENU (SETQ Menu (create
MENU
ITEMS ← (QUOTE (Yes No))
WHENSELECTEDFN ←
(FUNCTION (LAMBDA (Item Menu Button)
(TTY.PROCESS (WINDOWPROP (MAINWINDOW
(WFROMMENU Menu))
(QUOTE PROCESS)))
(BKSYSBUF (CONCAT Item (CHARACTER 13)))))
MENUFONT ← (FONTCREATE (QUOTE HELVETICA)
14
(QUOTE BOLD))
MENUBORDERSIZE ← 1
ITEMHEIGHT ← 20
ITEMWIDTH ← (TIMES 2 (STRINGWIDTH
"Yes"
(FONTCREATE (QUOTE
HELVETICA)
14
(QUOTE BOLD))))
))
PromptWin
(COND
((EQ PromptWin PROMPTWINDOW)
(QUOTE BOTTOM))
(T (QUOTE TOP)))
(QUOTE LEFT)))
(* * print msg in prompt window and wait for user repsonse)
(NC.YesP (PROG1 (NC.AskUser "" Prompt FirstTry NIL MainWindow T DontClearAtEndFlg T)
(DELETEMENU Menu T)
(DETACHWINDOW MenuWindow)
(if (OR DontCloseAtEndFlg (EQ PromptWin PROMPTWINDOW))
else (CLOSEW PromptWin)))))))
(NC.YesP
(LAMBDA (Answer) (* fgh: "19-Dec-85 17:03")
(* * Is Answer a "yes" ?)
(if (FMEMB (MKATOM Answer)
(QUOTE (Yes Y y YES yes)))
then T)))
(FILDIR-EARLIEST
(LAMBDA (FileSpec)
(FILDIR-VERSION FileSpec (QUOTE EARLIEST))))
(FILDIR-VERSION
(LAMBDA (FileSpec Version) (* edited: "30-SEP-83 15:38")
(PROG (FileName FileVersion Entry ResultsList (LatestFlag (COND
((EQ Version (QUOTE LATEST))
T)
(T NIL))))
(for File in (FILDIR FileSpec)
do (SETQ FileName (UNPACKFILENAME File))
(SETQ FileVersion (LISTGET FileName (QUOTE VERSION)))
(LISTPUT FileName (QUOTE VERSION)
NIL)
(SETQ FileName (PACKFILENAME FileName))
(SETQ Entry (FASSOC FileName ResultsList))
(COND
((NULL Entry)
(SETQ ResultsList (CONS (CONS FileName FileVersion)
ResultsList)))
((AND LatestFlag (IGREATERP FileVersion (CDR Entry)))
(RPLACD Entry FileVersion))
((ILESSP FileVersion (CDR Entry))
(RPLACD Entry FileVersion))))
(RETURN (for File in (DREVERSE ResultsList) collect (PACK* (CAR File)
(QUOTE ;)
(CDR File)))))))
(GETMOUSEX
(LAMBDA NIL (* fgh: " 1-Apr-84 13:18")
(GETMOUSESTATE)
LASTMOUSEX))
(GETMOUSEY
(LAMBDA NIL (* fgh: " 1-Apr-84 13:18")
(GETMOUSESTATE)
LASTMOUSEY))
(LOWERLEFT
(LAMBDA (Region) (* fgh: "30-Mar-84 20:01")
(create POSITION
XCOORD ←(fetch LEFT of Region)
YCOORD ←(fetch BOTTOM of Region))))
(MBUTTON.NEXT.FIELD.AS.TEXT.OR.IMAGEOBJ
(LAMBDA (TEXTOBJ CH#) (* fgh: "31-May-84 18:06")
(* Returns the first IMAGEOBJ in the next field.
IF no such beast, returns the next field as text)
(COND
((MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#)
(\SETUPGETCH (fetch (SELECTION CH#) of (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ))
TEXTOBJ)
(COND
((CAR (bind ImageObj for CHNO from 1 to (fetch (SELECTION DCH)
of (fetch (TEXTOBJ SCRATCHSEL)
of TEXTOBJ))
when (SETQ ImageObj (IMAGEOBJP (BIN (fetch (TEXTOBJ STREAMHINT)
of TEXTOBJ))))
collect ImageObj)))
(T (replace (SELECTION SET) of (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)
with T)
(TEDIT.SEL.AS.STRING (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
(fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ))))))))
(NC.AskUser
[LAMBDA (Msg Prompt FirstTry ClearFirstFlg MainWindow DontCloseAtEndFlg DontClearAtEndFlg
PROMPTFORWORDFlg) (* Randy.Gobbel " 1-May-87 18:29")
(* Get a response from the user -
using the promptwindow attached to MainWindow)
(* * rht 9/16/84: Added DontClearAtEndFlg which if non-nil prevents the call to NC.ClearMsg.)
(* * rht 5/22/85: Now uses TTYIN instead of PROMPTFORWORD so that people can edit their answer.)
(* * rht 5/30/85: Added PROMPTFORWORDFlg so callers doing yes/no questions can get old style PROMPTFORWORD
functionality.)
(* * rht 8/6/85: Wrapped TTYIN with NLSETQ so wouldn't break if CR inadvertantly inserted in string.)
(* * fgh 5/22/86 Added handling of COPYBYBKSYSBUF so that user can shift select into prompt windows being called
from TEdit main windows.)
(* * fgh 6/27/86 Added ERROR! is problems under TTYIN NLSETQ. Allows other process to kill the askuser process.)
(* * rg 5/1/87 fixed problem that sometimes caused Exec window's process to get smashed)
(LET (AskWindow TextObj)
(RESETLST
(* * If MainWindow is a TEdit window, make sur we can shift select into the prompt window.)
(RESETSAVE (SETQ AskWindow (NC.PrintMsg MainWindow ClearFirstFlg Msg))
(BQUOTE (NC.AskUserResetWindow , AskWindow , MainWindow ,
DontClearAtEndFlg ,
DontCloseAtEndFlg)))
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
[if (SETQ TextObj (WINDOWPROP MainWindow (QUOTE TEXTOBJ)))
then (RESETSAVE (TEXTPROP TextObj (QUOTE COPYBYBKSYSBUF)
T)
(BQUOTE (TEXTPROP , TextObj COPYBYBKSYSBUF ,
(TEXTPROP TextObj (QUOTE
COPYBYBKSYSBUF]
(* * Go ahead and ask)
(PROG1 (if PROMPTFORWORDFlg
then (TTY.PROCESS (THIS.PROCESS))
(PROMPTFORWORD Prompt FirstTry
"To type a ?, type CTRL-V followed by a ?."
AskWindow NIL NIL (CHARCODE (EOL)))
else (RESETFORM (TTYDISPLAYSTREAM AskWindow)
(CAR (OR [NLSETQ
(TTYIN (MKLIST (OR Prompt "")
)
NIL NIL
(QUOTE (STRING NORAISE))
NIL NIL
(AND FirstTry
(LIST FirstTry]
(ERROR!])
(NC.AskUserResetWindow
[LAMBDA (AskWindow MainWindow DontClearAtEndFlg DontCloseAtEndFlg)
(* Randy.Gobbel " 1-May-87 18:26")
(* * called from RESETRESTORE to blow away prompt window, unless flags tell us not to)
(* * rg 3/6/87 created)
(* * rg 5/1/87 now check AskWindow non-nil so we don't accidentally smash the Exec window)
(* * Setting the PromptWindow PROCESS to NIL is to break a circularity caused by TEXTOBJ -> PROMPTWINDOW -> PROCESS
-> TEXTSTREAM -> TEXTOBJ)
(AND AskWindow (WINDOWPROP AskWindow (QUOTE PROCESS)
NIL))
(OR DontClearAtEndFlg (NC.ClearMsg MainWindow (NULL DontCloseAtEndFlg])
(NC.ClearMsg
[LAMBDA (MainWindow ClosePromptWindowFlg) (* rht: "22-Apr-87 20:09")
(* Clear and optionally close the promnpt window for
MainWindow)
(* * rht 9/10/85: Fixed so closes instead of removing prompt window and clears whether prompt win gets closed or
not.)
(* * rht 11/7/85: Now checks if MainWindow is a NC window. If so, clears its promptwindow. If not, clears
MainWindow itself.)
(* * fgh 5/1/86 Fix to above fix. If clearing MainWindow, still need to check the ClosePromptWindowFlg.
Don't close the main window if this flag in NIL.)
(* * fgh 6/8/86 Added call to REPOSITIONATTACHEDWINDOWS)
(* * fgh 6/13/86 Now uses prompt window for NF menus as well as cards.)
(* * fgh 6/27/86 Updated to match window width changes in NC.PrintMsg)
(* * fgh&rht 7/4/86: Now checks that window isn't shrunken before calling REPOSITIONATTACHEDWINDOWS)
(* * fgh 7/5/86 Redid the previous fix. Replaced REPOSITIONATTACHEDWINDOWS with FREEATTACHWINDOW in order to handle
cases for open but buried windows as well as shrunken windows.)
(* * rht&rg&pmi: 4/22/87: Now smashes the PromptWindowProcess windowprop.)
(DECLARE (GLOBALVARS NC.PromptWindowMonitorLock))
(WITH.MONITOR NC.PromptWindowMonitorLock
(LET (PromptWindow)
(if (WINDOWP MainWindow)
then (if (NC.NoteCardsWindowP MainWindow)
then (SETQ PromptWindow (NC.GETPROMPTWINDOW MainWindow
NIL NIL T))
(if (OPENWP PromptWindow)
then (CLEARW PromptWindow))
(WINDOWPROP PromptWindow (QUOTE MaxLineWidth)
NIL)
(WINDOWPROP PromptWindow (QUOTE LastLineLength)
NIL)
(WINDOWPROP PromptWindow (QUOTE OldMaxWidth)
0)
(WINDOWPROP MainWindow (QUOTE PromptWindowLastNotCR)
NIL)
(if ClosePromptWindowFlg
then (WINDOWPROP PromptWindow (QUOTE
PromptWindowProcess)
NIL)
[WINDOWDELPROP MainWindow (QUOTE
OtherPromptWindows)
(ASSOC
PromptWindow
(WINDOWPROP
MainWindow
(QUOTE
OtherPromptWindows]
(FREEATTACHEDWINDOW PromptWindow)
(REMOVEWINDOW PromptWindow))
else (CLEARW MainWindow)
(if ClosePromptWindowFlg
then (CLOSEW MainWindow)))
else (CLRPROMPT])
(NC.GreyCard
(LAMBDA (Card) (* fgh: "17-Nov-85 20:16")
(* Grey over the interior of a card to mark it as
obsolete.)
(PROG ((Window (NC.FetchWindow Card)))
(AND (WINDOWP Window)
(BITBLT NIL NIL NIL Window NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE PAINT)
GRAYSHADE))
(RETURN T))))
(NC.IDFromNumber
[LAMBDA (Number) (* fgh: " 9-Apr-84 19:24")
(PACK* (SUBATOM (QUOTE NC00000)
1
(IDIFFERENCE 7 (NCHARS Number)))
Number])
(NC.MoveWindowOntoScreen
[LAMBDA (Window) (* rht: "21-Mar-87 18:08")
(* Make sure a window and all its attachments are on
the screen.)
(* * rht 8/28/85: Hacked to handle very big card windows that together with attached windows might be too big to
fit on screen.)
(* * kirk 12Feb86 Added room for scroll bars.)
(* * rht 3/4/86: Changed to use RELMOVEW because otherwise it screws up when there's an attached window on the left
or bottom of the window.)
(* * rht 3/19/87: Undid Kirk's change of 12Feb86. No longer leaves room for scroll bars.)
(PROG (OldWindowRegion NewWindowRegion OldTop OldBottom NewLeft NewTop)
(if [AND (WINDOWP Window)
(NOT (SUBREGIONP WHOLEDISPLAY (SETQ OldWindowRegion (WINDOWREGION
Window]
then (SETQ NewWindowRegion (COPY OldWindowRegion))
(SETQ OldTop (fetch (REGION TOP) of NewWindowRegion))
[if (GREATERP (fetch (REGION RIGHT) of NewWindowRegion)
(fetch (REGION RIGHT) of WHOLEDISPLAY))
then (SETQ NewLeft (replace (REGION LEFT) of NewWindowRegion
with (DIFFERENCE (fetch (REGION RIGHT)
of WHOLEDISPLAY)
(fetch (REGION WIDTH)
of NewWindowRegion]
(if (MINUSP (OR NewLeft (fetch (REGION LEFT) of NewWindowRegion)))
then (replace (REGION LEFT) of NewWindowRegion with 0))
[if (MINUSP (SETQ OldBottom (fetch (REGION BOTTOM) of
NewWindowRegion)))
then (replace (REGION BOTTOM) of NewWindowRegion with 0)
(SETQ NewTop (PLUS OldTop (MINUS OldBottom]
[if (GREATERP (OR NewTop (fetch (REGION TOP) of NewWindowRegion))
(fetch (REGION TOP) of WHOLEDISPLAY))
then (replace (REGION BOTTOM) of NewWindowRegion
with (DIFFERENCE (fetch (REGION TOP) of WHOLEDISPLAY)
(fetch (REGION HEIGHT) of
NewWindowRegion]
(RELMOVEW Window (create POSITION
XCOORD ← (DIFFERENCE (fetch (REGION LEFT)
of NewWindowRegion)
(fetch (REGION LEFT)
of OldWindowRegion))
YCOORD ← (DIFFERENCE (fetch (REGION BOTTOM)
of NewWindowRegion)
(fetch (REGION BOTTOM)
of OldWindowRegion])
(NC.NotDaughterP
(LAMBDA (StartCard CandidateCard LinkPredicate CheckedCardList)
(* fgh: "16-Nov-85 00:31")
(* Returns T if CandidateCard is not on any path emenating from StartID. Only links for which LinkPredicate is true
are checked. LinkPredicate defaults to all links.)
(LET (ToLinks)
(OR LinkPredicate (SETQ LinkPredicate (FUNCTION TRUE)))
(SETQ ToLinks (NC.RetrieveToLinks StartCard))
(SETQ CheckedCardList (CONS StartCard CheckedCardList))
(for Link in ToLinks bind DestinationCard
when (AND (PROGN (SETQ DestinationCard (fetch (Link DestinationCard)
of Link))
(for Card in CheckedCardList never (NC.SameCardP Card
DestinationCard)))
(APPLY* LinkPredicate Link))
always (AND (NEQ CandidateCard DestinationCard)
(NC.NotDaughterP DestinationCard CandidateCard LinkPredicate
CheckedCardList))))))
(NC.MarkerMatchesCardP
[LAMBDA (MarkerImageObject Card) (* rht: "13-Oct-86 12:08")
(* * Return non-nil if Marker is appropriate for Card.)
(AND (NC.PlaceMarkerP MarkerImageObject)
(STREQUAL (IMAGEOBJPROP MarkerImageObject (QUOTE OBJECTDATUM))
(if (NC.FileBoxP Card T)
then "File Boxes"
else "Note Cards"])
(NC.PlaceMarkerP
(LAMBDA (ImageObject) (* fgh: " 5-Mar-84 01:37")
(AND ImageObject (EQ (IMAGEOBJPROP ImageObject (QUOTE PUTFN))
(FUNCTION NC.PlaceMarkerPutFn)))))
(NC.ReportError
[LAMBDA (FromFunction Msg) (* rht: " 8-May-87 14:13")
(* * fgh 9/4/86 If \NC.NoBreakInReportError is non-NIL just prints msg in prompt window and cause ERROR!.)
(* * rht 3/2/87: coerced the function name to be an atom to fix a bug showing up in lyric.)
(* * rht 5/8/87: No longer breaks if HELPFLAG is nil.)
(DECLARE (GLOBALVARS \NC.NoBreakInReportError))
(if HELPFLAG
then (if \NC.NoBreakInReportError
then (FLASHW PROMPTWINDOW)
(CLRPROMPT)
(PROMPTPRINT "NoteCards Error")
(PROMPTPRINT Msg)
(ERROR!)
else (APPLY* (FUNCTION BREAK1)
T T (MKATOM FromFunction)
NIL NIL (LIST Msg])
(NC.PrintMsg
[LAMBDA Msgs (* rht: "23-Mar-87 12:57")
(* Print the msgs in the specified window. First argument is a window to print msg in, second arg is flag telling
whether to clear first, rest of arguments are simply prin1'ed to the msg window)
(* * rht 7/24/85: Now checks to be sure that window arg is a notecards window. If not, doesn't use promptwindow,
but prints directly to window.)
(* * rht 9/11/85: Added call to NC.MoveWindowOntoScreen in case we're crammed near the top of screen.)
(* * fgh 6/8/86 Now opens prompt window to width that matches longest line in Msg.)
(* * fgh 6/13/86 Now attaches prompt window to NF menus as well as cards.)
(* * fgh 6/26/86 Now tries to make the window an appropriate width to hold the whole msg. Height remains a
constant.)
(* * rht 3/23/87: Now gets font from globalvar NC.PrintMsgFont.)
(DECLARE (GLOBALVARS NC.PrintMsgFont))
(LET (NoteCardWinFlg PromptWin CachedStream Window MaxWidth)
(SETQ Window (ARG Msgs 1))
(* * find the maximun line length in the given arg list. Cached on the main window under the PromptWindowLastNotCR
prop is the length of the previous line if it didn't end in a carriage return. Need to add this to the length of
the first line in this call.)
(SETQ MaxWidth
(APPLY
(FUNCTION MAX)
(OR (bind [LastNotCR ← (if (AND Window (NULL (ARG Msgs 2)))
then (WINDOWPROP Window (QUOTE
PromptWindowLastNotCR]
for Msg from 3 to Msgs
join
(* * Parse each arg into a list of line lengths. Set the LastNotCR to the length of the last line in the arg if the
arg does not end in a CR. This will be added to the length of the first line in the next arg whether it be in this
call or the next call to Printmsg.)
[if (STREQUAL (ARG Msgs Msg)
"")
then (LIST 0)
else
(while (SETQ Char (GNC CopyString)) as Ctr from 1
bind Char (LastCR ← 0)
(CopyString ← (SUBSTRING (ARG Msgs Msg)
1))
(OriginalString ← (SUBSTRING (ARG Msgs Msg)
1))
when (EQ Char (CHARACTER 13))
collect (PROG1 (PLUS (OR LastNotCR 0)
(STRINGWIDTH
(OR (SUBSTRING OriginalString
(ADD1 LastCR)
(SUB1 Ctr))
"")
NC.PrintMsgFont))
(SETQ LastCR Ctr)
(SETQ LastNotCR 0))
finally
(* if the last line doesn't end in a CR, save its length as LastNotCR but be sure to put its length on the list
anyway in case this is the last call.)
(if (NOT (EQP Ctr LastCR))
then (SETQ $$VAL
(CONS (PLUS (OR LastNotCR 0)
(STRINGWIDTH
(OR (SUBSTRING OriginalString
(ADD1 LastCR)
(SUB1 Ctr))
"")
NC.PrintMsgFont))
$$VAL))
(SETQ LastNotCR (CAR $$VAL))
else (SETQ LastNotCR]
finally (* Cache the last linelength if it didn't end in a CR,
we'll need it to add to the first line next time.)
(if Window
then (WINDOWPROP Window (QUOTE PromptWindowLastNotCR)
LastNotCR)))
0)))
[if (IGREATERP Msgs 2)
then
(* * Figure out the prompt window)
(SETQ NoteCardWinFlg (NC.NoteCardsWindowP Window))
(if (NOT (WINDOWP Window))
then (SETQ PromptWin PROMPTWINDOW)
elseif NoteCardWinFlg
then (SETQ PromptWin (NC.AttachPromptWindow Window NIL NIL NIL T))
else (SETQ PromptWin Window))
(* * If requested, reset all the width caches.)
(if (AND PromptWin (ARG Msgs 2))
then (WINDOWPROP PromptWin (QUOTE OldMaxWidth)
300))
(* * Set window width to the max width of the current max width and the cached max width from previous lines since
the last clear)
[WINDOWPROP PromptWin (QUOTE OldMaxWidth)
(SETQ MaxWidth (MAX MaxWidth (OR (WINDOWPROP PromptWin
(QUOTE
OldMaxWidth))
300]
(* * Actual width of window is this maxwidth, except that if window is open, don't make it smaller.)
(if NoteCardWinFlg
then (SETQ PromptWin (NC.AttachPromptWindow
Window
(if (OPENWP PromptWin)
then (MAX MaxWidth (WINDOWPROP PromptWin (QUOTE WIDTH))
)
else MaxWidth)))
(NC.MoveWindowOntoScreen Window))
(* * Print the msg.)
(RESETLST (OR NoteCardWinFlg (RESETSAVE (TTYDISPLAYSTREAM PromptWin)))
(RESETSAVE NIL (BQUOTE (DSPFONT , (DSPFONT NC.PrintMsgFont
PromptWin)
, PromptWin)))
(if (ARG Msgs 2)
then (CLEARW PromptWin))
(LINELENGTH 1000 PromptWin)
(if (NULL PromptWin)
then (BREAK1 T T))
(for Msg from 3 to Msgs collect (PRIN1 (ARG Msgs Msg)
PromptWin]
PromptWin])
(DFIRSTREMOVE
(LAMBDA (X L) (* rht: "27-Apr-85 19:13")
(* * Like DREMOVE except only deletes the first occurrence of X in L. Also note that it doesn't rearrange the cons
nodes making up the list like DREMOVE does in the case when X = (CAR L))
(for RestOfList on L first (if (EQ X (CAR L))
then (RETURN (CDR L)))
do (COND
((EQ X (CADR RestOfList))
(RPLACD RestOfList (CDDR RestOfList))
(RETURN L))))))
(NC.HoldTTYProcess
(LAMBDA NIL (* rht: "22-May-85 14:58")
(* * Grabs the TTY process until it is explicitly placed elsewhere.)
(TTY.PROCESS (ADD.PROCESS (QUOTE (PROGN (WAIT.FOR.TTY)
(while (TTY.PROCESSP) do (BLOCK))))
(QUOTE NAME)
(QUOTE TtyHolder)))))
(NC.GetShrunkenWin
(LAMBDA (CardOrWindow) (* fgh: "16-Nov-85 00:15")
(* * Return the shrunken icon window for IDOrWindow. Return NIL if no corresponding shrunken window on screen.)
(* * rht 10/20/85: Rewrote to use ICONWINDOW prop of unshrunken window rather than looking at all windows on the
screen.)
(LET ((Window (COND
((WINDOWP CardOrWindow))
((NC.CardP CardOrWindow)
(NC.FetchWindow CardOrWindow)))))
(COND
((WINDOWP Window)
(OPENWP (WINDOWPROP Window (QUOTE ICONWINDOW))))))))
(NC.CoerceToNoteFileStream
(LAMBDA (CardOrNoteFileOrStream) (* rht: "23-Jan-86 17:40")
(* * Get stream from whatever it is.)
(COND
((STREAMP CardOrNoteFileOrStream))
((type? NoteFile CardOrNoteFileOrStream)
(fetch (NoteFile Stream) of CardOrNoteFileOrStream))
((type? Card CardOrNoteFileOrStream)
(fetch (NoteFile Stream) of (fetch (Card NoteFile) of CardOrNoteFileOrStream))))))
(NC.DrawInnerBox
[LAMBDA (Left Bottom Width Height LineWidth Operation ImageStream SkipLeftEdgeFlg ScaledIconWidth
ScaledIconHeight) (* pmi: "13-Feb-87 12:48")
(* * Draw a box that fits exactly inside the region given. Omit the left edge if SkipLeftEdgeFlg non-nil.)
(* * pmi & rht 2/10/87: Changed to not overwrite corners of the box.)
(* * pmi 2/11/87: Updated for Multi-line link icons. If multi-line, does not draw box edge in upper left corner
where bitmap is placed.)
(if (AND (GREATERP Width 0)
(GREATERP Height 0))
then (LET ((TrueWidth (SUB1 Width))
(TrueHeight (SUB1 Height))
(HalfBorderWidth (FIX (TIMES LineWidth .5)))
(Offset (if (EVENP LineWidth)
then -1
else 0))
Right Top)
(SETQ Right (PLUS Left TrueWidth))
(SETQ Top (PLUS Bottom TrueHeight))
(LET ((CenterLeft (PLUS Left HalfBorderWidth Offset))
(CenterBottom (PLUS Bottom HalfBorderWidth))
(CenterRight (DIFFERENCE Right HalfBorderWidth))
(CenterTop (DIFFERENCE Top HalfBorderWidth))
(InnerBottom (PLUS Bottom LineWidth))
(InnerRight (DIFFERENCE Right LineWidth))
(InnerTop (DIFFERENCE Top LineWidth)))
(if (EVENP LineWidth)
then (SETQ CenterBottom (SUB1 CenterBottom)))
(if SkipLeftEdgeFlg
then (if ScaledIconWidth
then (DRAWLINE Left CenterBottom Right CenterBottom
LineWidth Operation ImageStream)
(DRAWLINE CenterRight InnerBottom CenterRight Top
LineWidth Operation ImageStream)
(DRAWLINE InnerRight CenterTop (PLUS Left
ScaledIconWidth)
CenterTop LineWidth Operation ImageStream)
(DRAWLINE CenterLeft (DIFFERENCE Top
ScaledIconHeight)
CenterLeft InnerBottom LineWidth Operation
ImageStream)
else (DRAWLINE Left CenterBottom Right CenterBottom
LineWidth Operation ImageStream)
(DRAWLINE CenterRight InnerBottom CenterRight Top
LineWidth Operation ImageStream)
(DRAWLINE InnerRight CenterTop Left CenterTop
LineWidth Operation ImageStream))
else (DRAWLINE Left CenterBottom Right CenterBottom LineWidth
Operation ImageStream)
(DRAWLINE CenterRight InnerBottom CenterRight Top LineWidth
Operation ImageStream)
(DRAWLINE InnerRight CenterTop Left CenterTop LineWidth Operation
ImageStream)
(DRAWLINE CenterLeft InnerTop CenterLeft InnerBottom LineWidth
Operation ImageStream])
(NC.UnionListsOfLinks
(LAMBDA (LinksList1 LinksList2) (* rht: "29-Aug-86 16:28")
(* * Return a list containing links appearing in either LinksList1 and LinksList2.)
(if (GREATERP (LENGTH LinksList2)
(LENGTH LinksList1))
then (* Swap in order that first list be the longest.)
(PSETQ LinksList1 LinksList2 LinksList2 LinksList1))
(APPEND LinksList2 (for Link1 in LinksList1 unless (for Link2 in LinksList2
thereis (NC.SameLinkP Link1
Link2))
collect Link1))))
(NC.ParseString
[LAMBDA (String) (* pmi: " 6-Feb-87 10:47")
(* * Parses a sting into words and "white space." Example: String = "This is a test " would result in
("This" " " "is" " " "test" " "))
(COND
[(STRINGP String)
(PROG (StringLength SpacesPtr CharsPtr SubString StringList)
(SETQ StringLength (NCHARS String))
(SETQ SpacesPtr 1)
(SETQ CharsPtr 1)
(while (ILEQ SpacesPtr StringLength)
do
(* * Gather up adjacent spaces)
(while (AND (EQ (NTHCHAR String SpacesPtr)
(QUOTE % ))
(ILEQ SpacesPtr StringLength))
do (SETQ SpacesPtr (ADD1 SpacesPtr)))
(if (SETQ SubString (SUBSTRING String CharsPtr (SUB1 SpacesPtr)))
then (SETQ StringList (CONS SubString StringList)))
(SETQ CharsPtr SpacesPtr)
(* * Gather up adjacent characters)
(while (AND (NEQ (NTHCHAR String CharsPtr)
(QUOTE % ))
(ILEQ CharsPtr StringLength))
do (SETQ CharsPtr (ADD1 CharsPtr)))
(if (SETQ SubString (SUBSTRING String SpacesPtr (SUB1 CharsPtr)))
then (SETQ StringList (CONS SubString StringList)))
(SETQ SpacesPtr CharsPtr))
(RETURN (REVERSE StringList]
(T String])
(NC.AppendStringToStream
[LAMBDA (Stream String BoldFlg) (* rht: "26-Jun-85 12:17")
(* * Add the String to the end of the tedit Stream.)
(* * rht 11/16/84: Now calls TEDIT.LOOKS in any case, bold or no.)
(* * rht 6/26/85: Took out call to TEDIT.LOOKS and just stuck boldifying into call to TEDIT.INSERT.)
(TEDIT.INSERT Stream String (ADD1 (fetch (TEXTOBJ TEXTLEN) of (TEXTOBJ Stream)))
[FONTCOPY (TEXTPROP Stream (QUOTE FONT))
(QUOTE FACE)
(COND
(BoldFlg (QUOTE BRR))
(T (QUOTE MRR]
T])
(NC.CoerceToInterestedWindow
[LAMBDA (WinOrCardOrNoteFile) (* rht: "25-Mar-87 18:18")
(* * Try to return a window that can be used for NC.PrintMsg, NC.AskUser, etc. If arg is an open win, use that.
If displayed card, then use its window. If notefile, then use its notefile icon if open. Last hope is to use the
session icon if open. Returning nil means that main prompt window will have to be used.)
(DECLARE (GLOBALVARS NC.NoteCardsIconWindow))
(LET (Card NoteFile)
(COND
((OPENWP WinOrCardOrNoteFile)
WinOrCardOrNoteFile)
[(AND (type? NoteFile WinOrCardOrNoteFile)
(OPENWP (NCP.NoteFileIconWindow WinOrCardOrNoteFile]
[(AND (OR (NC.CardP WinOrCardOrNoteFile)
(TEXTSTREAMP WinOrCardOrNoteFile))
(NC.CardP (SETQ Card (NC.CoerceToCard WinOrCardOrNoteFile)))
(OPENWP (NC.FetchWindow Card]
[(AND (NC.CardP Card)
(SETQ NoteFile (fetch (Card NoteFile) of Card))
(OPENWP (NCP.NoteFileIconWindow NoteFile]
((OPENWP NC.NoteCardsIconWindow))
(T NIL])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA NAMED-RESETSAVE NAMED-RESETLST)
(ADDTOVAR NLAML NAMED-RESETUNSAVE)
(ADDTOVAR LAMA NC.PrintMsg)
)
(PUTPROPS NCUTILITIES COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2521 3555 (NC.CoerceToCard 2531 . 3313) (NC.CardFromWindow 3315 . 3553)) (4031 6817 (
NC.LookupAutoloadFnFile 4041 . 4311) (NC.StoreAutoloadFnFile 4313 . 4748) (NC.LoadFileFromDirectories
4750 . 6815)) (9245 9623 (WW 9255 . 9377) (FLASHW 9379 . 9621)) (12888 17315 (NAMED-RESETLST 12898 .
13767) (NAMED-RESETSAVE 13769 . 15640) (NAMED-RESETRESTORE 15642 . 16766) (NAMED-RESETUNSAVE 16768 .
17313)) (17316 51379 (TEDIT.LIST.OF.OBJECTS 17326 . 18269) (WINDOW.FROM.TEDIT.THING 18271 . 18924) (
WINDOW.OF.TEXTSTREAM 18926 . 19285) (NC.AskYesOrNo 19287 . 21410) (NC.YesP 21412 . 21653) (
FILDIR-EARLIEST 21655 . 21753) (FILDIR-VERSION 21755 . 22877) (GETMOUSEX 22879 . 23026) (GETMOUSEY
23028 . 23175) (LOWERLEFT 23177 . 23405) (MBUTTON.NEXT.FIELD.AS.TEXT.OR.IMAGEOBJ 23407 . 24515) (
NC.AskUser 24517 . 27153) (NC.AskUserResetWindow 27155 . 27939) (NC.ClearMsg 27941 . 30714) (
NC.GreyCard 30716 . 31194) (NC.IDFromNumber 31196 . 31420) (NC.MoveWindowOntoScreen 31422 . 34139) (
NC.NotDaughterP 34141 . 35245) (NC.MarkerMatchesCardP 35247 . 35668) (NC.PlaceMarkerP 35670 . 35911) (
NC.ReportError 35913 . 36712) (NC.PrintMsg 36714 . 42409) (DFIRSTREMOVE 42411 . 42983) (
NC.HoldTTYProcess 42985 . 43381) (NC.GetShrunkenWin 43383 . 44033) (NC.CoerceToNoteFileStream 44035 .
44531) (NC.DrawInnerBox 44533 . 47356) (NC.UnionListsOfLinks 47358 . 48033) (NC.ParseString 48035 .
49523) (NC.AppendStringToStream 49525 . 50187) (NC.CoerceToInterestedWindow 50189 . 51377)))))
STOP