(FILECREATED "21-Oct-86 21:27:22" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH126.;2 8163
changes to: (VARS RHTPATCH126COMS)
(FNS NC.MakeSearchCard)
previous date: "21-Oct-86 21:26:46" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH126.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH126COMS)
(RPAQQ RHTPATCH126COMS ((* * Fix for canceling out of document and search card creation.)
(* * Change for NCDOCUMENTCARD)
(FNS NC.MakeDocument)
(* * Change for NCSEARCHCARD)
(FNS NC.MakeSearchCard)))
(* * Fix for canceling out of document and search card creation.)
(* * Change for NCDOCUMENTCARD)
(DEFINEQ
(NC.MakeDocument
(LAMBDA (Card Title NoDisplayFlg CardIdentifier) (* rht: "21-Oct-86 21:19")
(* * 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.)
(PROG (RootCard RootTitle DocWindow DocCard DocWindowOrCard DocStream HeadingsFromFileboxes
TitlesFromNoteCards BuildBackLinks CopyEmbeddedLinks ExpandEmbeddedLinks
InspectWin RootSubstanceType)
(OR NoDisplayFlg (SPAWN.MOUSE))
(SETQ DocWindowOrCard (NC.MakeNoteCard (QUOTE Text)
(fetch (Card NoteFile) of Card)
"Document" NoDisplayFlg NIL Card))
(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 NIL
"Please select the Note Card or File Box the document should start from.")))
(if (NOT RootCard)
then (NC.DeleteNoteCards Card T NIL NIL T 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.DeleteNoteCards Card T NIL NIL T 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 for NCSEARCHCARD)
(DEFINEQ
(NC.MakeSearchCard
(LAMBDA (Card Title NoDisplayFlg) (* rht: "21-Oct-86 21:24")
(* Search for cards with specified characteristics and create a list card containing pointers to these cards.
For now search is limited to cards whose title contains a specified string.)
(* * rht 11/8/84: Fixed some confusion between ListCardID and ID variables.)
(* * fgh 11/17/85 Updated to handle multiple notefiles and crad objects.)
(* * rht 4/11/86: changed to call NC.ApplySuper.)
(* * rht 10/21/86: Now deletes card if no search string specified.)
(LET ((NoteFile (fetch (Card NoteFile) of Card))
SearchString HitCards WindowOrCard Window)
(SPAWN.MOUSE)
(SETQ WindowOrCard (NC.ApplySupersFn MakeFn Card (OR Title "SearchCard")
NoDisplayFlg))
(NC.ActivateCard Card)
(SETQ Window (AND (WINDOWP WindowOrCard)
WindowOrCard))
(SETQ SearchString (NC.AskUser "Please enter the search string: " NIL NIL T Window))
(if (OR (EQUAL SearchString "")
(NOT SearchString))
then (NC.DeleteNoteCards Card T NIL NIL T T)
NIL
else (NC.SetTitle Card (SETQ Title (OR Title (CONCAT "Cards with %""
SearchString "%" in title"))
))
(AND Window (WINDOWPROP Window (QUOTE TITLE)
Title))
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(NC.PrintMsg Window T "Searching for cards ...")
(SETQ HitCards (NC.TitleSearch NoteFile SearchString))
(TEDIT.INSERT (NC.FetchSubstance Card)
(CONCAT " List compiled on: " (DATE)
(CHARACTER 13)
(CHARACTER 13))
1)
(for HitCard in HitCards unless (EQ HitCard Card)
do (NC.InsertLinkBeforeMarker Card HitCard
NC.ListContentsLinkLabel NIL NIL))
(NC.PrintMsg Window NIL "Done!" (CHARACTER 13)))
(BLOCK 250)
(NC.ClearMsg Window T)
WindowOrCard))))
)
(PUTPROPS RHTPATCH126 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (681 5833 (NC.MakeDocument 691 . 5831)) (5870 8081 (NC.MakeSearchCard 5880 . 8079)))))
STOP