(FILECREATED "18-Jan-88 17:00:46" {QV}<NOTECARDS>1.3KNEXT>NCUTILITIES.;7 44473 changes to: (FNS NC.DrawInnerBox) previous date: "30-Nov-87 15:12:29" {QV}<NOTECARDS>1.3KNEXT>NCUTILITIES.;6) (* Copyright (c) 1984, 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.) (PRETTYCOMPRINT NCUTILITIESCOMS) (RPAQQ NCUTILITIESCOMS [(* * UTILITIES) (GLOBALVARS WHOLEDISPLAY NC.OffScreenPosition \NC.NoBreakInReportError) [DECLARE: DONTEVAL@LOAD DOCOPY (VARS (\NC.NoBreakInReportError) (NC.OffScreenPosition (QUOTE (1500 . 1500] (* * Coercing functions) (FNS NC.CoerceToCard NC.CardFromWindow) (MACROS NC.ActivateCardAndDo) [DECLARE: DONTEVAL@LOAD DOCOPY (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) (FNS GETWREGION TEDIT.LIST.OF.OBJECTS WINDOW.FROM.TEDIT.THING WINDOW.OF.TEXTSTREAM NC.AskUserWithMenu NC.AskYesOrNo NC.YesP FILDIR-EARLIEST FILDIR-VERSION GETMOUSEX GETMOUSEY LOWERLEFT MBUTTON.NEXT.FIELD.AS.TEXT.OR.IMAGEOBJ NC.AskUser NC.ZapAskUserProcess 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) (NLAML) (LAMA NC.PrintMsg]) (* * UTILITIES) (DECLARE: DOEVAL@COMPILE DONTCOPY (GLOBALVARS WHOLEDISPLAY NC.OffScreenPosition \NC.NoBreakInReportError) ) (DECLARE: DONTEVAL@LOAD DOCOPY (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]) ) (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] ) (DECLARE: DONTEVAL@LOAD DOCOPY (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))) ) (DEFINEQ (GETWREGION [LAMBDA (W NEWREGIONFN NEWREGIONFNDATA MINWIDTH MINHEIGHT) (* rrb " 7-May-85 09:26") (* gets a region from a window) (PROG ((REG (GETREGION MINWIDTH MINHEIGHT NIL NEWREGIONFN NEWREGIONFNDATA))) (RETURN (CREATEREGION (IDIFFERENCE (fetch LEFT of REG) (DSPXOFFSET NIL W)) (IDIFFERENCE (fetch BOTTOM of REG) (DSPYOFFSET NIL W)) (fetch WIDTH of REG) (fetch HEIGHT of REG]) (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.AskUserWithMenu [LAMBDA (MenuItems Message InterestedWindow DontCloseAtEndFlg FlashFlg) (* rht: " 4-Jun-87 14:34") (* * Puts up a prompt window containing Message with an attached menu containing MenuItems and returns the selected menu item.) (LET ((Event (CREATE.EVENT (QUOTE AskUserWithMenu))) Menu MenuWindow PromptWin) (SETQ PromptWin (NC.PrintMsg InterestedWindow T Message)) (if FlashFlg then (FLASHWINDOW PromptWin)) (WINDOWPROP PromptWin (QUOTE AskUserWithMenu-Event) Event) (SETQ MenuWindow (ATTACHMENU (SETQ Menu (create MENU ITEMS ← MenuItems WHENSELECTEDFN ← [FUNCTION (LAMBDA (Item Menu Button) (LET [(Win (MAINWINDOW (WFROMMENU Menu] (WINDOWPROP Win (QUOTE AskUserWithMenu-SelectedItem) Item) (NOTIFY.EVENT (WINDOWPROP Win (QUOTE AskUserWithMenu-Event] MENUFONT ← (FONTCREATE (QUOTE HELVETICA) 14 (QUOTE BOLD)) MENUBORDERSIZE ← 1 ITEMHEIGHT ← 20)) PromptWin (COND ((EQ PromptWin PROMPTWINDOW) (QUOTE BOTTOM)) (T (QUOTE TOP))) (QUOTE LEFT))) (ALLOW.BUTTON.EVENTS) (AWAIT.EVENT Event) (DELETEMENU Menu T) (DETACHWINDOW MenuWindow) (OR DontCloseAtEndFlg (NC.ClearMsg InterestedWindow T)) (* Return the selected menu item and trash that WINDOWPROP at the same time just to be safe.) (WINDOWPROP PromptWin (QUOTE AskUserWithMenu-SelectedItem) NIL]) (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 "12-Aug-87 15:22") (* 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) (* * rg 8/11/87 reset interrupts before calling TTYIN) (LET (AskWindow TextObj) (RESETLST (* * If MainWindow is a TEdit window, make sur we can shift select into the prompt window.) (RESETSAVE NIL (BQUOTE (NC.AskUserResetWindow , (SETQ AskWindow (NC.PrintMsg MainWindow ClearFirstFlg Msg) ) , 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) (WINDOWPROP AskWindow (QUOTE AskUserProcess) (THIS.PROCESS)) (WINDOWADDPROP AskWindow (QUOTE CLOSEFN) (FUNCTION NC.ZapAskUserProcess) T) (PROG1 [if PROMPTFORWORDFlg then (TTY.PROCESS (THIS.PROCESS)) [RESETFORM (RESET.INTERRUPTS (LISPINTERRUPTS) T) (PROMPTFORWORD Prompt FirstTry "To type a ?, type CTRL-V followed by a ?." AskWindow NIL NIL (CHARCODE (EOL] else (RESETLST (RESETSAVE (TTYDISPLAYSTREAM AskWindow)) (RESETSAVE (RESET.INTERRUPTS (LISPINTERRUPTS) T)) (CAR (OR [NLSETQ (TTYIN (MKLIST (OR Prompt "") ) NIL NIL (QUOTE (STRING NORAISE)) NIL NIL (AND FirstTry (LIST FirstTry] (ERROR!] (WINDOWDELPROP AskWindow (QUOTE CLOSEFN) (FUNCTION NC.ZapAskUserProcess]) (NC.ZapAskUserProcess [LAMBDA (Window) (* Randy.Gobbel "12-Aug-87 16:04") (LET [(AskUserProcess (WINDOWPROP WINDOW (QUOTE AskUserProcess] (WINDOWDELPROP Window (QUOTE CLOSEFN) (FUNCTION NC.ZapAskUserProcess)) [AND (PROCESSP AskUserProcess) (PROCESS.EVAL AskUserProcess (QUOTE (ERROR!] (QUOTE DON'T]) (NC.AskUserResetWindow [LAMBDA (AskWindow MainWindow DontClearAtEndFlg DontCloseAtEndFlg) (* Randy.Gobbel "12-Aug-87 16:02") (* * 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) (* * rg 8/11/87 always blow away window on error) (* * 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)) (AND AskWindow (WINDOWDELPROP AskWindow (QUOTE CLOSEFN) (FUNCTION NC.ZapAskUserProcess))) (if (EQ RESETSTATE (QUOTE ERROR)) then (NC.ClearMsg MainWindow T) else (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 Dashing SkipLeftEdgeFlg SkipRightEdgeFlg ScaledIconWidth ScaledIconHeight) (* pmi: " 5-Nov-87 12:32") (* * 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.) (* * rht 10/28/87: Added Dashing argument and passed to calls to DRAWLINE.) (* * pmi 11/3/87: Added SkipRightEdgeFlg for new cross-file link icons (with additional attached bitmap on right side of link icons.)) (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)) (InnerTop (DIFFERENCE Top LineWidth))) (if (EVENP LineWidth) then (SETQ CenterBottom (SUB1 CenterBottom))) (* * Draw the bottom line) (DRAWLINE Left CenterBottom Right CenterBottom LineWidth Operation ImageStream NIL Dashing) (* * Draw the right line) (if SkipRightEdgeFlg then (if ScaledIconWidth then (* Leave a break for the attached bitmap) (DRAWLINE CenterRight InnerBottom CenterRight (DIFFERENCE Top ScaledIconHeight) LineWidth Operation ImageStream NIL Dashing) (SETQ Right (DIFFERENCE Right ScaledIconWidth))) else (DRAWLINE CenterRight InnerBottom CenterRight Top LineWidth Operation ImageStream NIL Dashing)) (* * Draw the left line) (if SkipLeftEdgeFlg then (if ScaledIconWidth then (* Leave a break for the attached bitmap) (DRAWLINE CenterLeft (DIFFERENCE Top ScaledIconHeight) CenterLeft InnerBottom LineWidth Operation ImageStream NIL Dashing) (SETQ Left (PLUS Left ScaledIconWidth))) else (DRAWLINE CenterLeft Top CenterLeft InnerBottom LineWidth Operation ImageStream NIL Dashing)) (* * Draw the top line) (DRAWLINE Left CenterTop Right CenterTop LineWidth Operation ImageStream NIL Dashing]) (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 ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA NC.PrintMsg) ) (PUTPROPS NCUTILITIES COPYRIGHT ("Xerox Corporation" 1984 1985 1986 1987 1988)) (DECLARE: DONTCOPY (FILEMAP (NIL (2171 3194 (NC.CoerceToCard 2181 . 2954) (NC.CardFromWindow 2956 . 3192)) (3844 4220 (WW 3854 . 3975) (FLASHW 3977 . 4218)) (6038 44228 (GETWREGION 6048 . 6688) (TEDIT.LIST.OF.OBJECTS 6690 . 7622) (WINDOW.FROM.TEDIT.THING 7624 . 8271) (WINDOW.OF.TEXTSTREAM 8273 . 8628) (NC.AskUserWithMenu 8630 . 10584) (NC.AskYesOrNo 10586 . 12638) (NC.YesP 12640 . 12880) (FILDIR-EARLIEST 12882 . 12978) ( FILDIR-VERSION 12980 . 14091) (GETMOUSEX 14093 . 14240) (GETMOUSEY 14242 . 14389) (LOWERLEFT 14391 . 14619) (MBUTTON.NEXT.FIELD.AS.TEXT.OR.IMAGEOBJ 14621 . 15720) (NC.AskUser 15722 . 18973) ( NC.ZapAskUserProcess 18975 . 19408) (NC.AskUserResetWindow 19410 . 20483) (NC.ClearMsg 20485 . 23258) (NC.GreyCard 23260 . 23736) (NC.IDFromNumber 23738 . 23962) (NC.MoveWindowOntoScreen 23964 . 26681) ( NC.NotDaughterP 26683 . 27783) (NC.MarkerMatchesCardP 27785 . 28202) (NC.PlaceMarkerP 28204 . 28442) ( NC.ReportError 28444 . 29243) (NC.PrintMsg 29245 . 34940) (DFIRSTREMOVE 34942 . 35510) ( NC.HoldTTYProcess 35512 . 35902) (NC.GetShrunkenWin 35904 . 36544) (NC.CoerceToNoteFileStream 36546 . 37038) (NC.DrawInnerBox 37040 . 40207) (NC.UnionListsOfLinks 40209 . 40882) (NC.ParseString 40884 . 42372) (NC.AppendStringToStream 42374 . 43036) (NC.CoerceToInterestedWindow 43038 . 44226))))) STOP