(FILECREATED "18-Dec-84 18:17:35" {PHYLUM}<NOTECARDS>RELEASE1.2>NCUTILITIES.;2 18940
changes to: (FNS NC.FloppyArchive)
previous date: "20-Nov-84 17:04:34" {PHYLUM}<NOTECARDS>RELEASE1.2>NCUTILITIES.;1)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCUTILITIESCOMS)
(RPAQQ NCUTILITIESCOMS ((* * UTILITIES)
(DECLARE: DONTCOPY (MACROS \WOUT \WIN))
(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.DetermineBorderWidth NC.FloppyArchive
NC.GreyCard NC.IDFromNumber NC.IDFromWindow NC.MoveWindowOntoScreen NC.NotDaughterP
NC.PlaceMarkerP NC.ReportError NC.PrintMsg NC.MoveTTYWindow WW)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA NC.PrintMsg)))))
(* * 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))))
)
)
(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)
(* fgh: "17-Oct-84 18:10")
(* 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.)
(PROG (AskWindow)
(SETQ AskWindow (NC.PrintMsg MainWindow ClearFirstFlg Msg))
(TTY.PROCESS (THIS.PROCESS))
(RETURN (PROG1 (PROMPTFORWORD Prompt FirstTry "To type a ?, type CTRL-V followed by a ?."
AskWindow NIL NIL (CHARCODE (EOL)))
(* * 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.DetermineBorderWidth
(LAMBDA (NoteCardType) (* fgh: " 9-May-84 17:49")
(* Determine the border width for a card of type
NoteCardType)
(CADR (FASSOC NoteCardType NC.NoteCardBorderWidths))))
(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) (* fgh: "22-May-84 23:54")
(* 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)
(* fgh: "11-Apr-84 22:27")
(* 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 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)))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA NC.PrintMsg)
)
(PUTPROPS NCUTILITIES COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1407 18715 (TEDIT.LIST.OF.OBJECTS 1417 . 2361) (WINDOW.FROM.TEDIT.THING 2363 . 2999) (
WINDOW.OF.TEXTSTREAM 3001 . 3338) (NC.BreakTTYWindowCircularity 3340 . 3823) (NC.YesP 3825 . 4044) (
DRAWBOX 4046 . 4626) (FILDIR-EARLIEST 4628 . 4726) (FILDIR-VERSION 4728 . 5822) (GETMOUSEX 5824 . 5971
) (GETMOUSEY 5973 . 6120) (LOWERLEFT 6122 . 6346) (MBUTTON.NEXT.FIELD.AS.TEXT.OR.IMAGEOBJ 6348 . 7441)
(NC.AskUser 7443 . 8550) (NC.BitMapFromImageObject 8552 . 9433) (NC.ClearMsg 9435 . 9982) (
NC.DetermineBorderWidth 9984 . 10316) (NC.FloppyArchive 10318 . 13406) (NC.GreyCard 13408 . 13899) (
NC.IDFromNumber 13901 . 14130) (NC.IDFromWindow 14132 . 14297) (NC.MoveWindowOntoScreen 14299 . 15814)
(NC.NotDaughterP 15816 . 16869) (NC.PlaceMarkerP 16871 . 17108) (NC.ReportError 17110 . 17307) (
NC.PrintMsg 17309 . 18167) (NC.MoveTTYWindow 18169 . 18589) (WW 18591 . 18713)))))
STOP