/****************************** Module Header ******************************* * * Module Name: menu.e * * Copyright (c) Netlabs EPM Distribution Project 2004 * * $Id$ * * =========================================================================== * * This file is part of the Netlabs EPM Distribution package and is free * software. You can redistribute it and/or modify it under the terms of the * GNU General Public License as published by the Free Software * Foundation, in version 2 as it comes in the "COPYING" file of the * Netlabs EPM Distribution. This library is distributed in the hope that it * will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty * of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * General Public License for more details. * ****************************************************************************/ ; Common procedures and commands for menus. ; Most defs moved from STDCTRL.E. /* ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» º MENU support. º º EPM's menu support is achieved through the use of the MENU manager. º º This menu manager is located in EUTIL.DLL in versions prior to 5.20; º º in E.DLL for EPM 5.20 and above. The menu manager contains powerful º º functions that allow an application to create there own named menus. º º Building Menus with the Menu Manager: º º The menu manager provides two fuctions which allow the creating º º or replacing of items in a named menu. º º Note: A menu is first built and then displayed in the window. º º BUILDSUBMENU - creates or modifies a sub menu º º BUILDMENUITEM - create or modifies a menu item under a sub menu º º º º Showing a named Menu º º SHOWMENU - show the specified named menu in the specified º º window frame. º º º º Deleting a name menu º º DELETEMENU - remove a named menu from the internal menory º º manager. º ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ */ ; --------------------------------------------------------------------------- defexit universal defaultmenu deletemenu defaultmenu defaultmenu = '' ; --------------------------------------------------------------------------- ; List of available menus. Can be extended with ; call AddAVar( 'menulist', 'mymenu') ; or ; 'AddAVar menulist mymenu' definit call SetAVar( 'menulist', 'newmenu stdmenu fevshmnu ovshmenu') ; --------------------------------------------------------------------------- ; Todo: Rename to SelectMenu? ; Syntax: ChangeMenu [[.e]] ; If no arg specified, a listbox for menu selection containing all items from ; MenuList is opened. defc ChangeMenu MenuList = ' 'strip( GetAVar( 'menulist')) -- ensure that list starts with a space as separator KeyPath = '\NEPMD\User\Menu\Name' CurMenu = QueryConfigKey( KeyPath) if CurMenu = '' then CurMenuFile = STD_MENU_NAME if CurMenuFile = '' then -- for STDMENU.E CurMenuFile = 'STDMENU.E' endif if rightstr( upcase( CurMenuFile), 2) = '.E' then CurMenu = substr( CurMenuFile, 1, length( CurMenuFile) - 2) else CurMenu = CurMenuFile endif endif NewMenu = arg(1) if NewMenu = '' then Selection = wordpos( upcase( CurMenu), upcase( MenuList)) Text = 'Current menu: 'CurMenu Title = 'Menu selection' refresh select = listbox( Title, MenuList, '/~Set/Cancel', -- buttons 0, 0, --5, 5, -- top, left, min( words( MenuList), 12), 25, -- height, width gethwnd( APP_HANDLE) || atoi( Selection) || atoi(1) || atoi(0) || Text\0 ) refresh -- check result button = asc(leftstr( select, 1)) EOS = pos( \0, select, 2) -- CHR(0) signifies End Of String select= substr( select, 2, EOS - 2) if button <> 1 then select = '' endif if select <> '' then 'ChangeMenu 'select -- execute this command again endif return endif p1 = pos( '\', NewMenu) p2 = pos( '.', NewMenu) if p2 > p1 + 1 then NewMenu = substr( NewMenu, p1 + 1, p2 - p1 - 1) endif 'unlink 'CurMenu'.ex' 'link 'NewMenu'.ex' 'RefreshMenu' WriteConfigKey( KeyPath, NewMenu) ; --------------------------------------------------------------------------- defc RefreshMenu universal defaultmenu deletemenu defaultmenu 'LoadDefaultMenu' call showmenu_activemenu() ; --------------------------------------------------------------------------- defc DeleteMenu parse arg MenuName SubMenuId MenuItemId fItemOnly deletemenu MenuName, SubMenuId, MenuItemId, fItemOnly ; --------------------------------------------------------------------------- ; Called by external packs, that add a menu before the help menu. ; Common way is to ; - delete the help menu with deletemenu HELP_MENU_ID, 0, 0 ; - add a menu with buildsubmenu and buildmenuitem (or define a proc ; and call it) ; - add the help menu and show the updated menu with readd_help_menu defproc readd_help_menu universal defaultmenu call add_help_menu( defaultmenu) call maybe_show_menu() return ; --------------------------------------------------------------------------- ; Add Help menu. defc AddHelpMenu universal defaultmenu if arg(1) = '' then CurMenu = defaultmenu else CurMenu = arg(1) endif call add_help_menu( CurMenu) ; --------------------------------------------------------------------------- defproc delete_help_menu universal defaultmenu deletemenu defaultmenu 6, 0, 0 return ; --------------------------------------------------------------------------- defc DeleteHelpMenu universal defaultmenu deletemenu defaultmenu, 6, 0, 0 ; --------------------------------------------------------------------------- ; Shows menu if activemenu = defaultmenu. defproc maybe_show_menu universal defaultmenu universal activemenu if activemenu = defaultmenu then call showmenu_activemenu() -- show the updated EPM menu endif return ; --------------------------------------------------------------------------- ; Show menu if activemenu = defaultmenu. defc MaybeShowMenu call maybe_show_menu() ; --------------------------------------------------------------------------- ; Called by defmain. defproc showmenu_activemenu() universal activemenu showmenu activemenu -- show the updated EPM menu -- TODO: Move cascade_menu call to menu definition, e.g. to -- LoadDefaultMenu. if isadefc('add_cascade_menus') then 'postme add_cascade_menus' -- Process hook: add user-defined cascade menus if isadefc('HookExecute') then 'postme HookExecute cascademenu' endif endif return ; --------------------------------------------------------------------------- defc ShowMenu universal activemenu universal defaultmenu activemenu = arg(1) -- TODO: if activemenu = defaultmenu then call showmenu_activemenu() -- This handles the posting of cascademenu cmds, if necessary. else showmenu activemenu -- Just show the updated EPM menu endif ; --------------------------------------------------------------------------- defc BuildSubmenu parse arg MenuName SubMenuId SubMenuText Attrib HelpPanel ECommand buildsubmenu MenuName, SubMenuId, SubMenuText, ECommand, Attrib, HelpPanel ; --------------------------------------------------------------------------- defc BuildMenuItem parse arg Menuname SubMenuId MenuItemId SubMenuText Attrib HelpPanel ECommand buildmenuitem MenuName, SubMenuId, MenuItemId, SubMenuText, ECommand, Attrib, HelpPanel ; --------------------------------------------------------------------------- /* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³What's it called : processcommand ³ ³ ³ ³What does it do : This command is not called by macros. It is called by ³ ³ the internal editor message handler. When a menu ³ ³ selected messaged is received by the internal message ³ ³ handler, (WM_COMMAND) this function is called with ³ ³ the menu id as a parameter. ³ ³ ³ ³ ³ ³Who and When : Jerry C. 3/4/89 ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ */ ; Internally called on execution of a menu item or an accelerator key. ; The menu id or accel id is submitted as arg. querymenustring and ; queryaccelstring are used to query the saved string for it. defc ProcessCommand universal activeaccel universal activemenu MenuId = arg(1) --dprintf( 'ProcessCommand: MenuId = 'MenuId) if MenuId = '' then sayerror PROCESS_ERROR__MSG return endif -- First test if command was generated by the -- next/prev buttons on the editor frame. if MenuId = 44 then nextfile elseif MenuId = 45 then prevfile -- 8101 is free. 'ConfigDlg SYS' is hardcoded as 71154. --elseif MenuId = 8101 then -- Temporarily hardcode this -- 'configdlg SYS' else AccelStr = queryaccelstring( activeaccel, MenuId) if AccelStr <> '' then call ExecAccelKey( AccelStr) else -- Get the menu name from the saved array var at definition time MenuName = GetAVar( 'midmenu_'MenuId) --dprintf( 'MenuName = 'MenuName', MenuId = 'MenuId) if MenuName <> '' then -- nop -- Old way, left in for compatibility: requires correct switching of activemenu elseif activemenu <> '' then MenuName = activemenu else return endif -- MenuStr contains Command, previously \1 HintText was appended MenuStr = querymenustring( MenuName, MenuId) call ExecMenuItem( MenuStr) endif endif ; --------------------------------------------------------------------------- ; Called by ProcessCommand defproc ExecMenuItem parse value( arg(1)) with Cmd \1 HelpStr Cmd = strip( Cmd, 'T', \0) call SaveKeyCmd( \1''Cmd) Cmd --dprintf( 'ExecMenuItem: Cmd = 'Cmd) return ; --------------------------------------------------------------------------- compile if 0 -- Not used defc ProcessAccel universal activeaccel MenuId = arg(1) if MenuId = '' then sayerror PROCESS_ERROR__MSG return endif queryaccelstring( activeaccel, MenuId) compile endif ; --------------------------------------------------------------------------- ; This is executed on activating action bar menu items, popup menu items ; and action bar submenu items. (Popup submenu items are invisible.) ; Toolbar items don't call ProcessMenuSelect. ; This is used for prompting (showing a help text in the message line). defc ProcessMenuSelect universal menu_prompt universal defaultmenu universal activemenu parse arg MenuType MenuId . --dprintf( 'ProcessMenuSelect: MenuType = 'MenuType', MenuId = 'MenuId', args = 'arg(1)) -- EPM 6: menutype is always 'A'. -- MenuId = '' at closing a submenu -- MenuId = 65535 at closing a menu = 'Halt command' menu item = ProcessBreak command -- This is executed on activating action bar menu items, popup menu items -- and action bar submenu items. (Popup submenu items are invisible.) HintText = '' if MenuId = '' then -- nop elseif MenuId = 65535 then -- nop else -- This was used for older menu defs. Left in for compatibility. compile if 1 -- For action bar submenu items, switch activemenu back. -- This doesn't support previouslyactivemenu anymore. if pos( MenuId, GetAVar( 'mids')) then -- search in list of all sebmenu ids activemenu = defaultmenu elseif MenuId < 80 then -- hack activemenu = defaultmenu endif compile endif -- Query hint text from array var HintText = GetAVar( 'midhint_'MenuId) -- This was used for older menu defs. Left in for compatibility. compile if 1 if HintText = '' then -- Get the menu name from the saved array var at definition time MenuName = GetAVar( 'midmenu_'MenuId) if MenuName = '' then MenuName = activemenu endif -- Query menu string and parse it into Cmd and HintText parse value querymenustring( MenuName, MenuId) with Cmd \1 HintText endif compile endif endif if menu_prompt then if HintText = '' then -- Delete the previous msg sayerror 0 else -- Disable writing msg to the messagebox 'SayHint' HintText endif endif ; --------------------------------------------------------------------------- ; Called when a pulldown or pullright in an action bar menu or popup menu is ; initialized. Not called for toolbar menus. ; Note: this routine is *not* executed when Command (MenuId 1) is ; selected. Therefore we use MenuId = 0 instead. defc ProcessMenuInit MenuId = arg(1) --dprintf( 'ProcessMenuInit: MenuId = 'MenuId) -- Add possible exensions for defc 'menuinit_'name first compile if not VANILLA compile if defined(SITE_MENUINIT) compile if SITE_MENUINIT include SITE_MENUINIT compile endif compile endif tryinclude 'mymnuini.e' -- For user-supplied additions to this routine. -- Process hook: add user-defined menuinits -- Not really required. The user can add his hooks to a list and it will -- then be called automatically: -- call AddAVar( 'definedsubmenus', ). -- This will execute: 'menuinit_', if defined. if isadefc('HookExecute') then 'HookExecute menuinit' endif compile endif -- Try to find a defc 'menuinit_'name IdName = GetAVar( 'midname_'MenuId) if IdName <> '' then if isadefc('menuinit_'IdName) then 'menuinit_'IdName --'postme menuinit_'IdName return endif endif -- Try to find a defc 'menuinit_'MenuId if isadefc('menuinit_'MenuId) then 'menuinit_'MenuId --'postme menuinit_'MenuId return endif ; --------------------------------------------------------------------------- defproc GetMenuHWnd( MenuId) universal defaultmenu MenuName = GetAvar( 'midmenu_'MenuId) /* if MenuName = defaultmenu then hwnd_menu = getpminfo( EPMINFO_EDITMENUHWND) -- 0 elseif leftstr( MenuName, 5) = 'popup' then frameid_menu = 50 -- 50 is always used for a popup menu hwnd_menu = dynalink32( 'PMWIN', '#899', -- ordinal for Win32WindowFromID gethwndc( EPMINFO_EDITCLIENT) || atol( frameid_menu)) else hwnd_menu = getpminfo( EPMINFO_EDITMENUHWND) -- 0 endif */ -- Better assume action bar menu only for defaultmenu and popup menu -- for all others to not depend on the name starting with 'popup'. if MenuName = defaultmenu then -- action bar menu hwnd_menu = getpminfo( EPMINFO_EDITMENUHWND) -- 0 else -- popup menu frameid_menu = 50 -- 50 is always used for a popup menu hwnd_menu = dynalink32( 'PMWIN', '#899', -- ordinal for Win32WindowFromID gethwndc( EPMINFO_EDITCLIENT) || atol( frameid_menu)) endif -- Toolbar menus are not handled here. return hwnd_menu ; --------------------------------------------------------------------------- ; Change the menu item attribute ; attr = MIA_CHECKED: on = 1 means 'unchecked'! ; attr = MIA_DISABLED: on = 1 means 'disabled' defproc SetMenuAttribute( MenuId, Attr, on) -- Check for a non-empty MenuId first, because SetMenuAttribute is called -- by some toggle commands before the menu is built and the MenuIds were -- set. if MenuId = '' then sayerror 'Warning: defproc SetMenuAttribute: MenuId = 'MenuId', Attr = 'Attr', on = 'on return endif if not IsNum( MenuId) then IdName = lowcase( MenuId) -- Strip leading 'mid_' from mid name if leftstr( IdName, 4) = 'mid_' then IdName = substr( IdName, 5) endif MenuId = GetAVar( 'mid_'IdName) endif hwnd_menu = GetMenuHWnd( MenuId) if not on then Attr = mpfrom2short(Attr, Attr) endif call windowmessage( 1, hwnd_menu, 402, MenuId + 65536, Attr) return ; --------------------------------------------------------------------------- ; on = 1 means 'checked' defproc SetMenuChecked( MenuId, on) call SetMenuAttribute( MenuId, MIA_CHECKED, not on) ; --------------------------------------------------------------------------- ; on = 1 means 'enabled' defproc SetMenuEnabled( MenuId, on) call SetMenuAttribute( MenuId, MIA_DISABLED, not on) ; --------------------------------------------------------------------------- ; Change the menu item text defproc SetMenuText( MenuId, menutext) if MenuId = '' then return endif if not IsNum( MenuId) then IdName = lowcase( MenuId) -- Strip leading 'mid_' from mid name if leftstr( IdName, 4) = 'mid_' then IdName = substr( IdName, 5) endif MenuId = GetAVar( 'mid_'IdName) endif hwnd_menu = GetMenuHWnd( MenuId) menutext = menutext\0 call windowmessage( 1, hwnd_menu, 398, -- x18e, MM_SetItemText MenuId + 65536, ltoa(offset(menutext) || selector(menutext), 10) ) return ; --------------------------------------------------------------------------- ; Change a menu items text with a variable part (a part in brackets). ; The menu id and the menu text must have been stored in the array vars ; 'mid_'MenuIdName and 'mtext_'MenuIdName. defproc SetMenuVarText( MenuId, VarTextPart) -- Optional appending text part AppendTextPart = arg(3) if IsNum( MenuId) then IdName = GetAVar( 'midname_'MenuId) else IdName = lowcase( MenuId) -- Strip leading 'mid_' from mid name if leftstr( IdName, 4) = 'mid_' then IdName = substr( IdName, 5) endif MenuId = GetAVar( 'mid_'IdName) endif MenuText = GetAVar('mtxt_'IdName) parse value MenuText with next'['x']'rest MenuText = next'['VarTextPart']'rest if AppendTextPart <> '' then MenuText = MenuText AppendTextPart endif SetMenuText( MenuId, MenuText) ; --------------------------------------------------------------------------- ; Example for a conditional menu item text: ; |FileIsMarked|0:~Sort all lines|1:~Sort marked lines defproc ResolveConditionalText( var Text) rest = Text ConditionalText = '?' Condition = '' i = 0 do forever if leftstr( rest, 1) <> '|' then leave endif parse value rest with '|'next'|'rest i = i + 1 if rest <> '' then rest = '|'rest endif if i = 1 then next = lowcase( next) if not IsADefProc( next) then Text = 'Proc not defined: 'Text leave elseif next = 'fileismarked' then condrc = FileIsMarked() else leave endif else parse value next with n':'Textn if not isnum( n) then leave endif if condrc = n then Text = Textn else iterate endif endif enddo if ConditionalText <> '?' then Text = ConditionalText endif return ; --------------------------------------------------------------------------- ; This resolves conditions, specified instead of menu item texts, as menu ; item texts. The condition is processed at runtime. As arg, a MenuId or a ; Menu item name can be specified. See defproc ResolveConditionalText for ; valid condition procs. defproc ConditionalMenuText( MenuId) if MenuId = '' then return endif if IsNum( MenuId) then IdName = GetAVar( 'midname_'MenuId) else IdName = lowcase( MenuId) -- Strip leading 'mid_' from mid name if leftstr( IdName, 4) = 'mid_' then IdName = substr( IdName, 5) endif MenuId = GetAVar( 'mid_'IdName) endif -- Query Text from array var for IdName Text = GetAVar( 'mtxt_'IdName) do once = 1 to 1 -- Parse Text into TextString and AccelString parse value Text with TextString \9 AccelString -- Resolve conditional text CondText = TextString ResolveConditionalText( CondText) -- Keep Text if there's nothing to resolve if CondText = TextString then leave endif Text = CondText -- Append previously parsed AccelString to conditional text if AccelString <> '' then Text = CondText''\9''AccelString endif enddo -- Set menu text to Text SetMenuText( MenuId, Text) return ; --------------------------------------------------------------------------- ; Set the conditional cascade style ; Syntax: cascade_menu SubMenuId [defaultmenuitemid] ; Menu id names instead of menu ids can be specified optionally . defc cascade_menu parse arg MenuId DefMenuId . if MenuId = '' then return endif if not IsNum( MenuId) then IdName = MenuId MenuId = GetAVar( 'mid_'IdName) endif if not IsNum( DefMenuId) then IdName = DefMenuId DefMenuId = GetAVar( 'mid_'IdName) endif hwnd_menu = GetMenuHWnd( MenuId) menuitem = copies( \0, 16) -- 2 bytes ea. pos'n, style, attribute, identity; 4 bytes submenu hwnd, long item if not windowmessage( 1, hwnd_menu, 386, -- x182, MM_QueryItem MenuId + 65536, ltoa( offset(menuitem) || selector(menuitem), 10)) then return endif hwnd = substr( menuitem, 9, 4) call dynalink32( 'PMWIN', '#874', -- Win32SetWindowBits hwnd || atol(-2) || -- QWL_STYLE atol(64) || -- MS_CONDITIONALCASCADE atol(64)) -- MS_CONDITIONALCASCADE if DefMenuId <> '' then -- Default menu item call windowmessage( 1, ltoa( hwnd, 10), 1074, -- x432, MM_SETDEFAULTITEMID DefMenuId, 0) -- Make arg(2) the default menu item endif ; --------------------------------------------------------------------------- ; Return a unique menuid for main menu items. ; Menuids from 51 to 79 are normally unused (mid = 50 is used by ; ETK_FID_POPUP in MOUSE.E). ; If this proc would be used to get a menuid by all extension packages that ; add menus, it could be garanteed that the returned mid is unique. ; 71154 is used as 'ConfigDlg SYS', 8101 is free, ; 45 as PrevFile, 44 as NextFile, ; (65535 = 2^16 - 1) / (131071 = 2^32 - 1) as ProcessBreak, ; 65535 also as close menu, ; 10001 and up is used for accel keys, ; above 2^16 as temporary WM_COMMAND ids, defproc GetUniqueMid List = GetAVar('mids') mid = '' do i = 51 to 79 if pos( i, List) = 0 then mid = i List = strip(List' 'i) call SetAVar( 'mids', List) leave endif enddo --dprintf( 'GetUniqueMid: Next unique mid = 'mid) return mid ; --------------------------------------------------------------------------- ; Send EPM icon window a help message. ; 10 = Help index ; 4000 = General help ; 0 = Using help ; 1000 = Keys help ; 2000 = Commands help ; * = TOC ; or: help panel #, 9100,... (see MENUHELP.H) ; ; Note: ; buildsubmenu and buildmenuitem allow for its last arg (MIA) to specify ; not only the MIA, but also the help panel #. defc HelpMenu call windowmessage( 0, getpminfo(APP_HANDLE), 5133, -- EPM_HelpMgrPanel arg(1), -- mp1 0) -- mp2 = NULL ; --------------------------------------------------------------------------- defc ResetMids mids = GetAVar( 'mids') do w = 1 to words( mids) mid = word( mids, w) IdName = GetAVar( 'midname_'mid) if IdName <> '' then call DropAVar( 'mid_'IdName) call DropAVar( 'midname_'mid) endif enddo call DropAVar( 'mids') ; --------------------------------------------------------------------------- ; Syntax: DefSubMenu( IdName, Text [, Hint [, HelpId]]) defproc DefSubMenu( IdName, Text) universal activemenu universal LastSubMenuId universal LastMenuItemId IdName = lowcase( IdName) mid = '' if IdName <> '' then mid = GetAVar('mid_'IdName) call AddAVar( 'mids', mid) endif if mid = '' then mid = GetUniqueMid() endif LastSubMenuId = mid --dprintf( 'DefSubMenu( 'IdName', 'Text', ...), mid = 'mid) -- Save IdName and mid to array vars to make menu inits work if IdName <> '' then call SetAVar( 'mid_'IdName, mid) call SetAVar( 'midname_'mid, IdName) endif -- Save current activemenu to assign menu item to it at definition time call SetAVar( 'midmenu_'mid, activemenu) --dprintf( 'Text = 'Text', activemenu = 'activemenu', Menu name = 'GetAvar( 'midmenu_'mid)', GetMenuHWnd( mid) = 'GetMenuHWnd( mid)) -- EPM bug: -- ProcessMenuInit is not executed for SubMenuId = 1, which was traditionally -- the id for the Command submenu. Therefore SubMenuId = 0 can be used, which -- is not used by other submenus. -- To keep ids unique, MenuItemIds 001 ... 099 can't be used. They must be -- changed to 101 ... 199. if LastSubMenuId = 0 then LastMenuItemId = 100 else LastMenuItemId = mid'00' endif -- Automatically add specified text char to the list of used menu accelerators TildePos = pos( '~', Text) if TildePos < length( Text) then AccelLetter = substr( Text, TildePos + 1, 1) -- AddAVar creates a space-delimitted list call AddAVar( 'usedmenuaccelerators', AccelLetter) endif -- Sub menus don't execute a cmd Cmd = '' Hint = arg(3) if Hint = '' then -- nop else -- Strip the leading \1 char, used for older defs if leftstr( Hint, 1) = \1 then Hint = substr( Hint, 2) endif -- Save the hint text in an array var. -- It is queried by ProcessMenuSelect to show it in the message line. call SetAVar( 'midhint_'mid, Hint) endif Style = 0 Attr = 0 HelpId = arg(4) -- Todo: get HelpId for IdName if HelpId <> '' then if IsNum( HelpId) then Attr = mpfrom2short( HelpId, Attr) endif endif buildsubmenu activemenu, LastSubMenuId, Text, Cmd, Style, Attr ; --------------------------------------------------------------------------- ; This must be added before the DefMenuItem for the first submenu item. ; It adds MIS_SUBMENU to the next item. defproc DefNextItemStartsSubMenu() universal NextMenuItemStartsSub NextMenuItemStartsSub = 1 ; --------------------------------------------------------------------------- ; Differently from the syntax in .rc files, this must be added before the ; DefMenuItem for the last submenu item. It ends the current submenu level ; after the next item. defproc DefNextItemEndsSubMenu() universal NextMenuItemStartsSub NextMenuItemStartsSub = -1 ; --------------------------------------------------------------------------- ; Syntax: DefMenuItem( IdName, Text, Cmd [, Hint [, HelpId [, Options]]]) ; A unique IdName is only required for ; - submenu items when a menu_init is defined, ; - items whose menu attribute (disabled, checked, cascaded) should be ; changed, ; - items whose text should be changed. ; Otherwise specify an empty arg: '' defproc DefMenuItem( IdName, Text, Cmd) universal activemenu universal LastSubMenuId universal LastMenuItemId universal NextMenuItemStartsSub universal NoDismiss -- Instead of a name an menu item id can be specified -- This is used by the 'Halt command' menu item, which uses -- a hard-coded menu item id. if IsNum( IdName) then CurMenuItemId = IdName else -- Handle overflow if rightstr( LastMenuItemId, 2) = '99' then --SavedMid = LastMenuItemId mid = GetUniqueMid() LastMenuItemId = mid'00' --dprintf( 'Overflow caught. LastMenuItemId = 'SavedMid', new MenuItemId = 'LastMenuItemId + 1', Text = 'Text', Cmd = 'Cmd) endif LastMenuItemId = LastMenuItemId + 1 CurMenuItemId = LastMenuItemId endif -- Append accelerator key definition to text, separated by a tab char. -- Do this only if it's not already specified in the Text part. if pos( \9, Text) = 0 then next = MenuAccelString( Cmd) -- also adds the tab char, if key definition exists if next <> '' then Text = Text''next endif endif IdName = lowcase( IdName) if IdName <> '' then call SetAvar( 'mid_'IdName, CurMenuItemId) -- Text vars and conditional texts are resolved by menu inits. -- Therefore the Text string is saved as array var. if verify( Text, '[|#', 'M') then call SetAvar( 'mtxt_'IdName, Text) endif if NextMenuItemStartsSub = 1 then -- Required for menu inits call SetAvar( 'midname_'CurMenuItemId, IdName) endif endif -- Save current menu name to assign menu item to it at definition time call SetAVar( 'midmenu_'CurMenuItemId, activemenu) Hint = arg(4) if Hint = '' then -- nop else -- Strip the leading \1 char, used for older defs if leftstr( Hint, 1) = \1 then Hint = substr( Hint, 2) endif call SetAVar( 'midhint_'CurMenuItemId, Hint) endif -- Parse options word list Options = upcase( arg(6)) Attr = 0 Style = MIS_TEXT -- Menu item attributes if wordpos( 'NODISMISS', Options) | wordpos( MIA_NODISMISS, Options) then -- menu remains open after execution, use Esc for closing Attr = Attr + NoDismiss -- MIA_NODISMISS is configured globally endif if wordpos( 'FRAMED', Options) then Attr = Attr + MIA_FRAMED endif if wordpos( 'CHECKED', Options) then Attr = Attr + MIA_CHECKED endif if wordpos( 'DISABLED', Options) then Attr = Attr + MIA_DISABLED endif if wordpos( 'HILITED', Options) then Attr = Attr + MIA_HILITED endif -- Some menu item styles - the rest doesn't work if wordpos( 'STATIC', Options) then -- menu item is not selectable Style = Style + MIS_STATIC endif if wordpos( 'SYSCOMMAND', Options) then -- turn WM_COMMAND message into a WM_SYSCOMMAND message Style = Style + MIS_SYSCOMMAND endif if wordpos( 'HELP', Options) then -- turn WM_COMMAND message into a WM_HELP message Style = Style + MIS_HELP endif if wordpos( 'BREAK', Options) then -- menu item is placed in new column Style = Style + MIS_BREAK endif if wordpos( 'BREAKSEPARATOR', Options) then -- menu item is placed in new column with vertical separator Style = Style + MIS_BREAKSEPARATOR endif if wordpos( 'OWNERDRAW', Options) then Style = Style + MIS_OWNERDRAW endif if NextMenuItemStartsSub = 1 then Style = Style + MIS_SUBMENU elseif NextMenuItemStartsSub = -1 then Style = Style + MIS_ENDSUBMENU -- not a PM MIS, but id is used by buildmenuitem endif NextMenuItemStartsSub = 0 HelpId = arg(5) -- Todo: get HelpId for IdName if HelpId <> '' then if IsNum( HelpId) then Attr = mpfrom2short( HelpId, Attr) endif endif buildmenuitem activemenu, LastSubMenuId, CurMenuItemId, Text, Cmd, Style, Attr ; --------------------------------------------------------------------------- defproc DefMenuSep universal activemenu universal LastSubMenuId universal LastMenuItemId universal NextMenuItemStartsSub -- Handle overflow if rightstr( LastMenuItemId, 2) = '99' then --SavedMid = LastMenuItemId mid = GetUniqueMid() LastMenuItemId = mid'00' --dprintf( 'Overflow caught. LastMenuItemId = 'SavedMid', new MenuItemId = 'LastMenuItemId + 1', Text = 'Text', Cmd = 'Cmd) endif LastMenuItemId = LastMenuItemId + 1 Text = \0 Cmd = '' Style = MIS_SEPARATOR Attr = 0 -- Not remommended to use a separator as first or last item, but make that -- valid if someone uses that. if NextMenuItemStartsSub = 1 then Style = Style + MIS_SUBMENU elseif NextMenuItemStartsSub = -1 then Style = Style + MIS_ENDSUBMENU endif NextMenuItemStartsSub = 0 buildmenuitem activemenu, LastSubMenuId, LastMenuItemId, Text, Cmd, Style, Attr