(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Jan-88 15:47:47" {QV}<NOTECARDS>1.3LNEXT>RGPMIPATCH001.;1 11216
changes to%: (VARS RGPMIPATCH001COMS)
(FNS NC.SetUpNoteFileInterface))
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT RGPMIPATCH001COMS)
(RPAQQ RGPMIPATCH001COMS ((FNS NC.SetUpNoteFileInterface)
(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
RGPMIPATCH001)))
(DEFINEQ
(NC.SetUpNoteFileInterface
[LAMBDA (NoteFile Position InterestedWindow Don'tCreateInterfaceFlg)
(* ; "Edited 19-Jan-88 15:44 by Randy.Gobbel")
(* ;;; "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.")
(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 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 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]
(WINDOWPROP NoteFileMenuWindow 'NoteFile NoteFile)
(replace (NoteFile Menu) of NoteFile with NoteFileMenu)
(PUTPROP FullFileName 'Menu NoteFileMenu)
(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)
NoteFileMenuWindow])
)
(PUTPROPS RGPMIPATCH001 FILETYPE :TCOMPL)
(PUTPROPS RGPMIPATCH001 MAKEFILE-ENVIRONMENT (:PACKAGE "IL" :READTABLE "INTERLISP" :BASE 10))
(PUTPROPS RGPMIPATCH001 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (538 10985 (NC.SetUpNoteFileInterface 548 . 10983)))))
STOP