(FILECREATED "25-Mar-87 17:16:08" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH225.;3 11443
changes to: (VARS RHTPATCH225COMS)
(FNS NC.GetFileFromUser NC.MakeFileCardCore NC.DeleteNoteCard)
previous date: "25-Mar-87 16:25:10" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH225.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH225COMS)
(RPAQQ RHTPATCH225COMS ((* * Fixes bug #487: FileCard prompt window gets screwed up during
reshaping. Also cleaned up various antiquities in the code. Also adds
new args to NC.DeleteNoteCard. Makes minor fix to NC.PutProp.)
(DECLARE: COPY FIRST (P (LOAD? (NC.FindFile (QUOTE NCFILECARD)))))
(* * Changes to NCFILECARD)
(FNS NC.FileCardTitle NC.GetFileFromUser NC.MakeFileCardCore
NC.EditFileSubstance)
(* * These should be the ONLY globalvars in NCFILECARD. The others need to
be removed.)
(GLOBALVARS NC.DefaultFont TEDIT.DEFAULT.MENU NC.FileCardIcon)
(* * Changes to NCCARDS)
(FNS NC.PutProp NC.DeleteNoteCard)))
(* * Fixes bug #487: FileCard prompt window gets screwed up during reshaping. Also cleaned up
various antiquities in the code. Also adds new args to NC.DeleteNoteCard. Makes minor fix to
NC.PutProp.)
(DECLARE: COPY FIRST
(LOAD? (NC.FindFile (QUOTE NCFILECARD)))
)
(* * Changes to NCFILECARD)
(DEFINEQ
(NC.FileCardTitle
(LAMBDA (Card) (* rht: "25-Mar-87 15:40")
(* * Determine the title for file card ID)
(* * fgh 12/17/85 Updated for 1.3 and multiple open NoteFiles.)
(LET ((FileName (NC.FetchSubstance Card)))
(CONCAT (FILENAMEFIELD FileName (QUOTE NAME))
"."
(OR (FILENAMEFIELD FileName (QUOTE EXTENSION))
"")))))
(NC.GetFileFromUser
(LAMBDA (Window DontClearPromptFlg FirstTry) (* rht: "25-Mar-87 17:08")
(* * Create a file designator)
(* * rht 3/25/87: Changed to call NC.AskYesOrNo.)
(LET (FileName FullFileName)
(SETQ FileName (NC.AskUser "Enter file name" ": " FirstTry (NULL DontClearPromptFlg)
Window T NIL T))
(PROG1 (COND
((SETQ FullFileName (INFILEP FileName))
(PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
FullFileName))
((NULL (SETQ FullFileName (FULLNAME FileName (QUOTE NEW))))
(NC.PrintMsg Window T FileName " is not a legal file name." (CHARACTER
13)
"Please try again."
(CHARACTER 13))
(NC.GetFileFromUser Window T))
((NC.YesP (NC.AskYesOrNo (CONCAT "Do you want me to create " FullFileName)
" ? " "Yes" T Window NIL NIL T))
(PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
(CLOSEF (PROG1 (SETQ FileName (OPENSTREAM FileName
(QUOTE
OUTPUT)
(QUOTE
NEW)))
(BOUT FileName 32)))))
((NC.YesP (NC.AskYesOrNo "Do you want to specify another file name?" " -- "
"No"
T Window NIL NIL T))
(NC.GetFileFromUser Window DontClearPromptFlg FirstTry))
(T NIL))
(NC.ClearMsg Window T)))))
(NC.MakeFileCardCore
(LAMBDA (Card Title NoDisplayFlg) (* rht: "25-Mar-87 17:06")
(* * Make a new card of type File -- Core procedure)
(* * fgh 12/17/85 Updated for 1.3 multiple open NF changes)
(* * fgh 6/1/86 Updated with new title bar menu scheme)
(* * rht 3/25/87: Cleaned up lots of outdated cruftiness.)
(LET (FileName TextStream)
(if (NOT NoDisplayFlg)
then (LET (Window)
(SETQ Window (NC.MakeNewCardWindow Card (OR Title
"Creating File card ...")))
(NCP.SetUpTitleBar Window (NC.RetrieveType Card))
(WINDOWADDPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.FileCardShrinkFn))
(TEDIT NIL Window NIL (LIST (QUOTE FONT)
NC.DefaultFont
(QUOTE TITLEMENUFN)
(FUNCTION NC.TEditMenuFn)
(QUOTE PROMPTWINDOW)
(QUOTE DON'T)))
(until (SETQ TextStream (NC.SetTextStream Card (WINDOWPROP
Window
(QUOTE TEXTSTREAM))))
do (BLOCK))
(if (SETQ FileName (NC.GetFileFromUser Window))
then (TEDIT.INCLUDE (TEXTOBJ TextStream)
FileName)
(NC.SetSubstance Card FileName)
(WINDOWPROP Window (QUOTE TITLE)
(NC.SetTitle Card (NC.FileCardTitle Card)))
(NC.PutProp Card (QUOTE FileName)
FileName)
(NC.PutProp Card (QUOTE FileVersion)
(NC.FileCardFileVersionNumber Card))
(GIVE.TTY.PROCESS Window)
Window
else (NC.DeleteNoteCard Card NIL T)
NIL))
else (SETQ FileName (NC.GetFileFromUser))
(NC.SetSubstance Card FileName)
(NC.SetTitle Card (NC.FileCardTitle Card))
Card))))
(NC.EditFileSubstance
(LAMBDA (Card FileDesignator RegionOrPosition) (* rht: "25-Mar-87 16:14")
(* * Bring up a TEdit window for Card ID whose substance is specified by file designator in Region specified by
RegionOrPosition or by the user.)
(* * fgh 12/17/85 Updated for 1.3 and multiple open NFs)
(* * fgh 6/1/86 Updated with new title bar menu scheme)
(* * rht 11/16/86: Now moves window to RegionOrPosition if already up.)
(PROG (Region TEditWindow TEditProcess Title NewFileName)
(if (SETQ TEditWindow (NC.FetchWindow Card))
then (TOTOPW TEditWindow)
(if RegionOrPosition
then (SHAPEW TEditWindow (NC.DetermineDisplayRegion Card
RegionOrPosition)))
(RPTQ 2 (FLASHW TEditWindow))
(if (SETQ TEditProcess (WINDOWPROP TEditWindow (QUOTE PROCESS)))
then (TTY.PROCESS TEditProcess)
else (* Process may have been turned off.
Try to restart.)
(SETQ TEditProcess (RESTART-PROCESS-OF-TEDIT-WINDOW TEditWindow)))
(RETURN TEditWindow))
(SETQ Region (NC.DetermineDisplayRegion Card RegionOrPosition))
(SETQ Title (NC.RetrieveTitle Card))
(SETQ TEditWindow (CREATEW Region Title NIL NIL))
(WINDOWADDPROP TEditWindow (QUOTE SHRINKFN)
(FUNCTION NC.FileCardShrinkFn))
(NCP.SetUpTitleBar TEditWindow (NC.RetrieveType Card))
(COND
((NULL (INFILEP FileDesignator))
(NC.PrintMsg TEditWindow T FileDesignator " is no longer a file." (CHARACTER
13))
(COND
((NC.YesP (NC.AskUser "Do you want to create the file?" " -- " "Yes" NIL
TEditWindow NIL NIL T))
(CLOSEF (PROG1 (SETQ FileDesignator (OPENSTREAM FileDesignator
(QUOTE OUTPUT)
(QUOTE NEW)))
(BOUT FileDesignator 32))))
((NC.YesP (NC.AskUser "Do you want to respecify the file name?" " -- " "Yes"
NIL TEditWindow NIL NIL T))
(SETQ FileDesignator (NC.GetFileFromUser TEditWindow T))
(NC.SetSubstance Card FileDesignator)
(NC.MarkCardDirty Card)
(NC.SetTitle Card (NC.FileCardTitle Card))
(NC.SetTitleDirtyFlg Card T)
(WINDOWPROP TEditWindow (QUOTE TITLE)
(NC.SetTitle Card (NC.FileCardTitle Card)))
(NC.PutProp Card (QUOTE FileName)
FileDesignator))
(T (CLOSEW TEditWindow)
(RETURN NIL)))))
(TEDIT FileDesignator TEditWindow NIL (LIST (QUOTE FONT)
NC.DefaultFont
(QUOTE TITLEMENUFN)
(FUNCTION NC.TEditMenuFn)
(QUOTE PROMPTWINDOW)
(QUOTE DON'T)))
(NC.SetTextStream Card (WINDOWPROP TEditWindow (QUOTE TEXTSTREAM)))
(NC.PutProp Card (QUOTE FileVersion)
(NC.FileCardFileVersionNumber Card))
(RETURN TEditWindow))))
)
(* * These should be the ONLY globalvars in NCFILECARD. The others need to be removed.)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.DefaultFont TEDIT.DEFAULT.MENU NC.FileCardIcon)
)
(* * Changes to NCCARDS)
(DEFINEQ
(NC.PutProp
(LAMBDA (Card Prop Value) (* rht: "25-Mar-87 16:11")
(* * Put a property value pair on the NoteCardsPropList property of ID. ID must be active.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * rht 3/25/87: Now calls NC.SetPropListDirtyFlg to mark prop list as dirty.)
(PROG ((PropList (NC.FetchPropList Card)))
(COND
(PropList (LISTPUT PropList Prop Value)
(NC.SetPropList Card PropList))
(T (NC.SetPropList Card (LIST Prop Value))))
(NC.SetPropListDirtyFlg Card T))))
(NC.DeleteNoteCard
(LAMBDA (CardIdentifier DontClearFlg NoConfirmFlg QuietFlg InterestedWindow)
(* rht: "25-Mar-87 17:06")
(* * User interface level fn to delete a single note card from a NoteFile)
(* * rht 3/25/87: Added a bunch of new args. Fixed InterestedWindow stuff.)
(LET ((Card (NC.CoerceToCard CardIdentifier)))
(if (NC.ValidCardP Card)
then (OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow
Card)))
(NC.ProtectedCardOperation Card "Delete Note Card" InterestedWindow
(AND (if (NC.TopLevelCardP Card)
then (NC.PrintMsg InterestedWindow T
"You cannot delete this FileBox."
(CHARACTER 13))
(DISMISS 1000)
(NC.ClearMsg InterestedWindow T)
NIL
else T)
(NC.CheckForNotReadOnly Card InterestedWindow
"Can't delete cards from a ")
(OR NoConfirmFlg
(PROG1 (NC.AskYesOrNo
"Are you sure you want to delete this?"
" -- " "Yes"
(NULL
DontClearFlg)
InterestedWindow NIL
NIL)
(NC.ClearMsg InterestedWindow
T)))
(PROGN
(* * Mark UID of card about to be deleted.)
(NC.UIDPutProp (fetch
(Card UID)
of Card)
(QUOTE
AboutToBeDeletedFlg)
T)
(* * Sever all links into and out of Card)
(NC.SeverAllLinks (LIST Card)
QuietFlg
InterestedWindow)
(* * Now delete the card)
(NC.DeleteNoteCardInternal Card
QuietFlg
InterestedWindow)))))
)))
)
(PUTPROPS RHTPATCH225 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1385 8496 (NC.FileCardTitle 1395 . 1852) (NC.GetFileFromUser 1854 . 3394) (
NC.MakeFileCardCore 3396 . 5335) (NC.EditFileSubstance 5337 . 8494)) (8722 11361 (NC.PutProp 8732 .
9376) (NC.DeleteNoteCard 9378 . 11359)))))
STOP