(FILECREATED " 5-Jul-86 22:44:19" {QV}<NOTECARDS>1.3K>FGHPATCH092.;3 16788
changes to: (VARS FGHPATCH092COMS)
(FNS NC.RenameNoteFile NC.DeleteDatabaseFile NC.RemoveAccessToNoteFile
NC.SetUpNoteFileInterface NC.CopyNoteFile)
previous date: " 5-Jul-86 21:43:39" {QV}<NOTECARDS>1.3K>FGHPATCH092.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FGHPATCH092COMS)
(RPAQQ FGHPATCH092COMS ((* * Fixes to NC.CopyNoteFile and definition of NC.RenameNoteFile. Also
definition of NC.RemoveAccessToNoteFile and use in
NC.DeleteDatabaseFile.)
(* * Depends on RHTPATCH052)
(FILES RHTPATCH052)
(* * redefined FNS from NCINTERFACE)
(FNS NC.SetUpNoteFileInterface)
(* * redefined FNS from NCDATABASE)
(FNS NC.CopyNoteFile NC.DeleteDatabaseFile)
(* * New FNS for NCDATABASE)
(FNS NC.RenameNoteFile NC.RemoveAccessToNoteFile)
(* * New parameter to be added to NCPARAMETERS but not yet to the param
editor)
(GLOBALVARS NC.MsgDelay)
(VARS (NC.MsgDelay 1500))))
(* * Fixes to NC.CopyNoteFile and definition of NC.RenameNoteFile. Also definition of
NC.RemoveAccessToNoteFile and use in NC.DeleteDatabaseFile.)
(* * Depends on RHTPATCH052)
(FILESLOAD RHTPATCH052)
(* * redefined FNS from NCINTERFACE)
(DEFINEQ
(NC.SetUpNoteFileInterface
(LAMBDA (NoteFile Position) (* fgh: " 5-Jul-86 22:34")
(* * Create the NoteCards control menu for a NoteFile)
(* * kirk 13Jan85 Decreased the size of the NoteFile Menu)
(* * fgh 1/22/86 Fixed the ghost box size when position menu.)
(* * rht 5/6/86: Now restores the menu's WhenSelectedFn and ungrays its items if already existed.)
(* * fgh 6/27/86 Added position argument)
(* * rht 7/5/86: Now shades NewCards if readonly notefile.)
(* * fgh 7/6/86 Will now set up menu correctly even if NF is closed.)
(LET ((Font (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE BOLD)))
(TitleFont (FONTCREATE (QUOTE HELVETICA)
12
(QUOTE BOLD)))
NoteFileMenuWindow NoteFileMenu FullFileName) (* Main Menu)
(SETQ FullFileName (fetch (NoteFile FullFileName) of NoteFile))
(if (SETQ NoteFileMenu (fetch (NoteFile Menu) of NoteFile))
then (replace (MENU WHENSELECTEDFN) of NoteFileMenu
with (if (NC.NoteFileOpenP NoteFile)
then (FUNCTION NC.NoteFileMenuWhenSelectedFn)
else (FUNCTION NC.ClosedNoteFileMenuWhenSelectedFn)))
(replace (MENU TITLE) of NoteFileMenu with (CONCAT (if (
NC.ReadOnlyNoteFileP
NoteFile)
then "RO: "
else "")
(FILENAMEFIELD
FullFileName
(QUOTE NAME))
";"
(FILENAMEFIELD
FullFileName
(QUOTE VERSION)))
)
(replace (MENU IMAGE) of NoteFileMenu with NIL)
(* KLUDGE. Fetching the image height forces the menu
package to recompute the menu image.)
(fetch (MENU IMAGEHEIGHT) of NoteFileMenu)
(AND (WFROMMENU NoteFileMenu)
(REDISPLAYW (WFROMMENU NoteFileMenu)))
else (SETQ NoteFileMenu (create MENU
ITEMS ←(QUOTE ((NewCards NIL
"Create a new Text card (left button) or other card type (middle button).")
(Show% Box NIL
"Bring up one of the standard FileBoxes.")))
WHENSELECTEDFN ←(if (NC.NoteFileOpenP NoteFile)
then (FUNCTION
NC.NoteFileMenuWhenSelectedFn)
else (FUNCTION
NC.ClosedNoteFileMenuWhenSelectedFn))
CENTERFLG ← T
MENUBORDERSIZE ← 1
MENUOUTLINESIZE ← 2
MENUCOLUMNS ← 2
MENUFONT ← Font
TITLE ←(CONCAT (if (NC.ReadOnlyNoteFileP
NoteFile)
then "RO: "
else "")
(FILENAMEFIELD FullFileName
(QUOTE NAME))
";"
(FILENAMEFIELD FullFileName
(QUOTE VERSION)))
ITEMHEIGHT ←(IPLUS 6 (FONTPROP Font
(QUOTE HEIGHT)))
ITEMWIDTH ←(IPLUS (STRINGWIDTH (QUOTE NewCards)
Font)
10)
MENUTITLEFONT ← TitleFont)))
(for Item in (fetch (MENU ITEMS) of NoteFileMenu)
do (SHADEITEM Item NoteFileMenu (if (NC.NoteFileOpenP NoteFile)
then WHITESHADE
else GRAYSHADE)))
(* Shade NewCards if readonly notefile.)
(if (NC.ReadOnlyNoteFileP NoteFile)
then (for Item in (fetch (MENU ITEMS) of NoteFileMenu)
when (EQ (CAR Item)
(QUOTE NewCards))
do (SHADEITEM Item NoteFileMenu GRAYSHADE)))
(if (WINDOWP (SETQ NoteFileMenuWindow (WFROMMENU NoteFileMenu)))
then (FLASHWINDOW NoteFileMenuWindow)
else (SETQ NoteFileMenuWindow (ADDMENU NoteFileMenu NIL (GETMENUPROP NoteFileMenu
(QUOTE
OldPosition)
))))
(WINDOWPROP NoteFileMenuWindow (QUOTE NoteFile)
NoteFile)
(replace (NoteFile Menu) of NoteFile with NoteFileMenu)
(WINDOWPROP NoteFileMenuWindow (QUOTE RESHAPEFN)
(QUOTE DON'T))
(WINDOWPROP NoteFileMenuWindow (QUOTE BUTTONEVENTFN)
(FUNCTION NC.NoteFileIconButtonEventFn))
(WINDOWPROP NoteFileMenuWindow (QUOTE SHRINKFN)
(QUOTE DON'T))
(WINDOWADDPROP NoteFileMenuWindow (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (Window)
(PUTMENUPROP (CAR (WINDOWPROP Window (QUOTE MENU)))
(QUOTE OldPosition)
(WINDOWPOSITION Window)))))
(NC.MoveWindowOntoScreen NoteFileMenuWindow))))
)
(* * redefined FNS from NCDATABASE)
(DEFINEQ
(NC.CopyNoteFile
(LAMBDA (FromNoteFileOrName ToFileName Window) (* fgh: " 5-Jul-86 22:36")
(* * Copy a notefile. Ask user for names of FromNoteFileOrName and ToFileName.)
(* * fkr 11/8/85: Ripped out PSA.Database check. Now takes FromNoteFileOrName and ToFileName args.)
(* * kirk 19May86 Fixed to work from NoteFile menu)
(* * fgh 6/24/86 Fixed bug where would not work if NULL FromNoteFileOrName)
(* * fgh 7/5/86 Closes prompt window when done.)
(PROG (FullFromFileName Result (MsgWindow Window))
(if (type? NoteFile FromNoteFileOrName)
then (SETQ FullFromFileName (fetch (NoteFile FullFileName) of
FromNoteFileOrName))
(SETQ MsgWindow (OR (WFROMMENU (fetch (NoteFile Menu) of
FromNoteFileOrName))
Window))
else (OR FromNoteFileOrName (SETQ FromNoteFileOrName
(NC.DatabaseFileName "Name of NoteFile to be copied:" " -- " T NIL NIL
MsgWindow))
(RETURN))
(SETQ FullFromFileName (FULLNAME FromNoteFileOrName))
(if (SETQ NoteFile (NC.NoteFileFromFileName FullFromFileName))
then (SETQ MsgWindow (OR (WFROMMENU (fetch (NoteFile Menu)
of NoteFile))
Window))))
(if (OPENP FullFromFileName)
then (NC.PrintMsg MsgWindow T "Can't copy an open notefile." (CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg MsgWindow T)
(RETURN NIL))
(OR ToFileName (SETQ ToFileName (NC.DatabaseFileName "Name of target of copy:"
" -- "
T NIL NIL MsgWindow))
(RETURN))
(COND
((AND FullFromFileName ToFileName)
(NC.PrintMsg MsgWindow T "Copying " FullFromFileName " to " ToFileName " ...")
(COND
((SETQ Result (COPYFILE FullFromFileName ToFileName))
(NC.PrintMsg MsgWindow T FullFromFileName " copied to " Result "."
(CHARACTER 13))
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
Result))
(DISMISS NC.MsgDelay)
(NC.ClearMsg MsgWindow T))))
((NULL FullFromFileName)
(NC.PrintMsg MsgWindow T "Can't open file for copy: " FromNoteFileOrName
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg MsgWindow T))))))
(NC.DeleteDatabaseFile
(LAMBDA (FileNameOrNoteFile InterestedWindow Don'tConfirmFlg)
(* fgh: " 5-Jul-86 21:56")
(* Delete file FileName)
(* * rht 8/7/84: If delete happens, clear NC.DatabaseFileNameSuggestion.)
(* * rht 3/17/85: Fixed for case when user specifies version number of file to delete.)
(* * fkr 11/8/85: Ripped out PSA.Database check. Added check for file open.)
(* * kirk 23Jan86 Changed to use NC.AskYesOrNo)
(* * fgh 6/24/86 Added ability to pass down NoteFile object as well as file name. Added code to remove NF from NFs
hash array and remove the menu on the screen.)
(* * rht 7/2/86: No longer prints completed message with DISMISS. Now returns non-nil if successful.
Accepts Don'tConfirmFlg arg.)
(* * fgh 7/5/86 Added call to RemoveAccessToNoteFile.)
(PROG ((FileName (if (type? NoteFile FileNameOrNoteFile)
then (fetch (NoteFile FullFileName) of FileNameOrNoteFile)
else FileNameOrNoteFile))
FullFileName) (* Make sure no open databases)
(* Get file name)
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName "Name of Notefile to be deleted:"
" -- "
T NIL NIL InterestedWindow)))
(RETURN NIL)) (* make sure to be deleted file exists)
(SETQ FullFileName (if (FILENAMEFIELD FileName (QUOTE VERSION))
then (FULLNAME FileName)
else (CAR (FILDIR-EARLIEST FileName))))
(COND
((NULL FullFileName)
(NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T FileName " does not exist." (CHARACTER 13)
"Delete cancelled."
(CHARACTER 13))
(RETURN)))
(* * Can't delete an open file.)
(if (OPENP FullFileName)
then (NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T FileName " is an open file." (CHARACTER 13)
"Delete cancelled."
(CHARACTER 13))
(RETURN)) (* Ask user to confirm twice.)
(OR Don'tConfirmFlg (COND
((NOT (NC.AskYesOrNo (CONCAT "Are you sure you want to delete "
(CHARACTER 13)
FullFileName "?" (CHARACTER 13))
" -- " "No" T (NC.AttachPromptWindow InterestedWindow)
(NOT InterestedWindow)))
(NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T FullFileName " not deleted." (CHARACTER 13))
(RETURN))))
(NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T "Deleteing " FullFileName (CHARACTER 13))
(DISMISS 1000)
(OR Don'tConfirmFlg (COND
((NOT (NC.AskYesOrNo (CONCAT "Are you still sure you want to delete "
(CHARACTER 13)
FullFileName "?" (CHARACTER 13))
" -- " "No" T (NC.AttachPromptWindow InterestedWindow)
(NOT InterestedWindow)))
(NC.PrintMsg (NC.AttachPromptWindow InterestedWindow)
T FullFileName " not deleted." (CHARACTER 13))
(RETURN))))
(* * Remove this NF from NoteFiles hash array. array and close down any menu)
(NC.RemoveAccessToNoteFile FullFileName)
(* * Delete the file)
(SETQ FullFileName (DELFILE FullFileName))
(SETQ NC.DatabaseFileNameSuggestion NIL)
(NC.ClearMsg (NC.AttachPromptWindow InterestedWindow)
T)
(RETURN FullFileName))))
)
(* * New FNS for NCDATABASE)
(DEFINEQ
(NC.RenameNoteFile
(LAMBDA (FromNoteFileOrName ToFileName Window) (* fgh: " 5-Jul-86 22:18")
(* * Rename a notefile. Ask user for names of FromNoteFileOrName and ToFileName.)
(* * fgh 7/5/86 First created on basis of CopyNoteFile.)
(PROG (FullFromFileName Result (MsgWindow Window))
(if (type? NoteFile FromNoteFileOrName)
then (SETQ FullFromFileName (fetch (NoteFile FullFileName) of
FromNoteFileOrName))
(SETQ MsgWindow (OR (WFROMMENU (fetch (NoteFile Menu) of
FromNoteFileOrName))
Window))
else (OR FromNoteFileOrName (SETQ FromNoteFileOrName
(NC.DatabaseFileName "Name of NoteFile to be renamed:" " -- " T NIL
NIL MsgWindow))
(RETURN))
(SETQ FullFromFileName (FULLNAME FromNoteFileOrName))
(if (SETQ NoteFile (NC.NoteFileFromFileName FullFromFileName))
then (SETQ MsgWindow (OR (WFROMMENU (fetch (NoteFile Menu)
of NoteFile))
Window))))
(if (OPENP FullFromFileName)
then (NC.PrintMsg MsgWindow T "Can't rename an open notefile." (CHARACTER
13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg MsgWindow T)
(RETURN NIL))
(OR ToFileName (SETQ ToFileName (NC.DatabaseFileName "New name for the NoteFile:"
" -- "
T NIL NIL MsgWindow))
(RETURN))
(COND
((AND FullFromFileName ToFileName)
(NC.PrintMsg MsgWindow T "Renaming " FullFromFileName " to " ToFileName " ...")
(COND
((SETQ Result (RENAMEFILE FullFromFileName ToFileName))
(NC.PrintMsg MsgWindow T FullFromFileName " renamed to " Result "."
(CHARACTER 13))
(* * Fix up the NoteFile with the new name.)
(AND NoteFile (replace (NoteFile FullFileName) of NoteFile with Result)
(AND (fetch (NoteFile Menu) of NoteFile)
(WFROMMENU (fetch (NoteFile Menu) of NoteFile))
(NC.SetUpNoteFileInterface NoteFile)))
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
Result))
(DISMISS NC.MsgDelay)
(NC.ClearMsg MsgWindow T))))
((NULL FullFromFileName)
(NC.PrintMsg MsgWindow T "Can't open file for rename: " FromNoteFileOrName
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg MsgWindow T))))))
(NC.RemoveAccessToNoteFile
(LAMBDA (NoteFileOrFileNameOrUID) (* fgh: " 5-Jul-86 22:13")
(* * Remove a NoteFile from the NoteFiles hash array and close its menu if its on the screen.)
(LET ((NoteFileObject (if (type? NoteFile NoteFileOrFileNameOrUID)
then NoteFileOrFileNameOrUID
elseif (type? UID NoteFileOrFileNameOrUID)
then (GETHASH NoteFileOrFileNameOrUID NC.NoteFilesHashArray)
else (NC.NoteFileFromFileName NoteFileOrFileNameOrUID)))
Menu)
(if NoteFileObject
then (PUTHASH (fetch (NoteFile UID) of NoteFileObject)
NIL NC.NoteFilesHashArray)
(SETQ Menu (fetch (NoteFile Menu) of NoteFileObject))
(if Menu
then (CLOSEW (WFROMMENU Menu)))))))
)
(* * New parameter to be added to NCPARAMETERS but not yet to the param editor)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.MsgDelay)
)
(RPAQQ NC.MsgDelay 1500)
(PUTPROPS FGHPATCH092 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1354 6384 (NC.SetUpNoteFileInterface 1364 . 6382)) (6427 12968 (NC.CopyNoteFile 6437 .
9007) (NC.DeleteDatabaseFile 9009 . 12966)) (13004 16528 (NC.RenameNoteFile 13014 . 15664) (
NC.RemoveAccessToNoteFile 15666 . 16526)))))
STOP