(FILECREATED "23-May-85 14:28:53" {PHYLUM}<NOTECARDS>RELEASE1.2>NCUTILITIES.;9 20160
changes to: (FNS NC.AskUser)
previous date: "22-May-85 16:38:03" {PHYLUM}<NOTECARDS>RELEASE1.2>NCUTILITIES.;8)
(* Copyright (c) 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCUTILITIESCOMS)
(RPAQQ NCUTILITIESCOMS ((E (SETQ NC.SystemDate (DATE))
(UNMARKASCHANGED (QUOTE NC.SystemDate)
(QUOTE VARS)))
(VARS NC.SystemDate)
(P (UNMARKASCHANGED (QUOTE NC.SystemDate)
(QUOTE VARS)))
(* * UTILITIES)
(DECLARE: DONTCOPY (MACROS \WOUT \WIN))
(GLOBALVARS WHOLEDISPLAY)
(FNS TEDIT.LIST.OF.OBJECTS WINDOW.FROM.TEDIT.THING WINDOW.OF.TEXTSTREAM
NC.BreakTTYWindowCircularity NC.YesP DRAWBOX FILDIR-EARLIEST FILDIR-VERSION GETMOUSEX
GETMOUSEY LOWERLEFT MBUTTON.NEXT.FIELD.AS.TEXT.OR.IMAGEOBJ NC.AskUser
NC.BitMapFromImageObject NC.ClearMsg NC.FloppyArchive NC.GreyCard NC.IDFromNumber
NC.IDFromWindow NC.MoveWindowOntoScreen NC.NotDaughterP NC.PlaceMarkerP NC.ReportError
NC.PrintMsg NC.MoveTTYWindow WW DFIRSTREMOVE NC.HoldTTYProcess)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA NC.PrintMsg)))))
(RPAQQ NC.SystemDate "23-May-85 14:28:55")
(UNMARKASCHANGED (QUOTE NC.SystemDate)
(QUOTE VARS))
(* * UTILITIES)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \WOUT MACRO (OPENLAMBDA (STREAM W)
(\BOUT STREAM (fetch HIBYTE of W))
(\BOUT STREAM (fetch LOBYTE of W))))
(PUTPROPS \WIN MACRO (OPENLAMBDA (STREAM)
(create WORD
HIBYTE ←(\BIN STREAM)
LOBYTE ←(\BIN STREAM))))
)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS WHOLEDISPLAY)
)
(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: "22-Feb-84 19:36")
(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)
(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) (* rrb "12-OCT-83 10:08")
(* returns the window in which a textstream is being
editted.)
(fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM))))
(NC.BreakTTYWindowCircularity
(LAMBDA (ID) (* fgh: "20-Aug-84 12:51")
(* * Break the connection between the TEdit process and its TTY window)
(PROG (Window Process)
(SETQ Window (NC.FetchWindow ID))
(AND Window (SETQ Process (WINDOWPROP Window (QUOTE PROCESS))))
(AND Process (PROCESSPROP Process (QUOTE TEDITTTYWINDOW)
NIL)))))
(NC.YesP
(LAMBDA (Answer) (* rht: " 7-Aug-84 19:29")
(* * Is Answer a "yes" ?)
(FMEMB (MKATOM Answer)
(QUOTE (Yes Y y YES yes)))))
(DRAWBOX
(LAMBDA (LEFT BOTTOM WIDTH HEIGHT LINEWIDTH STREAM) (* fgh: "24-Oct-84 12:57")
(DRAWLINE LEFT BOTTOM (IPLUS LEFT WIDTH)
BOTTOM LINEWIDTH NIL STREAM)
(DRAWLINE (IPLUS LEFT WIDTH)
BOTTOM
(IPLUS LEFT WIDTH)
(IPLUS BOTTOM HEIGHT)
LINEWIDTH NIL STREAM)
(DRAWLINE (IPLUS LEFT WIDTH)
(IPLUS BOTTOM HEIGHT)
LEFT
(IPLUS BOTTOM HEIGHT)
LINEWIDTH NIL STREAM)
(DRAWLINE LEFT (IPLUS BOTTOM HEIGHT)
LEFT BOTTOM LINEWIDTH NIL STREAM)))
(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)
(* rht: "23-May-85 12:20")
(* 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.)
(PROG (AskWindow)
(SETQ AskWindow (NC.PrintMsg MainWindow ClearFirstFlg Msg))
(TTY.PROCESS (THIS.PROCESS))
(RETURN (PROG1 (RESETFORM (TTYDISPLAYSTREAM AskWindow)
(TTYIN (OR Prompt "")
NIL NIL (QUOTE (STRING NORAISE))
NIL NIL (AND FirstTry (LIST FirstTry))))
(* * Setting the PromptWindow PROCESS to NIL is to break a circularity caused by TEXTOBJ -> PROMPTWINDOW -> PROCESS
-> TEXTSTREAM -> TEXTOBJ)
(WINDOWPROP AskWindow (QUOTE PROCESS)
NIL)
(OR DontClearAtEndFlg (NC.ClearMsg MainWindow (NULL DontCloseAtEndFlg))))))))
(NC.BitMapFromImageObject
(LAMBDA (ImageObject) (* fgh: " 9-Apr-84 22:40")
(PROG (DisplayStream ImageBox BitMap)
(SETQ DisplayStream (DSPCREATE (BITMAPCREATE 1 1 1)))
(SETQ ImageBox (APPLY* (IMAGEOBJPROP ImageObject (QUOTE IMAGEBOXFN))
ImageObject DisplayStream))
(SETQ BitMap (BITMAPCREATE (fetch (IMAGEBOX XSIZE) of ImageBox)
(IPLUS (fetch (IMAGEBOX YSIZE) of ImageBox)
(fetch (IMAGEBOX YDESC) of ImageBox))))
(DSPDESTINATION BitMap DisplayStream)
(DSPYPOSITION (fetch (IMAGEBOX YDESC) of ImageBox)
DisplayStream)
(APPLY* (IMAGEOBJPROP ImageObject (QUOTE DISPLAYFN))
ImageObject DisplayStream)
(RETURN BitMap))))
(NC.ClearMsg
(LAMBDA (MainWindow ClosePromptWindowFlg) (* fgh: " 1-May-84 14:01")
(* Clear and optionally close the promnpt window for
MainWindow)
(PROG (PromptWindow)
(COND
((AND (WINDOWP MainWindow)
(SETQ PromptWindow (GETPROMPTWINDOW MainWindow)))
(COND
(ClosePromptWindowFlg (REMOVEPROMPTWINDOW MainWindow))
(T (CLEARW PromptWindow))))
(T (CLRPROMPT))))))
(NC.FloppyArchive
(LAMBDA (FileName FromFloppyFlg) (* rht: "18-Dec-84 15:15")
(* Copy a database from a file to or from a floppy file
for backup.)
(* * rht 8/7/84: If restoring, don't give a suggested name for NC.DatabaseFileName and set
NC.DatabaseFileNameSuggestion to the new file name before leaving)
(PROG (FromFile ToFile)
(COND
((AND PSA.Database (OPENP PSA.Database))
(NC.PrintMsg NIL T "There is an open NoteFile." (CHARACTER 13)
"The NoteFile must be closed before any other NoteFile can be "
(COND
(FromFloppyFlg "restored.")
(T "backed-up."))
(CHARACTER 13))
(RETURN)))
(AND (NULL (SETQ FileName (NC.DatabaseFileName (CONCAT "Name of NoteFile to be copied "
(COND
(FromFloppyFlg "from")
(T "to"))
" floppy:")
" -- " T FromFloppyFlg FileName)))
(RETURN NIL))
(COND
(FromFloppyFlg (SETQ FromFile (INFILEP (PACKFILENAME (QUOTE HOST)
(QUOTE {FLOPPY})
(QUOTE BODY)
FileName)))
(COND
((NULL FromFile)
(NC.PrintMsg NIL T FileName " is not on the floppy." (CHARACTER 13)
"Restore cancelled."
(CHARACTER 13))
(RETURN)))
(SETQ ToFile (PACKFILENAME (QUOTE HOST)
(FILENAMEFIELD (DIRECTORYNAME T)
(QUOTE HOST))
(QUOTE DIRECTORY)
(FILENAMEFIELD (DIRECTORYNAME T)
(QUOTE DIRECTORY))
(QUOTE VERSION)
NIL
(QUOTE BODY)
FromFile)))
(T (SETQ FromFile (INFILEP FileName))
(COND
((NULL FromFile)
(NC.PrintMsg NIL T FileName " does not exist." (CHARACTER 13)
"Backup cancelled."
(CHARACTER 13))
(RETURN)))
(SETQ ToFile (PACKFILENAME (QUOTE HOST)
(QUOTE {FLOPPY})
(QUOTE VERSION)
NIL
(QUOTE DIRECTORY)
NIL
(QUOTE BODY)
FromFile))))
(FLOPPY.MODE (QUOTE PILOT))
(NC.PrintMsg NIL T "Copying NoteFile " (COND
(FromFloppyFlg "from")
(T "to"))
" floppy. Please wait ... "
(CHARACTER 13))
(SETQ ToFile (COPYFILE FromFile ToFile))
(COND
(FromFloppyFlg (NC.PrintMsg NIL T "Restore of " FromFile " completed." (CHARACTER 13)
"NoteFile is now on " ToFile "." (CHARACTER 13))
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
ToFile)))
(T (NC.PrintMsg NIL T "Backup of " FromFile " completed." (CHARACTER 13)
"Copy of NoteFile is now on " ToFile "." (CHARACTER 13)))))))
(NC.GreyCard
(LAMBDA (ID) (* fgh: " 1-May-84 23:50")
(* Grey over the interior of a card to mark it as
obsolete.)
(PROG ((Window (NC.FetchWindow ID)))
(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.IDFromWindow
(LAMBDA (Window) (* fgh: "24-Feb-84 19:00")
(WINDOWPROP Window (QUOTE NoteCardID))))
(NC.MoveWindowOntoScreen
(LAMBDA (Window) (* rht: " 6-Feb-85 14:14")
(* Make sure a window and all its attachments are on
the screen.)
(PROG ((WindowRegion (WINDOWREGION Window)))
(COND
((WINDOWP Window)
(COND
((NOT (SUBREGIONP WHOLEDISPLAY WindowRegion))
(COND
((MINUSP (fetch (REGION LEFT) of WindowRegion))
(replace (REGION LEFT) of WindowRegion with 0))
((IGREATERP (fetch (REGION RIGHT) of WindowRegion)
(fetch (REGION RIGHT) of WHOLEDISPLAY))
(replace (REGION LEFT) of WindowRegion with (IDIFFERENCE (fetch (REGION RIGHT)
of WHOLEDISPLAY)
(fetch (REGION WIDTH)
of WindowRegion)))))
(COND
((IGREATERP (fetch (REGION TOP) of WindowRegion)
(fetch (REGION TOP) of WHOLEDISPLAY))
(replace (REGION BOTTOM) of WindowRegion with (IDIFFERENCE (fetch (REGION
TOP)
of WHOLEDISPLAY)
(fetch (REGION
HEIGHT)
of WindowRegion)))
)
((MINUSP (fetch (REGION BOTTOM) of WindowRegion))
(replace (REGION BOTTOM) of WindowRegion with 0)))
(MOVEW Window (LOWERLEFT WindowRegion)))))))))
(NC.NotDaughterP
(LAMBDA (StartID CandidateID LinkPredicate CheckedCardList)
(* rht: " 6-Feb-85 14:16")
(* Returns T if CandidateID is not on any path emenating from StartID. Only links for which LinkPredicate is true
are checked. LinkPredicate defaults to all links.)
(PROG (ToLinks)
(OR LinkPredicate (SETQ LinkPredicate (FUNCTION TRUE)))
(SETQ ToLinks (NC.RetrieveToLinks StartID PSA.Database))
(SETQ CheckedCardList (CONS StartID CheckedCardList))
(RETURN (for Link in ToLinks bind DestinationID
when (AND (NOT (FMEMB (SETQ DestinationID (fetch (NOTECARDLINK DESTINATIONID)
of Link))
CheckedCardList))
(APPLY* LinkPredicate Link))
always (AND (NEQ CandidateID DestinationID)
(NC.NotDaughterP DestinationID CandidateID LinkPredicate
CheckedCardList)))))))
(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) (* fgh: " 2-Mar-84 19:29")
(APPLY* (FUNCTION BREAK1)
T T FromFunction NIL NIL (LIST Msg))))
(NC.PrintMsg
(LAMBDA Msgs (* fgh: " 8-Oct-84 20:08")
(* 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)
(PROG (Window)
(AND (IGREATERP Msgs 2)
(COND
((WINDOWP (SETQ Window (ARG Msgs 1)))
(SETQ Window (GETPROMPTWINDOW Window 5 (FONTCREATE (QUOTE HELVETICA)
10))))
(T (SETQ Window PROMPTWINDOW)))
(OR (NULL (ARG Msgs 2))
(CLEARW Window)
T)
(LINELENGTH 500 Window)
(for Msg from 3 to Msgs do (PRIN1 (ARG Msgs Msg)
Window)))
(RETURN Window))))
(NC.MoveTTYWindow
(LAMBDA (OnOrOff) (* fgh: " 9-Apr-84 19:11")
(AND (NEQ (TTYDISPLAYSTREAM)
PROMPTWINDOW)
(COND
((EQ OnOrOff (QUOTE ON))
(MOVEW (WFROMDS (TTYDISPLAYSTREAM))
100 100)
(QUOTE OFF))
(T (MOVEW (WFROMDS (TTYDISPLAYSTREAM))
1000 2000)
(QUOTE ON))))))
(WW
(LAMBDA (X Y) (* fgh: " 2-Apr-84 15:15")
(WHICHW X Y)))
(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)))))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA NC.PrintMsg)
)
(PUTPROPS NCUTILITIES COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1796 19930 (TEDIT.LIST.OF.OBJECTS 1806 . 2750) (WINDOW.FROM.TEDIT.THING 2752 . 3388) (
WINDOW.OF.TEXTSTREAM 3390 . 3727) (NC.BreakTTYWindowCircularity 3729 . 4212) (NC.YesP 4214 . 4433) (
DRAWBOX 4435 . 5015) (FILDIR-EARLIEST 5017 . 5115) (FILDIR-VERSION 5117 . 6211) (GETMOUSEX 6213 . 6360
) (GETMOUSEY 6362 . 6509) (LOWERLEFT 6511 . 6735) (MBUTTON.NEXT.FIELD.AS.TEXT.OR.IMAGEOBJ 6737 . 7830)
(NC.AskUser 7832 . 9116) (NC.BitMapFromImageObject 9118 . 9999) (NC.ClearMsg 10001 . 10548) (
NC.FloppyArchive 10550 . 13638) (NC.GreyCard 13640 . 14131) (NC.IDFromNumber 14133 . 14362) (
NC.IDFromWindow 14364 . 14529) (NC.MoveWindowOntoScreen 14531 . 16046) (NC.NotDaughterP 16048 . 17098)
(NC.PlaceMarkerP 17100 . 17337) (NC.ReportError 17339 . 17536) (NC.PrintMsg 17538 . 18396) (
NC.MoveTTYWindow 18398 . 18818) (WW 18820 . 18942) (DFIRSTREMOVE 18944 . 19525) (NC.HoldTTYProcess
19527 . 19928)))))
STOP