(FILECREATED "17-Apr-87 20:23:26" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH240.;1 14333
changes to: (VARS RHTPATCH240COMS))
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH240COMS)
(RPAQQ RHTPATCH240COMS ((* * Fix to a bug Julian sent in wanting the tty window used by the card
type autoloader to do autoscrolling. Similar fix for the autoloading of
nccompact, ncrepair, etc. Also fixes minor bugs in document and link
index cards whereby they were asking for confirm when canceling the
create.)
(DECLARE: FIRST (P (LOAD? (NC.FindFile (QUOTE NCDOCUMENTCARD)))))
(DECLARE: FIRST (P (LOAD? (NC.FindFile (QUOTE NCLINKINDEXCARD)))))
(* * Change to NCTYPESMECH)
(FNS NC.CardTypeLoader)
(* * Change to NCUTILITIES)
(FNS NC.LoadFileFromDirectories)
(* * Change to NCDOCUMENTCARD)
(FNS NC.MakeDocument)
(* * Change to NCLINKINDEXCARD)
(FNS NC.MakeLinkIndex)))
(* * Fix to a bug Julian sent in wanting the tty window used by the card type autoloader to do
autoscrolling. Similar fix for the autoloading of nccompact, ncrepair, etc. Also fixes minor
bugs in document and link index cards whereby they were asking for confirm when canceling the
create.)
(DECLARE: FIRST
(LOAD? (NC.FindFile (QUOTE NCDOCUMENTCARD)))
)
(DECLARE: FIRST
(LOAD? (NC.FindFile (QUOTE NCLINKINDEXCARD)))
)
(* * Change to NCTYPESMECH)
(DEFINEQ
(NC.CardTypeLoader
(LAMBDA (TypeName FileSuggestion QuietFlg) (* rht: "17-Apr-87 19:53")
(* * Load card type TypeName using FileSuggestion as the first place to look. Otherwise look in the directories
specified by NoteCardsDirectories.)
(* * fgh 2/3/86 First written.)
(* * kirk 1Jul86 Added new process.)
(* * kirk 15Jul86 Removed new process and added FGH's RESETLST to close stream.)
(* * fgh 7/16/86 Added PRINTOUT to inform user before find file begins.)
(* * kirk 8/7/86 Added QuietFlg. Will not stop LOAD messages though.)
(* * kirk 19/8/86 Added set QuietFlg T in OPENWP check)
(* * fgh 8/26/86 Changed LOAD? to a LOAD. If we are at this point there must bve some reason we need to reload the
file even if its alreadt been loaded.)
(* * rht&rg&pmi 10/21/86: Changed LOAD to FILESLOAD.)
(* * rht 4/17/87: Now smashes PAGEFULLFN of tty window so that it'll scroll automatically.)
(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)))
(FileName (NC.FindFile FileSuggestion TypeName T)))
(if (NOT QuietFlg)
then (CLEARW Window)
(FLASHWINDOW Window)
(PRINTOUT Window "Card type " TypeName " not loaded." T
"Attempting to autoload."
T))
(if FileName
then (PROG1 (APPLY (QUOTE FILESLOAD)
(if NC.LOADFLG
then (BQUOTE ((, NC.LOADFLG)
, FileName))
else (LIST FileName)))
(NC.FixFileDates FileName)))))))
)
(* * Change to NCUTILITIES)
(DEFINEQ
(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)))))
)
(* * Change to NCDOCUMENTCARD)
(DEFINEQ
(NC.MakeDocument
(LAMBDA (Card Title NoDisplayFlg CardIdentifier) (* rht: "17-Apr-87 15:38")
(* * Called from a filebox's title bar. Makes a document by smashing all the descendant cards's text together.
Ask user if wants numbered section headings and titles. The former are made from FileBox titles, the latter from
notecard titles. Delete embedded links at the end if the user desires.)
(* * rht 10/22/84: Hacked to be callable from Programmer's interface.)
(* * rht 11/17/84: Checks for cancel when choosing rootID and also when setting parameters.)
(* * rht 8/25/85: Now dumps sketch and graph cards as well as text cards.)
(* * rht 9/16/85: Now handles cr's around titles using para leading.)
(* * fgh 11/178/85 Updated to handle Card and NoteFile objects.)
(* * kirk 27Jun86 Moved NC.RetrieveTitle call so does not break when user Cancels)
(* * rht 7/31/86: Now checks for card types having ExportSubstanceFn prop.)
(* * kirk 8/22/86 Fix of free use of NoteFile var)
(* * rht 10/15/86: Integrated markM's changes and fixed box numbering.)
(* * rht 11/17/86: Now calls NC.ApplySupersFn rather than NC.MakeNoteCard.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper. Still needs ProtectedCardOperation wrapper!)
(* * rg 4/2/87 changed NC.CardSelectionOperation to NCP.WithLockedCards)
(* * rht 4/17/87: No longer bugs user for confirm of delete when cancel'ing.)
(NCP.WithLockedCards (PROG (RootCard RootTitle DocWindow DocCard DocWindowOrCard DocStream
HeadingsFromFileboxes TitlesFromNoteCards BuildBackLinks
CopyEmbeddedLinks ExpandEmbeddedLinks InspectWin
RootSubstanceType)
(OR NoDisplayFlg (SPAWN.MOUSE))
(SETQ DocWindowOrCard (NC.ApplySupersFn MakeFn Card "Document"
NoDisplayFlg))
(if NoDisplayFlg
then (SETQ DocWindow NIL)
(SETQ DocCard DocWindowOrCard)
else (SETQ DocWindow DocWindowOrCard)
(SETQ DocCard (NC.CoerceToCard DocWindow)))
(* NC.MakeNoteCard either returned an Card or a window
depending on NoDisplayFlg.)
(SETQ RootCard (OR (NC.CoerceToCard CardIdentifier)
(NC.SelectNoteCards T NIL
NC.SelectingCardMenu
DocWindow
"Please shift-select the Note Card or File Box the document should start from.")))
(if (NOT RootCard)
then (NC.DeleteNoteCard Card NIL T)
(RETURN NIL))
(SETQ RootTitle (NC.RetrieveTitle RootCard))
(NC.SetTitle DocCard (CONCAT "Document from %"" RootTitle "%""))
(AND DocWindow (WINDOWPROP DocWindow (QUOTE TITLE)
(NC.RetrieveTitle DocCard)))
(SETQ DocStream (NC.FetchSubstance DocCard))
(* * Get MakeDocument parameters from user via inspector window.)
(if (NOT NoDisplayFlg)
then (SETQ InspectWin (NC.BuildMakeDocInspector DocWindow))
(TOTOPW InspectWin)
(for while (OPENWP InspectWin) do (BLOCK)))
(if (EQ (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE --DONE--))
(QUOTE QUIT))
then (PUTPROP (QUOTE NC.MakeDocParameters)
(QUOTE --DONE--)
(QUOTE --CANCEL--))
(NC.DeleteNoteCard Card NIL T)
(RETURN NIL))
(SETQ HeadingsFromFileboxes (GETPROP (QUOTE
NC.MakeDocParameters)
(QUOTE
HeadingsFromFileboxes)))
(SETQ TitlesFromNoteCards (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE TitlesFromNoteCards))
)
(SETQ BuildBackLinks (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE BuildBackLinks)))
(SETQ CopyEmbeddedLinks (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE CopyEmbeddedLinks)))
(SETQ ExpandEmbeddedLinks (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE ExpandEmbeddedLinks))
)
(* * Call recursive routine to dump filebox.)
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(NC.PrintMsg DocWindow NIL
"Collecting text from descendant cards ... ")
(* * Clean up the SeenBefore markers placed on the cards and boxes just copied.)
(RESETSAVE NIL
(QUOTE (PROGN
(for Card
in (NC.FetchUserDataProp
DocCard
(QUOTE SeenCards))
do (NC.SetUserDataProp
Card
(QUOTE SeenBefore)
NIL))
(NC.SetUserDataProp
DocCard
(QUOTE SeenCards)
NIL))))
(* * Unbelievably kludgy hack to get around Intermezzo TEdit bug. Just insert and delete a CR.)
(TEDIT.INSERT DocStream NC.CRString 1)
(TEDIT.DELETE DocStream 1 1)
(NC.DumpCardToDoc RootCard DocCard DocStream 0 0
HeadingsFromFileboxes
TitlesFromNoteCards BuildBackLinks
CopyEmbeddedLinks
ExpandEmbeddedLinks)
(NC.PrintMsg DocWindow NIL "Done!"))
(COND
((NOT NoDisplayFlg)
(BLOCK 250)
(NC.ClearMsg DocWindow T)))
(RETURN DocWindowOrCard)))))
)
(* * Change to NCLINKINDEXCARD)
(DEFINEQ
(NC.MakeLinkIndex
(LAMBDA (Card Title NoDisplayFlg SpecialArgsList) (* rht: "17-Apr-87 20:01")
(* * Gather all instances of a given set of linktypes, printing the titles of cards at the from and to ends of the
link.)
(* * rht 10/24/84: Now callable from Programmer's interface. If NoDisplayFlg it non-nil, then will build LinkIndex
invisibly. If SpecialArgsList is non-nil, then should be list of (<linklabels> <backpointersP>))
(* * rht 9/21/85: Now uses stylesheet for LinkIndexSpecs. Broke out workhorse code into the function
NC.ComputeLinkIndex)
(* * fgh 11/17/85 Updated to handle Card objects.)
(* * rht 4/11/86: Took out call to NCP.AddTitleBarMenuItems. Now done in NC.AddLinkIndexCard.
Also changed to call NC.ApplySuper.)
(* * rht 9/5/86: Now bails out properly if user aborts in stylesheet.)
(* * rht 9/19/86: Now passes IndexCard rather than Window to NC.AskLinkIndexSpecs. Added call to NC.HoldTTYProcess
to keep linkindexspecs on top.)
(* * rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard)
(PROG ((LinkLabels (CAR SpecialArgsList))
(BackLinksFlg (CADR SpecialArgsList))
Window LinkIndexSpecs)
(SPAWN.MOUSE)
(SETQ Window (WINDOWP (NC.ApplySupersFn MakeFn Card (CONCAT "Link Index: "
(DATE))
NoDisplayFlg)))
(if (NOT NoDisplayFlg)
then (NC.HoldTTYProcess)
(SETQ LinkIndexSpecs (NC.AskLinkIndexSpecs Card LinkLabels BackLinksFlg T))
(if (NULL LinkIndexSpecs)
then (NC.DeleteNoteCard Card NIL T)
(RETURN NIL))
(SETQ LinkLabels (CAR LinkIndexSpecs))
(SETQ BackLinksFlg (CADR LinkIndexSpecs)))
(NC.ComputeLinkIndex Card LinkLabels BackLinksFlg)
(RETURN (if NoDisplayFlg
then Card
else (NC.ClearMsg Window T)
Window)))))
)
(PUTPROPS RHTPATCH240 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1459 3764 (NC.CardTypeLoader 1469 . 3762)) (3799 5892 (NC.LoadFileFromDirectories 3809
. 5890)) (5930 12128 (NC.MakeDocument 5940 . 12126)) (12167 14251 (NC.MakeLinkIndex 12177 . 14249))))
)
STOP