(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED "15-Sep-88 15:35:01" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH111.;7 44422
changes to%: (FNS NCP.SetGrayShade NC.CreateNoteFileMenuItems
NC.MakeNoteFileIconOperationsMenus NC.NoticedNoteFileNamesMenu
NCP.ResetNoticedNoteFileNamesMenu NC.NoteFileIconButtonEventFn
NC.ResetNoteFileInterface NC.GreyCard NC.SetUpNoteFileInterface)
(VARS PMIPATCH111COMS)
previous date%: " 9-Sep-88 18:32:12" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH111.;1)
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT PMIPATCH111COMS)
(RPAQQ PMIPATCH111COMS
(
(* ;;; "New file")
(DECLARE%: DONTCOPY (PROPS (PMIPATCH111 MAKEFILE-ENVIRONMENT)
(PMIPATCH111 FILETYPE)))
[DECLARE%: FIRST (P (NC.LoadFileFromDirectories 'NEWSHADEITEM]
(* ;; "pmi 9/13/88: Changed menu of notefiles to have shaded text (for notefiles not available for the current operation) only on the notefile name (left side). The shade used is determined by the value of NCP.GrayShade, instead of GRAYSHADE.")
(* ;; "Also changed other places in the interface using GRAYSHADE to use NCP.GrayShade instead. NCP.GrayShade is set to GRAYSHADE initially, and may be changed via the new function NCP.SetGrayShade. Also uses NEWSHADEITEM to produce menus with unavailable items displayed with grayed text.")
(* ;; "NOTE: the file NEWSHADEITEM will need to be loaded by NoteCards (it is loaded by this patch file). It is currently on {qv}<notecards>1.3l>library>, but it will probably be made into a LISPUSERS package after we check it out.")
(* ;; "Changed in NCINTERFACE")
(FNS NC.CreateNoteFileMenuItems NC.MakeNoteFileIconOperationsMenus
NC.NoteFileIconButtonEventFn NC.ResetNoteFileInterface NC.SetUpNoteFileInterface)
(* ;; "Changed in NCDATABASE")
(FNS NC.NoticedNoteFileNamesMenu)
(* ;; "Changed in NCUTILITIES")
(FNS NC.GreyCard)
(* ;; "New for NCPROGINT")
(GLOBALVARS NCP.GrayShade)
(INITVARS (NCP.GrayShade GRAYSHADE))
(FNS NCP.SetGrayShade)
(* ;; "For the patch file only, to reset the current menus:")
(P (NCP.SetGrayShade))))
(* ;;; "New file")
(DECLARE%: DONTCOPY
(PUTPROPS PMIPATCH111 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS PMIPATCH111 FILETYPE :BCOMPL)
)
(DECLARE%: FIRST
(NC.LoadFileFromDirectories 'NEWSHADEITEM)
)
(* ;;
"pmi 9/13/88: Changed menu of notefiles to have shaded text (for notefiles not available for the current operation) only on the notefile name (left side). The shade used is determined by the value of NCP.GrayShade, instead of GRAYSHADE."
)
(* ;;
"Also changed other places in the interface using GRAYSHADE to use NCP.GrayShade instead. NCP.GrayShade is set to GRAYSHADE initially, and may be changed via the new function NCP.SetGrayShade. Also uses NEWSHADEITEM to produce menus with unavailable items displayed with grayed text."
)
(* ;;
"NOTE: the file NEWSHADEITEM will need to be loaded by NoteCards (it is loaded by this patch file). It is currently on {qv}<notecards>1.3l>library>, but it will probably be made into a LISPUSERS package after we check it out."
)
(* ;; "Changed in NCINTERFACE")
(DEFINEQ
(NC.CreateNoteFileMenuItems
[LAMBDA (FullFileName) (* ; "Edited 14-Sep-88 11:52 by pmi")
(* ;;; "pmi 5/21/87: creates a menu item bitmap for this notefile.")
(* ;;; "pmi 8/18/87: Renamed from NC.CreateMenuBitmaps to construct the entire menu item instead of just the bitmap. Also changed 'o' (for open) to print in BOLD face.")
(* ;;; "pmi 9/13/88: Now only short name is shaded if the notefile is not available for an operation. Added two bitmaps for shaded open and shaded closed notefiles, since menu item shading is no longer done with SHADEITEM.")
(DECLARE (GLOBALVARS NC.FileNameFont NC.FullFileNameFont NC.MaxFileNameChars NCP.GrayShade))
(PROG [FileNameString FullFileNameString NameWidth MaxNameWidth SpaceWidth oWidth FullNameWidth
FullNameMargin FontDescent BitmapHeight HalfBitmapHeight BitmapWidth OpenMenuBitmap
OpenMenuBitmapShaded ClosedMenuBitmap ClosedMenuBitmapShaded OpenDisplayStream
OpenDisplayStreamShaded ClosedDisplayStream ClosedDisplayStreamShaded
(NC.BoldFullFileNameFont (FONTCOPY NC.FullFileNameFont 'WEIGHT 'BOLD]
(if [OR (NULL FullFileName)
(AND (GETPROP FullFileName 'OpenMenuItem)
(GETPROP FullFileName 'OpenMenuItemShaded)
(GETPROP FullFileName 'ClosedMenuItem)
(GETPROP FullFileName 'ClosedMenuItemShaded]
then (RETURN))
(SETQ FileNameString (MKSTRING (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'EXTENSION NIL
'BODY FullFileName)))
(SETQ FullFileNameString (MKSTRING (L-CASE FullFileName)))
(SETQ NameWidth (STRINGWIDTH FileNameString NC.FileNameFont))
(SETQ FullNameWidth (STRINGWIDTH FullFileNameString NC.FullFileNameFont))
(SETQ MaxNameWidth (STRINGWIDTH (ALLOCSTRING NC.MaxFileNameChars "X")
NC.FileNameFont))
(SETQ SpaceWidth (STRINGWIDTH " " NC.FullFileNameFont))
(SETQ oWidth (STRINGWIDTH "o" NC.BoldFullFileNameFont))
(if (GREATERP NameWidth MaxNameWidth)
then (SETQ FullNameMargin (PLUS SpaceWidth oWidth SpaceWidth NameWidth SpaceWidth))
else (SETQ FullNameMargin (PLUS SpaceWidth oWidth SpaceWidth MaxNameWidth SpaceWidth)))
(SETQ FontDescent (FONTDESCENT NC.FileNameFont))
(* ;;; "Calculate the size of the bitmaps.")
(SETQ BitmapHeight (FONTHEIGHT NC.FileNameFont))
(SETQ HalfBitmapHeight (IQUOTIENT BitmapHeight 2))
(SETQ BitmapWidth (PLUS FullNameMargin FullNameWidth SpaceWidth))
(* ;;; "Create the bitmaps for the open notefile, shaded and unshaded.")
(SETQ OpenMenuBitmap (BITMAPCREATE BitmapWidth BitmapHeight))
(SETQ OpenMenuBitmapShaded (BITMAPCREATE BitmapWidth BitmapHeight))
(SETQ OpenDisplayStream (DSPCREATE OpenMenuBitmap))
(SETQ OpenDisplayStreamShaded (DSPCREATE OpenMenuBitmapShaded))
(MOVETO SpaceWidth FontDescent OpenDisplayStream)
(DSPFONT NC.BoldFullFileNameFont OpenDisplayStream)
(PRIN1 "o" OpenDisplayStream)
(RELMOVETO SpaceWidth 0 OpenDisplayStream)
(DSPFONT NC.FileNameFont OpenDisplayStream)
(PRIN1 FileNameString OpenDisplayStream)
(MOVETO FullNameMargin FontDescent OpenDisplayStream)
(DSPFONT NC.FullFileNameFont OpenDisplayStream)
(PRIN1 FullFileNameString OpenDisplayStream)
(BITBLT OpenMenuBitmap 0 0 OpenMenuBitmapShaded 0 0)
(BLTSHADE NCP.GrayShade OpenDisplayStreamShaded (PLUS SpaceWidth oWidth)
0
(PLUS SpaceWidth NameWidth SpaceWidth)
BitmapHeight
'ERASE)
(* ;;; "Construct the full menu items for an open notefile.")
(PUTPROP FullFileName 'OpenMenuItem (LIST OpenMenuBitmap `',FullFileName (CONCAT
"Selects NoteFile "
FullFileName
)))
(PUTPROP FullFileName 'OpenMenuItemShaded (LIST OpenMenuBitmapShaded
`',FullFileName
(CONCAT "Selects NoteFile " FullFileName)))
(* ;;; "Create bitmaps for the closed notefile, shaded and unshaded.")
(SETQ ClosedMenuBitmap (BITMAPCREATE BitmapWidth BitmapHeight))
(SETQ ClosedMenuBitmapShaded (BITMAPCREATE BitmapWidth BitmapHeight))
(SETQ ClosedDisplayStream (DSPCREATE ClosedMenuBitmap))
(SETQ ClosedDisplayStreamShaded (DSPCREATE ClosedMenuBitmapShaded))
(MOVETO (PLUS SpaceWidth oWidth SpaceWidth)
FontDescent ClosedDisplayStream)
(DSPFONT NC.FileNameFont ClosedDisplayStream)
(PRIN1 FileNameString ClosedDisplayStream)
(MOVETO FullNameMargin FontDescent ClosedDisplayStream)
(DSPFONT NC.FullFileNameFont ClosedDisplayStream)
(PRIN1 FullFileNameString ClosedDisplayStream)
(BITBLT ClosedMenuBitmap 0 0 ClosedMenuBitmapShaded 0 0)
(BLTSHADE NCP.GrayShade ClosedDisplayStreamShaded (PLUS SpaceWidth oWidth)
0
(PLUS SpaceWidth NameWidth SpaceWidth)
BitmapHeight
'ERASE)
(* ;;; "Construct the full menu items for a closed notefile.")
(PUTPROP FullFileName 'ClosedMenuItem (LIST ClosedMenuBitmap `',FullFileName
(CONCAT "Selects NoteFile " FullFileName)))
(PUTPROP FullFileName 'ClosedMenuItemShaded (LIST ClosedMenuBitmapShaded
`',FullFileName
(CONCAT "Selects NoteFile " FullFileName)
))
(RETURN FullFileName])
(NC.MakeNoteFileIconOperationsMenus
[LAMBDA NIL (* ; "Edited 14-Sep-88 16:13 by pmi")
(* ;;;
"Rebuild the menus NC.OpenedNoteFileMenu and NC.ClosedNoteFileMenu smashing any current values.")
(* ;;
"pmi 9/12/88: Now uses NCP.GrayShade instead of GRAYSHADE to shade the disabled menu items.")
(DECLARE (GLOBALVARS NC.OpenedNoteFileMenu NC.ClosedNoteFileMenu
NC.NoteFileIconOperationsMenuItems NC.MenuFont NC.NoteFileIconOpenOperations
NC.NoteFileIconCloseOperations NCP.GrayShade))
(* ; "First, make two identical menus.")
(SETQ NC.OpenedNoteFileMenu
(create MENU
ITEMS ← NC.NoteFileIconOperationsMenuItems
CHANGEOFFSETFLG ← 'Y
MENUOFFSET ← (CONS -1 0)
CENTERFLG ← NIL
TITLE ← "NoteFile Ops"
MENUTITLEFONT ← NC.MenuFont
MENUFONT ← NC.MenuFont
ITEMHEIGHT ← (IPLUS (FONTPROP NC.MenuFont 'HEIGHT)
1)
WHENSELECTEDFN ← (FUNCTION NC.NoteFileTitleLeftWhenSelectedFn)))
(SETQ NC.ClosedNoteFileMenu
(create MENU
ITEMS ← NC.NoteFileIconOperationsMenuItems
CHANGEOFFSETFLG ← 'Y
MENUOFFSET ← (CONS -1 0)
CENTERFLG ← NIL
TITLE ← "NoteFile Ops"
MENUTITLEFONT ← NC.MenuFont
MENUFONT ← NC.MenuFont
ITEMHEIGHT ← (IPLUS (FONTPROP NC.MenuFont 'HEIGHT)
1)
WHENSELECTEDFN ← (FUNCTION NC.NoteFileTitleLeftWhenSelectedFn)))
(* ;
"Now, shade the appropriate inaccessible items of each.")
[for Item in (fetch (MENU ITEMS) of NC.OpenedNoteFileMenu)
do (if (MEMB (CAR Item)
NC.NoteFileIconOpenOperations)
then (SHADEITEM Item NC.OpenedNoteFileMenu WHITESHADE)
else (NEWSHADEITEM Item NC.OpenedNoteFileMenu NCP.GrayShade NIL 'ERASE]
[for Item in (fetch (MENU ITEMS) of NC.ClosedNoteFileMenu)
do (if (MEMB (CAR Item)
NC.NoteFileIconCloseOperations)
then (SHADEITEM Item NC.ClosedNoteFileMenu WHITESHADE)
else (NEWSHADEITEM Item NC.ClosedNoteFileMenu NCP.GrayShade NIL 'ERASE]
(replace (MENU IMAGE) of NC.OpenedNoteFileMenu with NIL)
(replace (MENU IMAGE) of NC.ClosedNoteFileMenu with NIL])
(NC.NoteFileIconButtonEventFn
[LAMBDA (Window) (* ; "Edited 12-Sep-88 14:26 by pmi")
(* ;; "Bring up NoteFile Menues")
(* ;; "kirk 15Jul86 Adjusted title size check for change in font")
(* ;;
"rht 11/23/86: Now calls NC.NoteFileIconMiddleButtonFn to put up a menu of middle button options.")
(* ;; "pmi 3/20/87: Overhauled to have NewCards and ShowCards middlebutton menus appear when buttoned DOWN, instead of after the button comes back up.")
(* ;; "pmi 4/3/87: Now unshades NewCards item during card creation to indicate that multiple cards may be created at the same time.")
(* ;; "rg 11/4/87 calls NC.EditNoteCard w/ ReadOnly if NoteFile is read-only")
(* ;; "pmi 2/23/88: Now passes Window as InterestedWindow argument to NC.MakeNoteCard.")
(* ;; "pmi 9/12/88: Now uses NCP.GrayShade instead of GRAYSHADE to indicate the disabled state of a menu item, and BLACKSHADE instead of GRAYSHADE to shade the menu items when they are selected.")
(DECLARE (GLOBALVARS BLACKSHADE NCP.GrayShade))
(LET
(NoteFile Menu)
(if (MOUSESTATE UP)
else
(TOTOPW Window)
(LET
[(Menu (CAR (WINDOWPROP Window 'MENU] (* ; "title bar")
(SETQ NoteFile (WINDOWPROP Window 'NoteFile))
(for Item in (fetch (MENU ITEMS) of Menu) when (INSIDEP (MENUITEMREGION Item Menu)
(LASTMOUSEX Window)
(LASTMOUSEY Window))
do (RESETLST
(RESETSAVE (SHADEITEM Item Menu BLACKSHADE)
(LIST 'SHADEITEM Item Menu (if (NULL (NC.NoteFileOpenP NoteFile))
then NCP.GrayShade
elseif (AND (EQ (CAR Item)
'NewCards)
(NC.ReadOnlyNoteFileP NoteFile))
then NCP.GrayShade
else WHITESHADE)))
(if (NULL (NC.NoteFileOpenP NoteFile))
then
(* ;;; "If the NoteFile is not open, just print a message and return")
(FLASHW Window)
(NC.PrintMsg Window T (fetch (NoteFile FullFileName) of NoteFile)
" is not an open notefile.")
(DISMISS 1000)
(NC.ClearMsg Window T)
elseif (PROCESSP (NC.NoteFileProp NoteFile 'ProcessInProgress))
then
(* ;;; "This will probably be overhauled with Randy G.'s concurrancy fixes")
(NC.PrintOperationInProgressMsg Window (CAR Item)
(NC.NoteFileProp NoteFile 'OperationInProgress))
NIL
else (SELECTQ (CAR Item)
(NewCards (if (NC.ReadOnlyNoteFileP NoteFile)
then (FLASHW Window)
(NC.PrintMsg Window T
"Can't create a new card in a Read-Only notefile."
)
(DISMISS 1000)
(NC.ClearMsg Window T)
elseif (LASTMOUSESTATE LEFT)
then
(* ;; "For the left button, don't do anything until the button comes back up. Otherwise, things happen too soon.")
(UNTILMOUSESTATE UP)
(if (INSIDEP (MENUITEMREGION Item Menu)
(LASTMOUSEX Window)
(LASTMOUSEY Window))
then (SHADEITEM Item Menu WHITESHADE)
(NC.MakeNoteCard NC.DefaultCardType NoteFile
NIL NIL NIL NIL Window))
else (SHADEITEM Item Menu WHITESHADE)
(NC.MakeNoteCard NIL NoteFile NIL NIL NIL NIL Window)))
(ShowCards (if (LASTMOUSESTATE LEFT)
then
(* ;; "For the left button, don't do anything until the button comes back up. Otherwise, things happen too soon.")
(UNTILMOUSESTATE UP)
(if (INSIDEP (MENUITEMREGION Item Menu)
(LASTMOUSEX Window)
(LASTMOUSEY Window))
then (NC.EditNoteCard (fetch (NoteFile
TableOfContentsCard
)
of NoteFile)
(fetch (NoteFile ReadOnlyFlg)
of NoteFile)))
else (NC.ChooseTopLevelCard NoteFile)))
NIL)))
(RETURN) finally (if (LASTMOUSESTATE MIDDLE)
then (NC.NoteFileIconMiddleButtonFn Window NoteFile)
elseif (NULL (WINDOWPROP Window 'BusyOperation))
then (RESETLST
(RESETSAVE (WINDOWPROP Window 'BusyOperation "Operation")
`(WINDOWPROP ,Window BusyOperation NIL))
(NC.NoteFileOperations NoteFile))
else (NC.PrintMsg NIL NIL (CHARACTER 13)
(WINDOWPROP Window 'BusyOperation)
" in progress. Please wait."])
(NC.ResetNoteFileInterface
[LAMBDA (NoteFile) (* ; "Edited 12-Sep-88 14:01 by pmi")
(* ;;; "Close up the control menu for a NoteFile")
(* ;; "rht 5/1/86: Now does nothing if NC.NoteFileMenuLingerFlg is non-nil.")
(* ;; "rht 5/6/86: Now smashes WhenSelectedFn and shades menu items if NC.NoteFileMenuLingerFlg is non-nil.")
(* ;; "pmi 2/18/87: Now deletes 'RO:' in title of NoteFile menu if NoteFile was open Read-only")
(* ;; "pmi 3/20/87: Removed WhenSelectedFn when overhauling to have NewCards and ShowCards middlebutton menus appear when buttoned DOWN, instead of after the button comes back up. Everything is now done in the ButtonEventFn.")
(* ;; "pmi 5/1/87: Inserted call to NC.ClearMsg before the NoteFile's icon is deleted. Added Window arg to DELETEMENU call. Also commented out the code that deletes the NoteFile's menu and removes the NoteFile from its window if NC.NoteFileMenuLingerFlg is NIL. That way if the NoteFile is reopened, it will remember the position for its icon.")
(* ;; "pmi 9/12/88: Now uses NCP.GrayShade instead of GRAYSHADE for shading menu items.")
(DECLARE (GLOBALVARS NC.NoteFileMenuLingerFlg NCP.GrayShade))
(LET ((Menu (fetch (NoteFile Menu) of NoteFile))
Window FullFileName)
(if Menu
then (SETQ Window (WFROMMENU Menu))
(if NC.NoteFileMenuLingerFlg
then (for Item in (fetch (MENU ITEMS) of Menu)
do (SHADEITEM Item Menu NCP.GrayShade))
(* ;
"(replace (MENU WHENSELECTEDFN) of Menu with (FUNCTION NC.ClosedNoteFileMenuWhenSelectedFn))")
(* ; "No longer need a WHENSELECTEDFN")
(if (NC.ReadOnlyNoteFileP NoteFile)
then (SETQ FullFileName (fetch (NoteFile FullFileName) of NoteFile))
[replace (MENU TITLE) of Menu with (CONCAT (FILENAMEFIELD
FullFileName
'NAME)
";"
(FILENAMEFIELD
FullFileName
'VERSION]
(replace (MENU IMAGE) of Menu with NIL)
(* ;;
"KLUDGE. Fetching the image height forces the menu package to recompute the menu image.")
(fetch (MENU IMAGEHEIGHT) of Menu)
(* ;;
"further KLUDGE. Have to smash MENUGRID to prevent menu image from being shifted over.")
(replace (MENU MENUGRID) of Menu
with (LIST 2 2 (fetch (MENU ITEMWIDTH) of Menu)
(fetch (MENU ITEMHEIGHT) of Menu)))
(AND Window (REDISPLAYW Window)))
else (NC.ClearMsg Window T) (* ;
"This code was removed so that if the NoteFile is reopened it will remember its position:")
(* ;
"(WINDOWPROP Window (QUOTE NoteFile) NIL)")
(* ;
"(replace (NoteFile Menu) of NoteFile with NIL)")
(WINDOWPROP Window 'CLOSEFN NIL)
(DELETEMENU Menu T Window])
(NC.SetUpNoteFileInterface
[LAMBDA (NoteFile Position InterestedWindow Don'tCreateInterfaceFlg)
(* ; "Edited 12-Sep-88 14:07 by pmi")
(* ;;; "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.")
(* ;; "rht 7/13/86: Was ignoring the Position arg. No longer.")
(* ;; "rht 11/20/86: Changed name from ShowBox to ShowCards.")
(* ;; " pmi 12/12/86: Added InterestedWindow argument so that we can print a prompt to the user about placing a newly created NoteFile menu.")
(* ;; "pmi 3/20/87: Removed WhenSelectedFn when overhauling to have NewCards and ShowCards middlebutton menus appear when buttoned DOWN, instead of after the button comes back up. Everything is now done in the ButtonEventFn.")
(* ;; "pmi 5/6/87: Moved prompt for position of icon to better place. Also added MENUOFFSET to NoteFile menu for Lyric.")
(* ;; "pmi 5/19/87: Now stores the menu as a property of the fullfilename of the notefile. We might lose our pointer to the notefile object if another one gets created with the same UID, but we would like to keep a pointer to the menu.")
(* ;; "pmi 5/28/87: Now returns the NoteFile Interface window.")
(* ;; "rg 12/15/87: fixes up menu grid so redisplay works when notefile is reopened.")
(* ;; "pmi 12/17/87 Added Don'tCreateInterfaceFlg argument in response to suggestion by dsj. Now can be called to update the notefile interface and won't automatically create a new one if it doesn't already exist.")
(* ;; "pmi 1/11/88: moved rg's last patch so that it applies to both new and preexisting notefile icon menus.")
(* ;; "pmi 8/29/88: No longer tries to set windowprops on NIL window, which were ending up on the Mouse TTY window.")
(* ;; "pmi 9/12/88: Now uses NCP.GrayShade instead of GRAYSHADE for shading menu items.")
(DECLARE (GLOBALVARS NCP.GrayShade))
(LET ((Font (FONTCREATE 'HELVETICA 10 'BOLD))
(TitleFont (FONTCREATE 'HELVETICA 12 'BOLD))
NoteFileMenuWindow NoteFileMenu FullFileName) (* ; "Main Menu")
(SETQ FullFileName (fetch (NoteFile FullFileName) of NoteFile))
[if (SETQ NoteFileMenu (OR (NC.GetNoteFileMenu NoteFile)
(NC.GetNoteFileMenu FullFileName)))
then
(* ;; "No longer need WHENSELECTEDFN")
(* ;; "(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
'NAME)
";"
(FILENAMEFIELD FullFileName
'VERSION]
else
(* ;; "Removed this menu field from following menu: (WHENSELECTEDFN ← (if (NC.NoteFileOpenP NoteFile) then (FUNCTION NC.NoteFileMenuWhenSelectedFn) else (FUNCTION NC.ClosedNoteFileMenuWhenSelectedFn)))")
(SETQ NoteFileMenu
(create MENU
ITEMS ← '((NewCards NIL
"Create a new Text card (left button) or other card type (middle button)."
)
(ShowCards NIL "Bring up one of the special cards."))
WHENSELECTEDFN ← (FUNCTION NILL)
CENTERFLG ← T
MENUBORDERSIZE ← 1
MENUOUTLINESIZE ← 2
MENUCOLUMNS ← 2
MENUFONT ← Font
TITLE ← (CONCAT (if (NC.ReadOnlyNoteFileP NoteFile)
then "RO: "
else "")
(FILENAMEFIELD FullFileName 'NAME)
";"
(FILENAMEFIELD FullFileName 'VERSION))
ITEMHEIGHT ← (IPLUS 6 (FONTPROP Font 'HEIGHT))
ITEMWIDTH ← (IPLUS (STRINGWIDTH 'NewCards Font)
10)
MENUTITLEFONT ← TitleFont
MENUOFFSET ← (CONS 0 0]
(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) (* ;
"further KLUDGE. Have to smash MENUGRID to prevent menu image from being shifted over.")
(replace (MENU MENUGRID) of NoteFileMenu with (LIST 2 2 (fetch (MENU ITEMWIDTH) of
NoteFileMenu
)
(fetch (MENU ITEMHEIGHT) of NoteFileMenu
)))
(AND (WFROMMENU NoteFileMenu)
(REDISPLAYW (WFROMMENU NoteFileMenu)))
(for Item in (fetch (MENU ITEMS) of NoteFileMenu)
do (SHADEITEM Item NoteFileMenu (if (NC.NoteFileOpenP NoteFile)
then WHITESHADE
else NCP.GrayShade)))
(* ;
"Shade NewCards if readonly notefile.")
(if (NC.ReadOnlyNoteFileP NoteFile)
then (for Item in (fetch (MENU ITEMS) of NoteFileMenu) when (EQ (CAR Item)
'NewCards)
do (SHADEITEM Item NoteFileMenu NCP.GrayShade)))
[if (WINDOWP (SETQ NoteFileMenuWindow (WFROMMENU NoteFileMenu)))
then (FLASHWINDOW NoteFileMenuWindow)
else (* ;
"Don't create a new NoteFile interface if we were asked not to.")
(OR Don'tCreateInterfaceFlg (SETQ NoteFileMenuWindow
(ADDMENU NoteFileMenu NIL
(if Position
elseif (GETMENUPROP NoteFileMenu 'OldPosition)
else (* ;
"Prompt the user to place the new notefile menu")
(NC.PrintMsg InterestedWindow T
"Please place the menu for notefile "
FullFileName)
[SETQ Position (GETBOXPOSITION
(fetch (REGION WIDTH)
of (MENUREGION
NoteFileMenu)
)
(fetch (REGION HEIGHT)
of (MENUREGION
NoteFileMenu]
(NC.ClearMsg InterestedWindow T)
Position]
(if (WINDOWP NoteFileMenuWindow)
then (WINDOWPROP NoteFileMenuWindow 'NoteFile NoteFile)
(WINDOWPROP NoteFileMenuWindow 'RESHAPEFN 'DON'T)
(WINDOWPROP NoteFileMenuWindow 'BUTTONEVENTFN (FUNCTION
NC.NoteFileIconButtonEventFn))
(WINDOWPROP NoteFileMenuWindow 'SHRINKFN 'DON'T)
(WINDOWPROP NoteFileMenuWindow 'SCROLLFN NIL)
(WINDOWPROP NoteFileMenuWindow 'NOSCROLLBARS T)
(* ;; "Make sure default menu WhenSelectedFn is not called")
(WINDOWPROP NoteFileMenuWindow 'CURSORINFN NIL)
(WINDOWPROP NoteFileMenuWindow 'CURSOROUTFN NIL)
(WINDOWPROP NoteFileMenuWindow 'CURSORMOVEDFN NIL)
(* ;; "")
[WINDOWADDPROP NoteFileMenuWindow 'CLOSEFN (FUNCTION (LAMBDA (Window)
(PUTMENUPROP
(CAR (WINDOWPROP
Window
'MENU))
'OldPosition
(WINDOWPOSITION Window]
(NC.MoveWindowOntoScreen NoteFileMenuWindow))
(replace (NoteFile Menu) of NoteFile with NoteFileMenu)
(PUTPROP FullFileName 'Menu NoteFileMenu)
NoteFileMenuWindow])
)
(* ;; "Changed in NCDATABASE")
(DEFINEQ
(NC.NoticedNoteFileNamesMenu
[LAMBDA (IncludeNewNoteFileFlg AllowedOperations InterestedWindow Operation)
(* ; "Edited 13-Sep-88 09:57 by pmi")
(* ;;; "Bring up a menu of all notefiles found in the notefiles hash array. Also allow user to open a new notefile.")
(* ;;; "kirk 23Jan86 Added AskYesOrNo and InterestedWindow parameter")
(* ;;; "fgh 6/8/86 Added check to make sure NoteFile is open if it has a menu on the screen. Needed to handle case of liongering NF menus.")
(* ;;; "fgh 6/24/86 Changed to be a general function rather than one specific for opening. Now just returns the chosen name. Also, added IncludeNewNoteFileFlg and ShowOnlyOpenNFsFlg. Removed InterestedWindow arg.")
(* ;;; "fgh 6/27/86 Added InterestedWindow & Operation args and call to NC.DatabaseFileName.")
(* ;;; "pmi 12/4/86: Added version numbers to rootnames on list of known files. Also cleaned up help string for menu items. It was giving a bogus message about opening the selected file, even though this function is used for many operations and not just for Open.")
(* ;;; "pmi 2/18/87: Added GLOBALVARS declaration for NC.MenuFont")
(* ;;; "pmi 5/15/87: Used to be NC.ListOfNoteFilesMenu. Changed symbol for open notefile to o. Now uses NCP.NoticedNoteFileNames instead of hash array to build menu. Returns a NoteFile name instead of a NoteFile object.")
(* ;;; "pmi 5/21/87: Replaced each NoteFile menu item with a bitmap of its name in a large font and its full filename in a small font.")
(* ;;; "pmi 8/20/87: Made modifications to speed up this menu: cache it when possible, only recompute the shading, etc.")
(* ;;; "pmi 12/8/87: Cleaned up some of the shading; converted AllowedOperations to be one of Open, CLOSED or NIL for both.")
(* ;;; "pmi 12/30/87: Changed the global var NC.NoticedNoteFileNames to NCP.NoticedNoteFileNames to make it available in the programmer's interface. Also wrapped U-CASE around all SELECTQ vars so that case doesn't matter.")
(* ;;; "pmi 9/13/88: Changed to use one of 4 bitmaps for each menu item, depending on whether the notefile is open or closed, and whether an open or closed operation is in progress. Also now only puts %"--Other Notefile--%" on the menu if it makes sense to specify one (IncludeNewNoteFileFlg is non-NIL). ")
(DECLARE (GLOBALVARS NC.FileNameFont NCP.NoticedNoteFileNames NC.NoticedNoteFilesMenu
NC.NoticedNoteFilesMenuNewItem WHITESHADE NCP.GrayShade))
(LET
(Result)
[SETQ Result
(PROG (Items)
(* ;;
"Shade either the open or closed files, depending on the type allowed by this operation.")
[SETQ Items
(SELECTQ (U-CASE AllowedOperations)
(OPEN `[,@(for NoteFileName in NCP.NoticedNoteFileNames bind NoteFile
collect (SELECTQ (U-CASE (GETPROP NoteFileName 'LastKnownStatus))
(OPEN (GETPROP NoteFileName 'OpenMenuItem))
(CLOSED (GETPROP NoteFileName 'ClosedMenuItemShaded))
NIL))
,@(if IncludeNewNoteFileFlg
then (if NC.NoticedNoteFilesMenuNewItem
then (LIST NC.NoticedNoteFilesMenuNewItem)
else (LIST (SETQ NC.NoticedNoteFilesMenuNewItem
'("-- Other NoteFile --" 'NEW
"Select some other notefile - you'll be prompted for the name."
])
(CLOSED `[,@(for NoteFileName in NCP.NoticedNoteFileNames bind NoteFile
collect (SELECTQ (U-CASE (GETPROP NoteFileName 'LastKnownStatus))
(OPEN (GETPROP NoteFileName 'OpenMenuItemShaded))
(CLOSED (GETPROP NoteFileName 'ClosedMenuItem))
NIL))
,@(if IncludeNewNoteFileFlg
then (if NC.NoticedNoteFilesMenuNewItem
then (LIST NC.NoticedNoteFilesMenuNewItem)
else (LIST (SETQ NC.NoticedNoteFilesMenuNewItem
'("-- Other NoteFile --" 'NEW
"Select some other notefile - you'll be prompted for the name."
])
`(,@(for NoteFileName in NCP.NoticedNoteFileNames bind NoteFile
collect (SELECTQ (U-CASE (GETPROP NoteFileName 'LastKnownStatus))
(OPEN (GETPROP NoteFileName 'OpenMenuItem))
(CLOSED (GETPROP NoteFileName 'ClosedMenuItem))
NIL))
,@(if IncludeNewNoteFileFlg
then (if NC.NoticedNoteFilesMenuNewItem
then (LIST NC.NoticedNoteFilesMenuNewItem)
else (LIST (SETQ NC.NoticedNoteFilesMenuNewItem
'("-- Other NoteFile --" 'NEW
"Select some other notefile - you'll be prompted for the name."
]
[if (NULL Items)
then (SELECTQ (U-CASE AllowedOperations)
(OPEN (NC.PrintMsg InterestedWindow NIL "No open NoteFiles." (CHARACTER
13)))
(CLOSED (NC.PrintMsg InterestedWindow NIL "No closed NoteFiles."
(CHARACTER 13)))
(NC.PrintMsg InterestedWindow NIL "No NoteFiles." (CHARACTER 13)))
(RETURN NIL)
elseif [AND (EQ (LENGTH Items)
1)
(EQUAL (CADAR Items)
''NEW]
then (RETURN 'NEW)
else (SETQ NC.NoticedNoteFilesMenu
(create MENU
ITEMS ← Items
TITLE ← "NoteFiles"
MENUFONT ← NC.FileNameFont
ITEMHEIGHT ← (IPLUS (BITMAPHEIGHT (CAAR Items))
1]
(replace (MENU IMAGE) of NC.NoticedNoteFilesMenu with NIL)
(RETURN (MENU NC.NoticedNoteFilesMenu]
(if (EQ Result 'NEW)
then (SETQ Result (NC.DatabaseFileName (CONCAT "Name of NoteFile to " (SUBSTRING Operation 1
-9)
(CHARACTER 13))
" -- " T T NIL InterestedWindow)))
Result])
)
(* ;; "Changed in NCUTILITIES")
(DEFINEQ
(NC.GreyCard
[LAMBDA (Card) (* ; "Edited 12-Sep-88 13:51 by pmi")
(* ;
"Grey over the interior of a card to mark it as obsolete.")
(* ;; "pmi 9/12/88: Now uses NCP.GrayShade in BITBLT instead of GRAYSHADE.")
(DECLARE (GLOBALVARS NCP.GrayShade))
(PROG ((Window (NC.FetchWindow Card)))
(AND (WINDOWP Window)
(BITBLT NIL NIL NIL Window NIL NIL NIL NIL 'TEXTURE 'PAINT NCP.GrayShade))
(RETURN T])
)
(* ;; "New for NCPROGINT")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NCP.GrayShade)
)
(RPAQ? NCP.GrayShade GRAYSHADE)
(DEFINEQ
(NCP.SetGrayShade
[LAMBDA (NewShade) (* ; "Edited 15-Sep-88 15:34 by pmi")
(* ;; "Sets NCP.GrayShade to NewShade. Also resets the menu of noticed notefiles, the notefile icon operations menu, and all notefile icon menus. If NewShade is not a texture, then just resets the menus. Returns the new value of NCP.GrayShade.")
(DECLARE (GLOBALVARS NCP.NoticedNoteFileNames NCP.GrayShade))
(if (TEXTUREP NewShade)
then (SETQ NCP.GrayShade NewShade))
(SETQ NC.NoticedNoteFilesMenu NIL)
(NC.MakeNoteFileIconOperationsMenus)
(for NoteFileName in NCP.NoticedNoteFileNames bind NoteFile
do (REMPROP NoteFileName 'OpenMenuItem)
(REMPROP NoteFileName 'OpenMenuItemShaded)
(REMPROP NoteFileName 'ClosedMenuItem)
(REMPROP NoteFileName 'ClosedMenuItemShaded)
(NC.CreateNoteFileMenuItems NoteFileName)
(if (SETQ NoteFile (NCP.NoteFileFromFileName NoteFileName))
then (NC.ResetNoteFileInterface NoteFile)))
NCP.GrayShade])
)
(* ;; "For the patch file only, to reset the current menus:")
(NCP.SetGrayShade)
(PUTPROPS PMIPATCH111 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3613 34866 (NC.CreateNoteFileMenuItems 3623 . 9974) (NC.MakeNoteFileIconOperationsMenus
9976 . 12671) (NC.NoteFileIconButtonEventFn 12673 . 19644) (NC.ResetNoteFileInterface 19646 . 23872)
(NC.SetUpNoteFileInterface 23874 . 34864)) (34906 42300 (NC.NoticedNoteFileNamesMenu 34916 . 42298)) (
42341 42973 (NC.GreyCard 42351 . 42971)) (43112 44245 (NCP.SetGrayShade 43122 . 44243)))))
STOP