(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP") (FILECREATED "29-Aug-88 12:29:14" {QV}<NOTECARDS>1.3LNEXT>PMIPATCH107.;1 12188 changes to%: (FNS NC.SetUpNoteFileInterface) (VARS PMIPATCH107COMS)) (* " Copyright (c) 1988 by Xerox Corporation. All rights reserved. ") (PRETTYCOMPRINT PMIPATCH107COMS) (RPAQQ PMIPATCH107COMS ( (* ;;; "New file") (DECLARE%: DONTCOPY (PROPS (PMIPATCH107 MAKEFILE-ENVIRONMENT) (PMIPATCH107 FILETYPE))) (* ;; "pmi 8/29/88: No longer tries to set windowprops on NIL window, which were ending up on the Mouse TTY window.") (* ;; "Changed in NCINTERFACE") (FNS NC.SetUpNoteFileInterface))) (* ;;; "New file") (DECLARE%: DONTCOPY (PUTPROPS PMIPATCH107 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP")) (PUTPROPS PMIPATCH107 FILETYPE :BCOMPL) ) (* ;; "pmi 8/29/88: No longer tries to set windowprops on NIL window, which were ending up on the Mouse TTY window." ) (* ;; "Changed in NCINTERFACE") (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.") (* ;; "pmi 8/29/88: No longer tries to set windowprops on NIL window, which were ending up on the Mouse TTY window.") (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] (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]) ) (PUTPROPS PMIPATCH107 COPYRIGHT ("Xerox Corporation" 1988)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1253 12105 (NC.SetUpNoteFileInterface 1263 . 12103))))) STOP