/****************************** Module Header ******************************* * * Module Name: keys.e * * Copyright (c) Netlabs EPM Distribution Project 2002 * * $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. * ****************************************************************************/ compile if not defined( SMALL) -- If compiled separately EA_comment 'This defines definitions for keysets.' define INCLUDING_FILE = 'KEYS.E' include 'stdconst.e' const tryinclude 'mycnf.e' const compile if not defined( NLS_LANGUAGE) NLS_LANGUAGE = 'ENGLISH' compile endif include NLS_LANGUAGE'.e' ; In case someone executes 'keys' by mistake, the module would be unlinked. ; Therefore add a (nop) defc that would be executed then in preference: defc keys -- nop compile endif ; --------------------------------------------------------------------------- definit universal blockreflowflag blockreflowflag = 0 compile if defined(ACTIONS_ACCEL__L) -- For CUSTEPM support call AddMenuAVar( 'usedmenuaccelerators', 'A') compile endif compile if defined(TEX_BAR__MSG) -- For TFE or EPMTeX support call AddMenuAVar( 'usedmenuaccelerators', 'T') compile endif compile if defined(ECO_MENU__MSG) -- For ECO support call AddMenuAVar( 'usedmenuaccelerators', 'I') compile endif -- These keys must be defined as WM_CHAR keys, not as accelerator keys. -- Otherwise typing single accent keys like ^ï` and entering a char via -- its key code with Alt and the keypad numbers won't work. -- This array var value must be specified in lowercase and with the -- underscore as prefix separator: c_, a_ or s_ (not + or -) NonAccelKeys = '' NonAccelKeys = NonAccelKeys' a_1 a_2 a_3 a_4 a_5 a_6 a_7 a_8 a_9 a_0' NonAccelKeys = NonAccelKeys' space' NonAccelKeys = NonAccelKeys' down up left right' NonAccelKeys = NonAccelKeys' a_down a_up a_left a_right' NonAccelKeys = NonAccelKeys' a_ins a_del a_home a_end a_pgdn a_pgup' call AddKeysAVar( 'nonaccelkeys', NonAccelKeys) ; --------------------------------------------------------------------------- ; Apparently edit_keys must be defined in EPM.EX as first ETK keyset. ; Therefore "defkeys edit_keys new clear" was moved to INIT.E to be ; included early. ; ; The standard ETK keyset "edit_keys" is mainly a dummy keyset, compared to ; the original EPM keyset definition. It defines all keys as otherkeys, ; except a_0 ... a_9, which are not executable as accel keys without unwanted ; results. ; ; Otherkeys processes all keys for which no accel key def exists. That are ; mainly single char keys. Process_Key works like Keyin, but handles ; overwriting of the marked area in CUA marking mode. ; ; Bug in EPM's ETK keyset handling: ; .keyset = '' works only, if was defined in ; the same .EX file, from where the keyset should be changed. ; Therefore (as a workaround) switch temporarily to the externally ; defined keyset in order to make it known for 'SetKeys': ; ; definit -- required for a separately compiled package ; saved_keys = .keyset ; .keyset = '' ; .keyset = saved_keys ; ; Note: An .EX file, that defines a keyset, can't be unlinked, when this ; keyset is in use. ; --------------------------------------------------------------------------- /*** ; The following is defined in INIT.E and is processed during definit of ; EPM.E. ; This defines the standard keyset. It's important to use the option 'clear'. ; Otherwise otherkeys won't process the standard letters, numbers and chars. ; ; The keyset 'edit_keys' must be defined before all other keysets. ; Therefore this file is actually included early in EPM.E. It's possible to ; link these defs, but then other key defs must be linked after defining ; 'edit_keys'. ; (To do: test if defs from 'edit_keys' are overtaken by other keysets then.) defkeys edit_keys new clear ; For testing: ;def '„' ; dprintf( 'lastkey() = 'lastkey()', ch = 'ch) ; call SaveKeyCmd( lastkey()) ; call Process_Keys( 'ae') ; Alt+0 ... Alt+9 keys (WM_CHAR): ; These standard key defs are not executed as accel keys in order to keep ; entering a char via Alt+keypad key working. ; Because accel keys don't create a WM_CHAR message, they can't be handled ; by lastkey or getkeystate. ; To assign code to these keys, they have to be additionally defined via the ; DefKey proc (which is used for defining accel keys). DefKey handles them ; specially: It sets just an array var, that is queried and executed by ; ExecKeyCmd. def a_1 'ExecKeyCmd a_1' def a_2 'ExecKeyCmd a_2' def a_3 'ExecKeyCmd a_3' def a_4 'ExecKeyCmd a_4' def a_5 'ExecKeyCmd a_5' def a_6 'ExecKeyCmd a_6' def a_7 'ExecKeyCmd a_7' def a_8 'ExecKeyCmd a_8' def a_9 'ExecKeyCmd a_9' def a_0 'ExecKeyCmd a_0' ; Space key (WM_CHAR): ; In order to type the single accent key '^' which is created by ; +, space must not be defined as accel key. Therefore ; Space is defined with ExecKeyCmd. That means that it executes the ; command that is stored by DefKey( Space, cmd) as an array var. def space 'ExecKeyCmd space' ; Cursor keys (WM_CHAR): ; When processed as accel keys, cursor key messages send by another app ; are ignored. This happens if AMouse is configured to send keyboard ; messages instead of scroll window messages. def down 'ExecKeyCmd down' def up 'ExecKeyCmd up' def left 'ExecKeyCmd left' def right 'ExecKeyCmd right' ; Processing the keys above in the 'otherkeys' command would work, but ; their scancode may vary with different keyboard layouts. The E toolkit ; key names (used after 'def') handle that. ; Add more keys here that have to be processed as standard E toolkit keys ; or can't be processed as accelerator keys. The cursor keys above are ; defined as both. When being processed, the accel def wins. To ignore ; the accel def, a key must be added to the 'noaccelkeys' array var above. ; OtherKeys processes all other single keys plus those virtual keys that ; are also defined as number keys on the keypad block (WM_CHAR): def otherkeys 'OtherKeys' -- Defined in KEYS.E ***/ ; --------------------------------------------------------------------------- defproc CtrlIsDown ks = getkeystate( VK_CTRL) fDown = (ks = 1 | ks = 2) return fDown ; --------------------------------------------------------------------------- defproc AltIsDown ks = getkeystate( VK_ALT) fDown = (ks = 1 | ks = 2) return fDown ; --------------------------------------------------------------------------- defproc ShiftIsDown ks = getkeystate( VK_SHIFT) fDown = (ks = 1 | ks = 2) return fDown ; --------------------------------------------------------------------------- ; This is used to separate standard char keys from modifier keys ; (Ctrl/Alt/Sh) and virtual keys. defproc IsSingleKey k = arg( 1) fSingle = 0 -- This can't work on DBCS systems: if length( k) = 1 then fSingle = 1 -- This should work on DBCS systems: elseif IsDbcs( k) then fSingle = 1 endif return fSingle ; --------------------------------------------------------------------------- ; OtherKeys processes all other single keys plus those Alt+virtual keys that ; are also defined as number keys on the keypad block (WM_CHAR). defc OtherKeys k = lastkey() parse value lastkey( 2) with Flags 3 Repeat 4 ScanCode 5 CharCode 7 VkCode 9 ScanCode = Hex2Dec( c2x( ScanCode)) VkCode = itoa( VkCode, 10) fExpanded = 0 if IsSingleKey( k) then call SaveKeyCmd( k) fExpanded = ExpandKey() if fExpanded = 0 then call Process_Key( k) endif elseif AltIsDown() then -- Filter out keypad keys in order to keep entering a char via -- Alt+keypad key working. -- Usually keypad keys have a decimal scancode < 95. The scancode is -- hardware-specific. The following line has to be changed for other -- unusual keyboards. -- The scancode (in hex) can be shown both in a PMPrintf window and -- on EPM's mesageline by the TestKeys command. if ScanCode >= 95 then if VkCode = VK_UP then 'ExecKeyCmd a_up' elseif VkCode = VK_DOWN then 'ExecKeyCmd a_down' elseif VkCode = VK_LEFT then 'ExecKeyCmd a_left' elseif VkCode = VK_RIGHT then 'ExecKeyCmd a_right' elseif VkCode = VK_INSERT then 'ExecKeyCmd a_ins' elseif VkCode = VK_DELETE then 'ExecKeyCmd a_del' elseif VkCode = VK_HOME then 'ExecKeyCmd a_home' elseif VkCode = VK_END then 'ExecKeyCmd a_end' elseif VkCode = VK_PAGEDOWN then 'ExecKeyCmd a_pgdn' elseif VkCode = VK_PAGEUP then 'ExecKeyCmd a_pgup' endif endif endif ; --------------------------------------------------------------------------- ; Standard key defs don't work for keypad keys, only for normal keys. ; Therefore keypad keys don't have to be filtered out here. ; Keypad keys can be redefined via accel keys, but then entering chars by ; entering its keycode via Alt+keypad keys won't work anymore. defc ExecKeyCmd -- The array var is internally set by the DefKey proc if Alt+num keys -- were defined via DefKey. KeyString = arg( 1) Cmd = GetKeysAVar( 'keydef.'KeyString) call SaveKeyCmd( KeyString''\1''Cmd) fExpanded = ExpandKey() --dprintf( 'ExecKeyCmd: KeyString = 'KeyString', fExpanded = 'fExpanded) if fExpanded = 0 then if Cmd <> '' then Cmd else k = lastkey() call Process_Key( k) endif endif ; --------------------------------------------------------------------------- ; This ignores modifier key combinations. Therefore it can be used for single ; chars only. defproc Process_Key( char) if IsSingleKey( char) & char <> \0 then call Process_Keys( char) endif ; --------------------------------------------------------------------------- ; This types one or multiple chars. It handles replacing a marked area while ; CUA marking is active. defproc Process_Keys( chars) universal lastcommand fInsert = insertstate() fMarked = 0 fInsertToggled = 0 fMarkDeleted = (ReplaceMark() = 1) if not fInsert & fMarkDeleted then -- Turn on insert mode because the key should replace -- the mark, not the character after the mark. inserttoggle fInsertToggled = 1 endif lastcommand = chars keyin chars if fInsertToggled then inserttoggle endif ; --------------------------------------------------------------------------- ; An easier to remember synonym for Process_Keys. defproc TypeChars( chars) call Process_Keys( chars) ; --------------------------------------------------------------------------- ; Defined as command for use in key definition files. defc TypeChars parse arg chars call Process_Keys( chars) ; --------------------------------------------------------------------------- ; This takes ascii values of one or multiple chars. Multiple chars can be ; separated by '\'. An leading '\' is optional. ; Example: TypeAscChars \0\170 gives a null char followed by a not char. defc TypeAscChars, TypeEscapedChars Rest = strip( arg( 1)) Chars = '' do while Rest <> '' if leftstr( Rest, 1) <> '\' then Rest = '\'Rest endif parse value Rest with '\'Num'\'Rest Num = strip( Num) Rest = strip( Rest) if IsNum( Num) and Num < 256 then Chars = Chars''chr( Num) else -- Maybe give an error msg here or ignore this one Chars = Chars''Num endif enddo call Process_Keys( Chars) ; --------------------------------------------------------------------------- ; executekey can only execute single WM_CHAR keys, either chars or virtual ; keys defined in the ETK. For multiple keys, keyin can be used. defc DoKey, ExecuteKey 'Key '1 arg( 1) ; --------------------------------------------------------------------------- ; Syntax: Key ; In EPM we don't do a getkey() to ask you for the key. You must supply it ; as part of the command, as in 'key 80 ='. defc Key, LoopKey do once = 1 to 1 parse value arg( 1) with LoopNum k . if not upcase( LoopNum) = 'RC' then if not IsNum( LoopNum) then sayerror INVALID_NUMBER__MSG leave endif endif fSingleKey = IsSingleKey( k) -- jbl: Allow the user to specify the key in the command, so he can -- say 'key 80 =' and avoid the prompt. if k == '' then -- Please specify the key to repeat, as in 'SayError' KEY_PROMPT2__MSG '"Key 'loopnum' =", "Key 'loopnum' S+F3".' leave endif call NextCmdAltersText() i = 0 do forever i = i + 1 if IsNum( LoopNum) then if i > LoopNum then leave endif endif -- Execute key if fSingleKey then -- Type char executekey k else KeyString = NormalizeKeyString( k) Cmd = GetKeysAVar( 'keydef.'KeyString) if Cmd <> '' then -- Execute Cmd Cmd else -- Execute virtual WM_CHAR key (not used anymore in NEPMD) executekey Resolve_Key( k) endif endif if upcase( LoopNum) = 'RC' then if rc then leave endif endif enddo enddo ; --------------------------------------------------------------------------- defc Keyin parse arg chars --'SayError chars = "'chars'"' if chars == '' then keyin ' ' else keyin chars endif ; --------------------------------------------------------------------------- ; In E3 and EOS2, we can use a_X to enter the value of any key. In EPM, ; we can't, so the following routine is used by KEY and LOOPKEY to convert ; from an ASCII key name to the internal value. It handles shift or alt + ; any letter, or a function key (optionally, with any shift prefix). LAM ; suffix for virtual keys ; hex dec ; 02 2 without prefix ; 0a 10 Sh ; 12 18 Ctrl ; 22 34 Alt ; ; suffix for letters ; hex dec ; 10 16 Ctrl ; 20 32 Alt ; defproc Resolve_Key( k) kl = lowcase( k) suffix = \2 -- For unshifted function keys if length( k) >= 3 & pos( substr( k, 2, 1), '_-+') then if length( k) > 3 then if substr( kl, 3, 1) = 'f' then -- Shifted function key suffix = substr( \10\34\18, pos( leftstr( kl, 1), 'sac'), 1) -- Set suffix, kl = substr( kl, 3) -- strip shift prefix, and more later... elseif wordpos( substr( kl, 3), 'left up right down') then suffix = substr( \10\34\18, pos( leftstr( kl, 1), 'sac'), 1) -- Set suffix, kl = substr( kl, 3) -- strip shift prefix, and more later... else -- Something we don't handle... 'SayError Resolve_key:' sayerrortext(-328) rc = -328 endif else -- alt+letter or ctrl+letter k = substr( kl, 3, 1) || substr( \32\16, pos( leftstr( kl, 1), 'ac'), 1) endif endif if leftstr( kl, 1) = 'f' & isnum( substr( kl, 2)) then k = chr( substr( kl, 2) + 31) || suffix elseif wordpos( kl, 'left up right down') then k = chr( wordpos( kl, 'left up right down') + 20) || suffix endif return k ; --------------------------------------------------------------------------- ; An accelerator key issues a WM_COMMAND message, which is processed by the ; ProcessCommand command defined in menu.e. ; Some other defs where accelerator keys are filtered are: ; def otherkeys, defproc process_key, defc ProcessOtherKeys ; queryaccelstring returns the command connected with the specified menu item ; or accelerator key def. ; --------------------------------------------------------------------------- ; Add or redefine an entry to the active named accelerator key table. ; ; Syntax: DefKey( KeyString, Cmd[, 'L']) ; ; KeyString prefixes are separated by '_', '+' or '-'. The following ; prefixes are defined: ; 'c_' Ctrl ; 's_' Shift ; 'a_' Alt ; In this definition the order of the prefixes doesn't matter, while ; on execution, the KeyString prefixes are used in the above order. ; Cmd must be an E command string, not E code. ; 'L' is the option for defining the key as a lonekey ; (a lonekey is executed once on releasing the key) ; ; Examples: ; DefKey( 'c_s_Q', 'SayError Ctrl+Shift+Q pressed') ; DefKey( 'c+s+q', 'SayError Ctrl+Shift+Q pressed') (equivalent) ; DefKey( 'C-S-q', 'SayError Ctrl+Shift+Q pressed') (equivalent) ; DefKey( 'altgraf', 'SayError AltGraf key pressed', 'L') ; For defining non-ASCII keys that don't match the upcase or lowcase ; procedure processing, the key has to be defined in the correct ; case: ; DefKey( '„', 'SayError Lowercase „ (a-umlaut) pressed') ; DefKey( 's_Ž', 'SayError Uppercase „ (a-umlaut) pressed') ; ; For standard accel table defs, the first def wins. This command changes it, ; so that an accel table can be extended as expected: An already existing ; accel table entry is overridden by a new one. That makes the last def win ; and avoids multiple defs for a key. ; defproc DefKey( KeyString, Cmd) universal activeaccel universal lastkeyaccelid universal cua_menu_accel Flags = 0 String = KeyString call GetAFFlags( String, KeyString, Char, Flags) -- parses modifier prefixes of String -- Parse lonekey option fPadKey = 0 Options = upcase( arg( 3)) if Options <> '' then if pos( Options, 'L') > 0 then Flags = Flags + AF_LONEKEY endif endif -- Handle deactivated 'block Alt+letter keys from jumping to menu bar' -- Note: These keys and F10 can't be recorded, they are handled by PM. -- There exists no ETK procs to activate the menu. if IsSingleKey( Char) then if cua_menu_accel then if Flags = AF_ALT & wordpos( Char, upcase( GetMenuAVar( 'usedmenuaccelerators'))) then return endif endif endif -- Remove previous key def in array vars, if any PrevCmd = GetKeysAVar('keydef.'KeyString) DelKeysAVar( 'keycmd.'PrevCmd, KeyString) -- Save key def in array to allow for searching for KeyString and Cmd SetKeysAVar( 'keydef.'KeyString, Cmd) AddKeysAVar( 'keycmd.'Cmd, KeyString) -- may have multiple key defs -- Add KeyString to category array vars SaveKeyCat( KeyString) -- Handle key defs that have to be defined as ETK keys instead of PM -- accelerator keys. -- In order to type the single accent key '^' which is created by -- +, space must not be defined as accel key. Therefore -- Space is defined with ExecKeyCmd. That means that it executes the -- command that is stored by DefKey( Space, cmd) as an array var. -- Ignore Alt+keypad number keys as accel keys here. Just save key in -- array to query it by ExecKeyCmd. -- That makes the Alt+keypad number keys work for entering a char by its -- key code. NonAccelKeys = GetKeysAVar( 'nonaccelkeys') if wordpos( KeyString, NonAccelKeys) then -- Save key def in a keyset-specific array SetKeysAVar( 'nonaccelkeydef.'activeaccel'.'KeyString, Cmd) return endif if IsSingleKey( Char) then Flags = Flags + AF_CHAR if Flags bitand AF_SHIFT then Key = asc( upcase( Char)) else Key = asc( lowcase( Char)) endif else VK = GetVKConst( Char) if VK > 0 then Key = VK Flags = Flags + AF_VIRTUALKEY else 'SayError Error: Unknown key string 'KeyString' specified.' --dprintf( 'KeyString = 'KeyString', Cmd = 'Cmd', Flags = 'Flags', Key = 'Key', last id = 'lastkeyaccelid) return endif endif AccelId = GetKeysAVar( 'keyid.'KeyString) if AccelId = '' then lastkeyaccelid = lastkeyaccelid + 1 if lastkeyaccelid = 8101 then -- 8101 is hardcoded as 'configdlg SYS' lastkeyaccelid = lastkeyaccelid + 1 endif AccelId = lastkeyaccelid endif -- Avoid to define c_break as accelerator key to keep the internal -- definition working. That key is additionally defined as ProcessBreak -- in STDKEYS.E, to make MenuAccelString() work. if KeyString <> 'c_break' then buildacceltable activeaccel, KeyString''\1''Cmd, Flags, Key, AccelId endif -- Save key def in array to allow for searching for KeyString and Cmd SetKeysAVar( 'keyid.'KeyString, AccelId) --if KeyString = 'alt' then -- dprintf( 'KeyString = 'KeyString', Cmd = 'Cmd', Flags = 'Flags', Key = 'Key', id = 'lastkeyaccelid) --endif --if KeyString = 'c_s' then -- dprintf( 'KeyString = 'KeyString', Cmd = 'Cmd', Flags = 'Flags', Key = 'Key', this id = 'AccelId', last id = 'lastkeyaccelid) --endif /* -- For non-letter chars: define also the shifted variant automatically -- to make the defs more keyboard-independible. if Flags bitand AF_CHAR and not Flags bitand AF_SHIFT then if upcase( Key) = lowcase( Key) then Flags = Flags + AF_SHIFT lastkeyaccelid = lastkeyaccelid + 1 buildacceltable activeaccel, KeyString''\1''Cmd, Flags, Key, AccelId endif endif */ return ; Define a cmd to call the proc in profile.erx or for testing defc DefKey parse arg KeyString Cmd if upcase( lastword( Cmd)) = 'L' then Options = 'L' Cmd = subword( Cmd, 1, words( Cmd) - 1) else Options = '' endif call DefKey( KeyString, Cmd, Options) ; --------------------------------------------------------------------------- ; Syntax: UnDefKey( KeyString) defproc UnDefKey( KeyString) universal activeaccel AccelId = GetKeysAVar( 'keyid.'KeyString) if AccelId <> '' then -- Define Ctrl+Alt (= nothing) for this id -- Don't change the array var to allow for redefining this id again buildacceltable activeaccel, '', AF_CONTROL+AF_VIRTUALKEY, VK_ALT, AccelId -- Remove KeyString from 'keycmd.' array var Cmd = GetKeysAVar('keydef.'KeyString) DelKeysAVar( 'keycmd.'Cmd, KeyString) else -- No error message if key was not defined before endif -- Remove KeyString from category array vars DelKeyCat( KeyString) return ; Define a cmd to call the proc in profile.erx or for testing defc UnDefKey parse arg KeyString call UnDefKey( KeyString) ; --------------------------------------------------------------------------- defproc DefKeyCategory( CategoryName) universal activeaccel do once = 1 to 1 if CategoryName = '' then leave endif Keyset = activeaccel if Keyset = '' then leave endif --LastNum = GetKeysAVar( 'keycatname.0') LastNum = GetKeysAVar( 'keycatname.'Keyset'.0') if LastNum = '' then LastNum = 0 endif -- Add only new categories for keyset fLeave = 0 do n = 1 to LastNum KeyCat = GetKeysAVar( 'keycatname.'Keyset'.'n) if CategoryName = KeyCat then -- Don't add existing categories fLeave = 1 leave endif enddo if fLeave then leave endif LastNum = LastNum + 1 --dprintf( 'Keyset = 'Keyset', n = 'LastNum', Category = 'CategoryName) SetKeysAVar( 'keycatname.'Keyset'.'LastNum, CategoryName) SetKeysAVar( 'keycatname.'Keyset'.0', LastNum) enddo -- Allow for reset CategoryName if empty SetKeysAVar( 'curkeycatname', CategoryName) return ; --------------------------------------------------------------------------- ; Add KeyString to category array vars defproc SaveKeyCat( KeyString) -- Query current key category KeyCat = GetKeysAVar( 'curkeycatname') if KeyCat = '' then KeyCat = 'Miscellaneous' endif Keyset = GetKeysAVar( 'curkeysetcmd') if Keyset <> '' then -- Query previous category array var for KeyString PrevKeyCat = GetKeysAVar( 'keycat.'Keyset'.'KeyString) -- Process only, if change required if PrevKeyCat <> KeyCat then -- Remove KeyString from previous category list DelKeysAVar( 'catkeys.'Keyset'.'PrevKeyCat, KeyString) -- Add KeyString to category list AddKeysAVar( 'catkeys.'Keyset'.'KeyCat, KeyString) -- Save key def in array to allow for searching for KeyString and KeyCat SetKeysAVar( 'keycat.'Keyset'.'KeyString, KeyCat) endif endif return ; --------------------------------------------------------------------------- ; Remove KeyString from category array vars defproc DelKeyCat( KeyString) Keyset = GetKeysAVar( 'curkeysetcmd') if Keyset <> '' then -- Query previous category array var for KeyString PrevKeyCat = GetKeysAVar( 'keycat.'Keyset'.'KeyString) -- Remove KeyString from previous category list DelKeysAVar( 'catkeys.'Keyset'.'PrevKeyCat, KeyString) -- Remove var name from array DropKeysAVar( 'keycat.'Keyset'.'KeyString) endif return ; --------------------------------------------------------------------------- defproc GetAFFlags( String, var KeyString, var Char, var Flags) TmpStr = String -- Get prefix fC_Prefix = 0 fA_Prefix = 0 fS_Prefix = 0 do l = 1 to length( TmpStr) -- Just an upper limit to prevent looping forever if length( TmpStr) <= 2 then leave endif ch1 = upcase( leftstr( TmpStr, 1)) ch2 = substr( TmpStr, 2, 1) p1 = pos( ch1, 'CAS') if not p1 then leave endif p2 = pos( ch2, '_-+') if not p2 then leave endif TmpStr = substr( TmpStr, 3) if p1 = 1 then fC_Prefix = 1 elseif p1 = 2 then fA_Prefix = 1 elseif p1 = 3 then fS_Prefix = 1 endif enddo -- Char is String without prefix Char = TmpStr Flags = 0 PrefixString = '' if fC_Prefix = 1 then Flags = Flags + AF_CONTROL -- 16 PrefixString = PrefixString'c_' endif if fA_Prefix = 1 then Flags = Flags + AF_ALT -- 32 PrefixString = PrefixString'a_' endif if fS_Prefix = 1 then Flags = Flags + AF_SHIFT -- 8 PrefixString = PrefixString's_' endif -- Try to resolve virtual keys VK = GetVKName( Char) -- Build return string if VK = '' then -- If not defined as virtual key, change KeyString to lowercase. -- This allows to use these procs for mouse definitions as well. KeyString = PrefixString''lowcase( Char) else KeyString = PrefixString''VK endif return ; --------------------------------------------------------------------------- defproc NormalizeKeyString( String) KeyString = '' call GetAFFlags( String, KeyString, Char, Flags) --dprintf( 'NormalizeKeyString( 'arg( 1)'): GetAFFlags( 'String', 'KeyString', 'Char', 'Flags')') return KeyString ; --------------------------------------------------------------------------- defproc GetVKConst( String) VK = 0 String = upcase( String) if String = 'BREAK' then VK = VK_BREAK elseif String = 'BACKSPACE' then VK = VK_BACKSPACE elseif String = 'BKSPC' then VK = VK_BACKSPACE elseif String = 'TAB' then VK = VK_TAB elseif String = 'BACKTAB' then VK = VK_BACKTAB elseif String = 'NEWLINE' then VK = VK_NEWLINE -- This is the regular Enter key elseif String = 'SHIFT' then VK = VK_SHIFT elseif String = 'CTRL' then VK = VK_CTRL elseif String = 'ALT' then VK = VK_ALT elseif String = 'ALTGRAF' then VK = VK_ALTGRAF elseif String = 'ALTGR' then VK = VK_ALTGRAF elseif String = 'PAUSE' then VK = VK_PAUSE elseif String = 'CAPSLOCK' then VK = VK_CAPSLOCK elseif String = 'ESC' then VK = VK_ESC elseif String = 'SPACE' then VK = VK_SPACE elseif String = 'PAGEUP' then VK = VK_PAGEUP elseif String = 'PGUP' then VK = VK_PAGEUP elseif String = 'PAGEDOWN' then VK = VK_PAGEDOWN elseif String = 'PGDOWN' then VK = VK_PAGEDOWN elseif String = 'PGDN' then VK = VK_PAGEDOWN elseif String = 'END' then VK = VK_END elseif String = 'HOME' then VK = VK_HOME elseif String = 'LEFT' then VK = VK_LEFT elseif String = 'UP' then VK = VK_UP elseif String = 'RIGHT' then VK = VK_RIGHT elseif String = 'DOWN' then VK = VK_DOWN elseif String = 'DN' then VK = VK_DOWN elseif String = 'PRINTSCRN' then VK = VK_PRINTSCRN elseif String = 'INSERT' then VK = VK_INSERT elseif String = 'INS' then VK = VK_INSERT elseif String = 'DELETE' then VK = VK_DELETE elseif String = 'DEL' then VK = VK_DELETE elseif String = 'SCRLLOCK' then VK = VK_SCRLLOCK elseif String = 'NUMLOCK' then VK = VK_NUMLOCK elseif String = 'ENTER' then VK = VK_ENTER -- This is the numeric keypad Enter key elseif String = 'PADENTER' then VK = VK_ENTER -- This is the numeric keypad Enter key elseif String = 'SYSRQ' then VK = VK_SYSRQ elseif String = 'F1' then VK = VK_F1 elseif String = 'F2' then VK = VK_F2 elseif String = 'F3' then VK = VK_F3 elseif String = 'F4' then VK = VK_F4 elseif String = 'F5' then VK = VK_F5 elseif String = 'F6' then VK = VK_F6 elseif String = 'F7' then VK = VK_F7 elseif String = 'F8' then VK = VK_F8 elseif String = 'F9' then VK = VK_F9 elseif String = 'F10' then VK = VK_F10 elseif String = 'F11' then VK = VK_F11 elseif String = 'F12' then VK = VK_F12 endif return VK ; --------------------------------------------------------------------------- defproc GetVKName( String) VK = '' String = upcase( String) if String = 'BREAK' then VK = 'break' elseif String = 'BACKSPACE' then VK = 'backspace' elseif String = 'BKSPC' then VK = 'backspace' elseif String = 'TAB' then VK = 'tab' elseif String = 'BACKTAB' then VK = 'backtab' elseif String = 'NEWLINE' then VK = 'newline' -- This is the regular Enter key elseif String = 'SHIFT' then VK = 'shift' elseif String = 'CTRL' then VK = 'ctrl' elseif String = 'ALT' then VK = 'alt' elseif String = 'ALTGRAF' then VK = 'altgraf' elseif String = 'ALTGR' then VK = 'altgraf' elseif String = 'PAUSE' then VK = 'pause' elseif String = 'CAPSLOCK' then VK = 'capslock' elseif String = 'ESC' then VK = 'esc' elseif String = 'SPACE' then VK = 'space' elseif String = 'PAGEUP' then VK = 'pageup' elseif String = 'PGUP' then VK = 'pageup' elseif String = 'PAGEDOWN' then VK = 'pagedown' elseif String = 'PGDOWN' then VK = 'pagedown' elseif String = 'PGDN' then VK = 'pagedown' elseif String = 'END' then VK = 'end' elseif String = 'HOME' then VK = 'home' elseif String = 'LEFT' then VK = 'left' elseif String = 'UP' then VK = 'up' elseif String = 'RIGHT' then VK = 'right' elseif String = 'DOWN' then VK = 'down' elseif String = 'DN' then VK = 'down' elseif String = 'PRINTSCRN' then VK = 'printscrn' elseif String = 'INSERT' then VK = 'insert' elseif String = 'INS' then VK = 'insert' elseif String = 'DELETE' then VK = 'delete' elseif String = 'DEL' then VK = 'delete' elseif String = 'SCRLLOCK' then VK = 'scrllock' elseif String = 'NUMLOCK' then VK = 'numlock' elseif String = 'ENTER' then VK = 'enter' -- This is the numeric keypad Enter key elseif String = 'PADENTER' then VK = 'enter' -- This is the numeric keypad Enter key elseif String = 'SYSRQ' then VK = 'sysrq' elseif String = 'F1' then VK = 'f1' elseif String = 'F2' then VK = 'f2' elseif String = 'F3' then VK = 'f3' elseif String = 'F4' then VK = 'f4' elseif String = 'F5' then VK = 'f5' elseif String = 'F6' then VK = 'f6' elseif String = 'F7' then VK = 'f7' elseif String = 'F8' then VK = 'f8' elseif String = 'F9' then VK = 'f9' elseif String = 'F10' then VK = 'f10' elseif String = 'F11' then VK = 'f11' elseif String = 'F12' then VK = 'f12' endif return VK ; --------------------------------------------------------------------------- const ; Also added to ENGLISH.E compile if not defined( NEWLINE_KEY__MSG) NEWLINE_KEY__MSG = 'Newline' compile endif defproc GetVKMenuName( String) VK = '' String = upcase( String) if String = 'BREAK' then VK = 'Brk' elseif String = 'BACKSPACE' then VK = BACKSPACE_KEY__MSG elseif String = 'BKSPC' then VK = BACKSPACE_KEY__MSG elseif String = 'TAB' then VK = 'Tab' elseif String = 'BACKTAB' then VK = 'BackTab' elseif String = 'NEWLINE' then VK = NEWLINE_KEY__MSG -- This is the regular Enter key elseif String = 'SHIFT' then VK = SHIFT_KEY__MSG elseif String = 'CTRL' then VK = CTRL_KEY__MSG elseif String = 'ALT' then VK = ALT_KEY__MSG elseif String = 'ALTGRAF' then VK = 'AltGraf' elseif String = 'ALTGR' then VK = 'AltGraf' elseif String = 'PAUSE' then VK = 'Pause' elseif String = 'CAPSLOCK' then VK = 'Capslock' elseif String = 'ESC' then VK = ESCAPE_KEY__MSG elseif String = 'SPACE' then VK = 'Space' elseif String = 'PAGEUP' then VK = 'PgUp' elseif String = 'PGUP' then VK = 'PgUp' elseif String = 'PAGEDOWN' then VK = 'PgDown' elseif String = 'PGDOWN' then VK = 'PgDown' elseif String = 'PGDN' then VK = 'PgDown' elseif String = 'END' then VK = 'End' elseif String = 'HOME' then VK = 'Home' elseif String = 'LEFT' then VK = 'Left' elseif String = 'UP' then VK = UP_KEY__MSG elseif String = 'RIGHT' then VK = 'Right' elseif String = 'DOWN' then VK = DOWN_KEY__MSG elseif String = 'DN' then VK = DOWN_KEY__MSG elseif String = 'PRINTSCRN' then VK = 'PrtScrn' elseif String = 'INSERT' then VK = INSERT_KEY__MSG elseif String = 'INS' then VK = INSERT_KEY__MSG elseif String = 'DELETE' then VK = DELETE_KEY__MSG elseif String = 'DEL' then VK = DELETE_KEY__MSG elseif String = 'SCRLLOCK' then VK = 'ScrlLock' elseif String = 'NUMLOCK' then VK = 'NumLock' elseif String = 'ENTER' then VK = PADENTER_KEY__MSG -- This is the numeric keypad Enter key elseif String = 'PADENTER' then VK = PADENTER_KEY__MSG -- This is the numeric keypad Enter key elseif String = 'SYSRQ' then VK = 'SysRq' elseif String = 'F1' then VK = 'F1' elseif String = 'F2' then VK = 'F2' elseif String = 'F3' then VK = 'F3' elseif String = 'F4' then VK = 'F4' elseif String = 'F5' then VK = 'F5' elseif String = 'F6' then VK = 'F6' elseif String = 'F7' then VK = 'F7' elseif String = 'F8' then VK = 'F8' elseif String = 'F9' then VK = 'F9' elseif String = 'F10' then VK = 'F10' elseif String = 'F11' then VK = 'F11' elseif String = 'F12' then VK = 'F12' endif return VK ; --------------------------------------------------------------------------- defproc GetVKString( VkCode) String = '' if VkCode = VK_BREAK then String = 'break' elseif VkCode = VK_BACKSPACE then String = 'backspace' elseif VkCode = VK_TAB then String = 'tab' elseif VkCode = VK_BACKTAB then String = 'backtab' elseif VkCode = VK_NEWLINE then String = 'newline' elseif VkCode = VK_SHIFT then String = 'shift' elseif VkCode = VK_CTRL then String = 'ctrl' elseif VkCode = VK_ALT then String = 'alt' elseif VkCode = VK_ALTGRAF then String = 'altgraf' elseif VkCode = VK_PAUSE then String = 'pause' elseif VkCode = VK_CAPSLOCK then String = 'capslock' elseif VkCode = VK_ESC then String = 'esc' elseif VkCode = VK_SPACE then String = 'space' elseif VkCode = VK_PAGEUP then String = 'pageup' elseif VkCode = VK_PAGEDOWN then String = 'pagedown' elseif VkCode = VK_END then String = 'end' elseif VkCode = VK_HOME then String = 'home' elseif VkCode = VK_LEFT then String = 'left' elseif VkCode = VK_UP then String = 'up' elseif VkCode = VK_RIGHT then String = 'right' elseif VkCode = VK_DOWN then String = 'down' elseif VkCode = VK_DOWN then String = 'dn' elseif VkCode = VK_PRINTSCRN then String = 'printscrn' elseif VkCode = VK_INSERT then String = 'insert' elseif VkCode = VK_DELETE then String = 'delete' elseif VkCode = VK_SCRLLOCK then String = 'scrllock' elseif VkCode = VK_NUMLOCK then String = 'numlock' elseif VkCode = VK_ENTER then String = 'padenter' elseif VkCode = VK_SYSRQ then String = 'sysrq' elseif VkCode = VK_F1 then String = 'f1' elseif VkCode = VK_F2 then String = 'f2' elseif VkCode = VK_F3 then String = 'f3' elseif VkCode = VK_F4 then String = 'f4' elseif VkCode = VK_F5 then String = 'f5' elseif VkCode = VK_F6 then String = 'f6' elseif VkCode = VK_F7 then String = 'f7' elseif VkCode = VK_F8 then String = 'f8' elseif VkCode = VK_F9 then String = 'f9' elseif VkCode = VK_F10 then String = 'f10' elseif VkCode = VK_F11 then String = 'f11' elseif VkCode = VK_F12 then String = 'f12' endif return String ; --------------------------------------------------------------------------- ; Get key def as appendix for a menu item text, with a prepended tab char, ; if any text. Supports multiple Cmds, if specified as separate args. defproc MenuAccelString AccelString = '' do i = 1 to arg() Cmd = arg( i) if Cmd = '' then iterate endif -- Query array var, defined by DefKey KeyString = strip( GetKeysAVar( 'keycmd.'Cmd)) if KeyString = '' then iterate endif -- A Cmd may have multiple key defs, each appended by a space do w = 1 to words( KeyString) Rest = word( KeyString, w) ThisString = '' if pos( 'c_', Rest) = 1 then ThisString = ThisString''CTRL_KEY__MSG'+' Rest = substr( Rest, 3) endif if pos( 'a_', Rest) = 1 then ThisString = ThisString''ALT_KEY__MSG'+' Rest = substr( Rest, 3) endif if pos( 's_', Rest) = 1 then ThisString = ThisString''SHIFT_KEY__MSG'+' Rest = substr( Rest, 3) endif if Rest <> '' then VKString = GetVKMenuName( Rest) if VKString <> '' then ThisString = ThisString''VKString else ThisString = ThisString''upcase( Rest) endif endif if AccelString <> '' then AccelString = AccelString' | 'ThisString else AccelString = ThisString endif enddo enddo if AccelString <> '' then AccelString = \9''AccelString endif return AccelString ; For testing: defc MenuAccelString Cmd = strip( arg( 1)) 'SayError Menu item text appendix for "'Cmd'" is: |'MenuAccelString( Cmd)'|' ; --------------------------------------------------------------------------- ; This is for .KEYSET_DEFINITIONS_* files. It converts a KeyString to a ; String as used for menu item texts to display the key def. defproc ConvertKeyString( KeyString) ThisString = '' Rest = KeyString do while Rest <> '' if pos( 'c_', Rest) = 1 then ThisString = ThisString''CTRL_KEY__MSG'+' Rest = substr( Rest, 3) iterate endif if pos( 'a_', Rest) = 1 then ThisString = ThisString''ALT_KEY__MSG'+' Rest = substr( Rest, 3) iterate endif if pos( 's_', Rest) = 1 then ThisString = ThisString''SHIFT_KEY__MSG'+' Rest = substr( Rest, 3) iterate endif if Rest <> '' then VKString = GetVKMenuName( Rest) if VKString <> '' then ThisString = ThisString''VKString else CapRest = upcase( leftstr( Rest, 1))''substr( Rest, 2) ThisString = ThisString''CapRest endif Rest = '' endif enddo return ThisString ; --------------------------------------------------------------------------- ; Called by ProcessCommand in MENU.E defproc ExecAccelKey parse value( arg( 1)) with KeyString \1 Cmd call SaveKeyCmd( arg( 1)) fExpanded = ExpandKey() --dprintf( 'ExecAccelKey: KeyString = 'KeyString', fExpanded = 'fExpanded) if fExpanded = 0 then Cmd endif return ; --------------------------------------------------------------------------- ; ExpandKey is called by ExecKeyCmd, ExecAccelKey and ExecMenuItem. defproc ExpandKey universal expand_on fExpanded = 0 do once = 1 to 1 -- Check first if any expansion is enabled KeyPath = '\NEPMD\User\SpecialKeys\MatchFindOpening' fFindOpening = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\SpecialKeys\MatchInsertPair' fInsertPair = QueryConfigKey( KeyPath) if fFindOpening | fInsertPair | expand_on then -- Ensure that cursor is not within a literal Mode = GetMode() if InsideLiteral( Mode) then leave endif endif if fFindOpening | fInsertPair then -- Try to expand match char fExpanded = (ExpandMatchChars() == 1) if fExpanded = 1 then leave endif endif if expand_on then -- Try to expand syntax fExpanded = (ExpandSyntax() == 1) if fExpanded = 1 then leave endif endif enddo -- fExpanded = 1 must stop further processing in the calling proc. return fExpanded ; --------------------------------------------------------------------------- ; Keyset array vars: ; ; 'keysets' list of defined keysets ; 'keyset.'name list of subkeysets (keyset cmds) for keyset name ; 'keysetused.'cmdname list of keysets that use cmdname ; (this var allows for changing keysets for all ; loaded files, not just for newly loaded files) ; ; Examples with cuakeys active: Examples without cuakeys active: ; 'keysets' = 'std shell' 'keysets' = 'std shell' ; 'keyset.std' = 'std cua' 'keyset.std' = 'std' ; 'keysetused.std' = 'std shell' 'keysetused.std' = 'std shell' ; 'keyset.shell' = 'std cua shell' 'keyset.shell' = 'std shell' ; 'keysetused.shell' = 'shell' 'keysetused.shell' = 'shell' ; ; --------------------------------------------------------------------------- ; Define a named accel table. It has to be activated with SetKeyset. ; ; Syntax: DefKeyset [] [ ...] ; DefKeyset [] [value] ...] ; ; Instead of a keyset cmd, a keyset name can be specified (with 'value' ; appended). Then the specified keyset will be extended. defc DefAccel, DefKeyset universal activeaccel universal lastkeyaccelid universal LoadState -- Default accel table name = 'std' (standard EPM uses 'defaccel') StdName = 'std' -- Init accel table defs StartAccelId = 10000 -- max. = 65534 (65535 is hardcoded as Halt cmd) if lastkeyaccelid < StartAccelId then lastkeyaccelid = StartAccelId activeaccel = StdName -- Bug in ETK: first def is ignored, therefore add a dummy def here -- This must be a valid def, otherwise the menu is not loaded at startup: buildacceltable StdName, 'SayError Ignored!', AF_VIRTUALKEY, VK_ALT, lastkeyaccelid endif parse arg Keyset SubKeysets Keyset = strip( Keyset) if Keyset = '' | lowcase( Keyset) = 'edit' | lowcase( Keyset) = 'default' then Keyset = StdName endif Keyset = lowcase( Keyset) SubKeysets = strip( SubKeysets) SubKeysets = lowcase( SubKeysets) if SubKeysets = '' then -- Use default keyset defs if Keyset = StdName then SubKeysets = StdName -- use defc stdkeys else SubKeysets = StdName'value' Keyset -- extend stdkeys with defc Namekeys endif endif SavedAccel = activeaccel activeaccel = Keyset --dprintf( 'DefKeyset: Keyset = 'Keyset', SubKeysets = 'SubKeysets', SavedAccel = 'SavedAccel) -- Parse keyset definition list and get resolved list of SubKeysets. -- Keyset command defs have 'keys' appended. In the following, the -- term 'keyset cmd' means the command without 'keys'. The same applies -- for the array vars, were the string without 'keys' is used, too. List = SubKeysets SubKeysets = '' do w = 1 to words( List) SubKeyset = word( List, w) --dprintf( 'DefKeyset: SubKeyset = 'SubKeyset) -- Allow for specifying a keyset name instead of a list of keyset defs -- (e.g. 'stdvalue' instead of 'std cua') if rightstr( SubKeyset, 5) = 'value' and length( SubKeyset) > 5 then SubName = leftstr( SubKeyset, length( SubKeyset) - 5) SubList = GetKeysAVar( 'keyset.'SubName) do s = 1 to words( SubList) ThisSubKeyset = word( SubList, s) SubKeysets = SubKeysets ThisSubKeyset enddo else SubKeysets = SubKeysets SubKeyset endif enddo SubKeysets = strip( SubKeysets) -- Remove doubled and undefined entries -- Try to link SubKeysets if not defined Next = '' Rest = SubKeysets do forever if Rest = '' then leave endif parse value Rest with SubKeyset Rest SubKeyset = strip( SubKeyset) Rest = strip( Rest) if wordpos( SubKeyset, Rest) then iterate endif -- Check if SubKeyset'keys' is defined as defc and -- maybe link SubKeyset'keys' fIsDefined = KeysetCmdExists( SubKeyset) -- Append SubKeyset only if defined if not fIsDefined then iterate endif Next = Next SubKeyset enddo SubKeysets = strip( Next) if SubKeysets <> '' then -- Change array vars for this keyset name PrevSubKeysets = GetKeysAVar( 'keyset.'Keyset) --dprintf( 'DefKeySet: PrevSubKeysets = 'PrevSubKeysets) if PrevSubKeysets <> SubKeysets then -- For all previous keyset commands do k = 1 to words( PrevSubKeysets) SubKeyset = word( PrevSubKeysets, k) -- Remove keyset name from array var for this SubKeyset DelKeysAVar( 'keysetused.'SubKeyset, Keyset) enddo endif --dprintf( 'DefKeySet: Keyset = 'Keyset', SubKeysets = 'SubKeysets) -- Set array vars for this keyset name AddKeysAVar( 'keysets', Keyset) SetKeysAVar( 'keyset.'Keyset, SubKeysets) -- Set array var for each keyset command and execute it do k = 1 to words( SubKeysets) SubKeyset = word( SubKeysets, k) -- Add keyset name to array var for this keyset cmd AddKeysAVar( 'keysetused.'SubKeyset, Keyset) -- Execute keyset cmd (with 'keys' appended) SubKeyset'keys' enddo -- For Keyset = 'std' write also AddKeyDefs if Keyset = 'std' then AddKeyDefs = word( SubKeysets, 2) -- empty for 'std' = 'std' KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected' WriteConfigKey( KeyPathSelected, AddKeyDefs) endif endif -- The BlockAlt key subset needn't to be added to the 'keysets' array var 'BlockAltKeys' activeaccel = SavedAccel ; --------------------------------------------------------------------------- defproc KeysetCmdExists( SubKeyset) fIsDefined = 0 do once = 1 to 1 -- Check if Keyset cmd exists if isadefc( SubKeyset'keys') then fIsDefined = 1 leave endif -- Check if .EX file exists findfile ExFile, SubKeyset'keys.ex', 'EPMPATH' if rc then leave endif -- Check if .EX file is linked linkedrc = linked( SubKeyset'keys.ex') if linkedrc >= 0 then leave endif -- Link .EX file 'Link quiet' SubKeyset'keys' --dprintf( 'KeysetCmdExists: Keyset "'SubKeyset'Keys" linked, rc = 'rc) -- Check rc from Link if .EX file is linked if rc < 0 then leave endif -- Check if Keyset cmd exists if isadefc( SubKeyset'keys') then fIsDefined = 1 leave endif enddo return fIsDefined ; --------------------------------------------------------------------------- ; Block Alt and/or AltGr from switching to the menu ; PM defines the key F10 to jump to the menu, like Alt and AltGraf. ; It can be used instead, if it's not redefined. ; To block these PM def, Alt and AltGraf have to be defined with the ; AF_LONEKEY flag. defc BlockAltKeys -- Block Alt and/or AltGr from switching to the menu -- PM defines the key F10 to jump to the menu, like Alt and AltGraf. -- It can be used instead, if it's not redefined. -- To block these PM def, Alt and AltGraf have to be defined with the -- AF_LONEKEY flag. -- Redefine every used accel keyset KeyPath = '\NEPMD\User\SpecialKeys\Alt\BlockLeftAlt' fBlocked1 = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\SpecialKeys\Alt\BlockRightAlt' fBlocked2 = QueryConfigKey( KeyPath) if fBlocked1 = 1 then DefKeyCategory( 'Block alt keys') DefKey( 'alt', '', 'L') else UnDefKey( 'alt') endif if fBlocked2 = 1 then DefKeyCategory( 'Block alt keys') DefKey( 'altgraf', '', 'L') else UnDefKey( 'altgraf') endif ; --------------------------------------------------------------------------- ; Redefine every used accel keyset. This can be used by the menu commands ; toggle_block_left_alt_key and toggle_block_right_alt_key to activate the ; changed behavior for all loaded keysets. defc RefreshBlockAlt universal activeaccel KeyPath = '\NEPMD\User\SpecialKeys\Alt\BlockLeftAlt' fBlocked1 = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\SpecialKeys\Alt\BlockRightAlt' fBlocked2 = QueryConfigKey( KeyPath) SavedAccel = activeaccel KeySets = strip( GetKeysAVar( 'keysets')) do w = 1 to words( KeySets) KeySet = word( KeySets, w) activeaccel = KeySet if fBlocked1 = 1 then DefKeyCategory( 'Block alt keys') DefKey( 'alt', '', 'L') else UnDefKey( 'alt') endif if fBlocked2 = 1 then DefKeyCategory( 'Block alt keys') DefKey( 'altgraf', '', 'L') else UnDefKey( 'altgraf') endif enddo activeaccel = SavedAccel activateacceltable activeaccel ; --------------------------------------------------------------------------- defc DisableSwitchKeyset universal switchkeysetdisabled switchkeysetdisabled = 1 defc EnableSwitchKeyset universal switchkeysetdisabled switchkeysetdisabled = 0 ; --------------------------------------------------------------------------- defproc ExpandKeyset parse arg Keyset SubKeysets Keyset = lowcase( strip( Keyset)) -- Default accel table name = 'std' (standard EPM uses 'defaccel') if Keyset = '' | Keyset = 'default' then Keyset = 'std' endif SubKeysets = lowcase( strip( SubKeysets)) if SubKeysets = '' then SubKeysets = GetKeysAVar( 'keyset.'Keyset) endif return strip( Keyset SubKeysets) ; --------------------------------------------------------------------------- ; Init 'std' keyset. This must be executed before executing LoadAccel and ; before loading the menu. It is done in CONFIG.E:"defc InitConfig". defc InitStdKeyset StdName = 'std' 'SetKeyset2' StdName ; --------------------------------------------------------------------------- defc LoadAccel parse arg Args if Args = '' then 'SetKeyset std' else 'SetKeyset' Args -- defined in MODEEXEC.E endif ; --------------------------------------------------------------------------- ; SetKeyset: defined in MODEEXEC.E, contains mode-specific part, calls: ; SetKeyset2: switches keyset and maybe defines it. ; Syntax: SetKeyset [] ; Examples: ; SetKeyset std switch to keyset 'std' ; SetKeyset std std cua define and switch to keyset 'std' = StdKeys and CuaKeys ; SetKeyset std std define and switch to keyset 'std' = StdKeys ; SetKeyset rexx stdvalue rexx define and switch to keyset 'rexx' = value of 'std' and RexxKeys ; SetKeyset rexx switch to keyset 'rexx' defc SetKeyset2 universal activeaccel universal switchkeysetdisabled universal keysetchanged universal menuloaded universal refreshmenudisabled universal refreshmenustate parse value ExpandKeyset( arg( 1)) with Keyset SubKeysets DefinedKeysets = GetKeysAVar( 'keysets') KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected' AddKeyDefs = QueryConfigKey( KeyPathSelected) PrevSubKeysets = strip( GetKeysAVar( 'keyset.'Keyset)) --dprintf( 'SetKeyset2: args = 'arg( 1)', PrevSubKeysets = 'PrevSubKeysets', '.filename) -- Parse keyset definition list and get resolved list of SubKeysets. -- Keyset command defs have 'keys' appended. In the following, the -- term 'keyset cmd' means the command without 'keys'. The same applies -- for the array vars, where the string without 'keys' is used, too. List = SubKeysets SubKeysets = '' do w = 1 to words( List) SubKeyset = word( List, w) --dprintf( 'SefKeyset2: SubKeyset = 'SubKeyset) -- Allow for specifying a keyset name instead of a list of keyset defs -- (e.g. 'stdvalue' instead of 'std cua') if rightstr( SubKeyset, 5) = 'value' and length( SubKeyset) > 5 then SubName = leftstr( SubKeyset, length( SubKeyset) - 5) SubList = GetKeysAVar( 'keyset.'SubName) do s = 1 to words( SubList) ThisSubKeyset = word( SubList, s) SubKeysets = SubKeysets ThisSubKeyset enddo else SubKeysets = SubKeysets SubKeyset endif enddo SubKeysets = strip( SubKeysets) if SubKeysets = '' then -- Switch to keyset only if PrevSubKeysets = '' then if Keyset = 'std' then SubKeysets = strip( Keyset AddKeyDefs) else SubKeysets = strip( strip( 'std' AddKeyDefs) Keyset) endif else SubKeysets = PrevSubKeysets endif else -- Define keyset endif -- Store current keyset in array var and query LastKeyset LastKeyset = GetKeysAVar( 'lastkeyset') call SetKeysAVar( 'lastkeyset', Keyset) --dprintf( 'SetKeyset2: DefinedKeysets = "'DefinedKeysets'", PrevSubKeysets = "'PrevSubKeysets'", SubKeysets = "'SubKeysets'", Keyset = 'Keyset', activeaccel = 'activeaccel) if wordpos( Keyset, DefinedKeysets) = 0 | SubKeysets <> PrevSubKeysets then -- Reset category names and keys first. -- Store Keyset. It is used for to define keyset-specific categories. -- See definitions for DefKeyCategory and SaveKeyCat procs above. SetKeysAVar( 'curkeysetcmd', Keyset) -- Ensure that category is reset before DefKeyset DefKeyCategory( '') -- Define keyset --dprintf( 'SetKeyset2: Define keyset, "DefKeyset' strip( Keyset SubKeysets)'" executed') 'DefKeyset' strip( Keyset SubKeysets) -- Ensure that category is reset after DefKeyset DefKeyCategory( '') endif do once = 1 to 1 if switchkeysetdisabled then leave endif --dprintf( 'SetKeyset2: SwitchKeyset' Keyset SubKeysets) -- Switch to keyset if Keyset <> LastKeyset | SubKeysets <> PrevSubkeysets then --dprintf( 'SetKeyset2: SwitchKeyset' Keyset SubKeysets) 'SwitchKeyset' Keyset SubKeysets endif enddo -- This is required to update the menu texts, e.g. key mnemonics -- RefreshMenu slows file switching down. do once = 1 to 1 if not menuloaded then leave elseif Keyset = LastKeyset & SubKeysets = PrevSubkeysets then leave endif -- 'VSyncCursor' was added because of showwindow to keep scroll position 'VSyncCursor' if refreshmenudisabled <> 1 then -- Rebuild menu -- Suppress refresh of submenus refreshmenustate = 1 'PostMe RefreshMenu' -- PostMe required to make it run properly --dprintf( '* RefreshMenu executed') endif enddo -- Execute basic mouse defs, not defined in StdKeys -- Always required to make the mouse work, even at startup 'Mouse_Init' ; --------------------------------------------------------------------------- ; This ic executed by SetKeyset2. defc SwitchKeyset universal activeaccel PrevKeyset = activeaccel PrevSubKeysets = GetKeysAVar( 'keyset.'PrevKeyset) parse value ExpandKeyset( arg( 1)) with Keyset SubKeysets --dprintf( 'SwitchKeyset: args = 'args', Keyset = 'Keyset', SubKeysets = 'SubKeysets) -- Activate keyset: accelerator keys --dprintf( 'SwitchKeyset: activeaccel = 'activeaccel', Keyset = 'Keyset) activeaccel = Keyset activateacceltable activeaccel -- Activate keyset: keyset-specific array defs (for ExecKeyCmd) NonAccelKeys = GetKeysAVar( 'nonaccelkeys') do w = 1 to words( NonAccelKeys) KeyString = word( NonAccelKeys, w) NonAccelKeyDef = GetKeysAVar( 'nonaccelkeydef.'Keyset'.'KeyString) SetKeysAVar( 'keydef.'KeyString, NonAccelKeyDef) enddo -- Switch to previously defined keyset. Redefine menu accel strings. do k = 1 to words( SubKeysets) SubKeyset = word( SubKeysets, k) -- Execute keyset cmd (with 'keys' appended). This calls a set of DefKey -- procs. --dprintf( 'SwitchKeyset: Executing "'SubKeyset'keys" for '.filename) SubKeyset'keys' enddo --dprintf( 'SwitchKeyset: Switch keyset, keyset cmds executed: 'Keyset' = 'SubKeysets) ; --------------------------------------------------------------------------- defc ReloadKeyset universal activeaccel Keyset = activeaccel SubKeysets = GetKeysAVar( 'keyset.'Keyset) 'DelKeyset' -- Reset list of defined keysets to make SetKeyset2 execute DefKeyset call SetKeysAVar( 'keysets', '') -- Redef key defs --dprintf( 'ReloadKeyset: SetKeyset2' Keyset SubKeysets) 'SetKeyset2' Keyset SubKeysets ; --------------------------------------------------------------------------- defc ShowKeyset universal activeaccel parse arg Keyset if Keyset = '' then Keyset = activeaccel endif TmpFileName = '.KEYSET_DEFINITIONS_'Keyset getfileid startfid display -3 if IsFileLoaded( TmpFileName) then 'xcom e /n' TmpFileName -- activate tmp file else 'xcom e /c' TmpFileName -- create tmp file deleteline -- delete first line (EPM automatically creates line 1) endif getfileid tmpfid savedlast = .last .autosave = 0 insertline copies('-', 78), .last + 1 SubKeysets = GetKeysAVar( 'keyset.'Keyset) insertline 'Keyset: 'Keyset' - Subkeysets: 'SubKeysets, .last + 1 insertline '', .last + 1 LastNum = GetKeysAVar( 'keycatname.'Keyset'.0') --dprintf( 'LastNum = 'LastNum) Indent = copies( ' ', 3) do n = 1 to LastNum KeyCat = GetKeysAVar( 'keycatname.'Keyset'.'n) KeyStrings = GetKeysAVar( 'catkeys.'Keyset'.'KeyCat) if KeyStrings = '' then iterate endif KeyCatText = KeyCat if KeyCat = 'Newline' then mmax = 2 else mmax = 1 endif do m = 1 to mmax if KeyCat = 'Newline' then if m = 1 then mode = 'stream' else mode = 'line' endif KeyCatText = KeyCat' in 'mode' mode' endif insertline '', .last + 1 insertline Indent''KeyCatText, .last + 1 insertline '', .last + 1 do w = 1 to words( KeyStrings) KeyString = word( KeyStrings, w) Cmd = GetKeysAVar( 'keydef.'KeyString) if Cmd = '' then Cmd = GetKeysAVar( 'mousedef.'KeyString) endif if subword( upcase( Cmd), 1, 1) = 'NEWLINE' then KeyPath = '\NEPMD\User\SpecialKeys' if mode = 'stream' then KeyPath = KeyPath'\Stream' else KeyPath = KeyPath'\Line' endif KeyPath = KeyPath'\'KeyString next = QueryConfigKey( KeyPath) if next = '' then next = 'Split,KeepIndent' endif parse value next with SplitCfg','ColCfg','fCmd','NewlineCmd if fCmd <> 1 then fCmd = 0 endif if fCmd then Cmd = NewlineCmd else Cmd = 'Newline' SplitCfg','ColCfg endif elseif wordpos( subword( upcase( Cmd), 1, 1), 'TAB BACKTAB') then KeyPath = '\NEPMD\User\SpecialKeys\'KeyString next = QueryConfigKey( KeyPath) Cmd = Cmd next endif CnvKeyString = ConvertKeyString( KeyString) -- Longest KeyString = 21 KeyStringSpc = leftstr( KeyString, Max( 21 + length( Indent), length( KeyString)))''Indent -- Longest CnvKeyString = 24 CnvKeyStringSpc = leftstr( CnvKeyString, Max( 24 + length( Indent), length( CnvKeyString)))''Indent -- Display only converted KeyString and Cmd columns: insertline Indent''Indent''CnvKeyStringSpc''Cmd, .last + 1 -- Display an additional KeyString column: --insertline Indent''Indent''KeyStringSpc''CnvKeyStringSpc''Cmd, .last + 1 enddo enddo enddo insertline '', .last + 1 tmpfid.modify = 0 --activatefile tmpfid .cursory = 4 -- Scroll almost to the top (must come before setting the line) .line = savedlast + 1 .col = 1 display 3 ; --------------------------------------------------------------------------- ; This must be used instead of the internally defined deleteaccel statement. ; Disadvantage: This closes the menu, even if nodismiss is set for a menu ; item. This is caused by the array var procs, because they switch ; temporarily to a hidden file. defc DeleteAccel, DelKeyset universal activeaccel if arg( 1) = '' | lowcase( arg( 1)) = 'defaccel' then Keyset = activeaccel else Keyset = arg( 1) endif Keyset = lowcase( Keyset) deleteaccel Keyset activeaccel = '' -- Change array vars for this keyset name DelKeysAVar( 'keysets', Keyset) SubKeysets = GetKeysAVar( 'keyset.'Keyset) -- For all keyset commands do k = 1 to words( SubKeysets) SubKeyset = word( SubKeysets, k) -- Remove keyset name from array var for this keyset cmd DelKeysAVar( 'keysetused.'SubKeyset, Keyset) enddo DropKeysAVar( 'keyset.'Keyset) -- For all categories LastNum = GetKeysAVar( 'keycatname.'Keyset'.0') do n = 1 to LastNum KeyCat = GetKeysAVar( 'keycatname.'Keyset'.'n) KeyStrings = GetKeysAVar( 'catkeys.'Keyset'.'KeyCat) if KeyStrings = '' then iterate endif -- For all keystrings do w = 1 to words( KeyStrings) KeyString = word( KeyStrings, w) -- Remove KeyString array vars Cmd = GetKeysAVar( 'keydef.'KeyString) if Cmd = '' then Cmd = GetKeysAVar( 'mousedef.'KeyString) DelKeysAVar( 'mousecmd.'Cmd, KeyString) DropKeysAVar( 'mousedef.'KeyString) else DelKeysAVar( 'keycmd.'Cmd, KeyString) DropKeysAVar( 'keydef.'KeyString) endif -- Remove KeyString from category list DelKeysAVar( 'catkeys.'Keyset'.'KeyCat, KeyString) -- Remove var name from array DropKeysAVar( 'keycat.'Keyset'.'KeyString) enddo enddo ; --------------------------------------------------------------------------- ; Ensure that default entry is present in AddKeyDefsList definit 'InitAddKeyDefs' defc InitAddKeyDefs DefaultNameList = lowcase( 'cua') -- only basenames without 'keys' KeyPathList = '\NEPMD\User\Keysets\AddKeyDefs\List' KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected' AddKeyDefsList = QueryConfigKey( KeyPathList) SelectedAddKeyDefs = QueryConfigKey( KeyPathSelected) -- Remove 'keys' from SelectedAddKeyDefs if rightstr( SelectedAddKeyDefs, 4) = 'keys' then parse value SelectedAddKeyDefs with SelectedAddKeyDefs'keys' --dprintf( 'definit: Write to NEPMD.INI: SelectedAddKeyDefs = 'SelectedAddKeyDefs) WriteConfigKey( KeyPathSelected, SelectedAddKeyDefs) endif -- Remove 'keys' from every word of AddKeyDefsList List = '' do w = 1 to words( AddKeyDefsList) Next = word( AddKeyDefsList, w) parse value Next with Next'keys' List = strip( List Next) enddo if AddKeyDefsList <> List then WriteConfigKey( KeyPathList, List) endif -- Maybe add every item of DefaultNameList to AddKeyDefsList List = AddKeyDefsList do w = 1 to words( DefaultNameList) ThisName = word( DefaultNameList, w) if not wordpos( ThisName, List) then List = strip( List ThisName) endif enddo if List <> AddKeyDefsList then WriteConfigKey( KeyPathList, List) endif ; --------------------------------------------------------------------------- ; Also called in NEWMENU.E. defproc GetAddKeyDefs KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected' SelectedAddKeyDefs = QueryConfigKey( KeyPathSelected) return SelectedAddKeyDefs ; --------------------------------------------------------------------------- defc RemoveAddKeyDefs KeyPathList = '\NEPMD\User\Keysets\AddKeyDefs\List' KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected' AddKeyDefs = strip( arg( 1)) AddKeyDefsList = QueryConfigKey( KeyPathList) SelectedAddKeyDefs = QueryConfigKey( KeyPathSelected) if linked( AddKeyDefs'keys') > 0 then 'unlink' AddKeyDefs'keys' endif -- Remove from list wp = wordpos( AddKeyDefs, AddKeyDefsList) if wp > 0 then AddKeyDefsList = SpaceStr( DelWord( AddKeyDefsList, wp, 1)) WriteConfigKey( KeyPathList, AddKeyDefsList) endif -- Remove from macroadd.lst call DeleteFromMacroListFile( AddKeyDefs'keys') if AddKeyDefs = SelectedAddKeyDefs then 'SetAddKeyDefs' -- reset endif ; --------------------------------------------------------------------------- defc SetAddKeyDefs universal activeaccel KeyPathList = '\NEPMD\User\Keysets\AddKeyDefs\List' KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected' AddKeyDefs = strip( arg( 1)) --dprintf( 'SetAddKeyDefs: arg( 1) = 'arg( 1)) AddKeyDefsList = QueryConfigKey( KeyPathList) SelectedAddKeyDefs = QueryConfigKey( KeyPathSelected) DefinedKeysets = GetKeysAVar( 'keysets') -- Save current keyset SavedKeyset = activeaccel getfileid fid CurKeyset = GetKeysAVar( fid'.keyset') CurSubKeysets = GetKeysAVar( 'keyset.'CurKeyset) --dprintf( 'SetAddKeyDefs: CurKeyset = 'CurKeyset', CurSubKeysets = 'CurSubKeysets', activeaccel = 'activeaccel) -- Nothing changed: don't process further if AddKeyDefs = SelectedAddKeyDefs then --dprintf( 'SetAddKeyDefs: AddKeyDefs = 'AddKeyDefs', SelectedAddKeyDefs = 'SelectedAddKeyDefs) return endif -- Delete all key defs first and re-apply all defs of main keyset 'DisableSwitchKeyset' -- Reset list of defined keysets to make SetKeyset2 execute DefKeyset. -- The keyset of the current file is defined and switched immediately. -- For all other files in the ring that is processed on their next -- select event. call SetKeysAVar( 'keysets', '') -- Reset keyset 'std' --dprintf( 'SetAddKeyDefs: Reset keyset std, execute SetKeyset2 std std') 'SetKeyset2 std std' 'EnableSwitchKeyset' -- Change list of subkeysets and define each key def do w = 1 to words( DefinedKeysets) Keyset = word( DefinedKeysets, w) SubKeysets = strip( GetKeysAVar( 'keyset.'Keyset)) --dprintf( 'SetAddKeyDefs: w = 'w', Keyset = 'Keyset', SubKeysets = 'SubKeysets', AddKeyDefs = 'AddKeyDefs', SelectedAddKeyDefs = 'SelectedAddKeyDefs) -- Remove previous add. keydefs name first wp = wordpos( SelectedAddKeyDefs, SubKeysets) if wp > 0 then SubKeysets = SpaceStr( delword( SubKeysets, wp, 1)) endif -- Add add. keydefs name next after 'std' if AddKeyDefs <> '' then wp = wordpos( 'std', SubKeysets) LeftWords = subword( SubKeysets, 1, wp) RightWords = subword( SubKeysets, wp + 1) SubKeysets = SpaceStr( LeftWords AddKeyDefs RightWords) endif if Keyset = SavedKeyset then --dprintf( 'SetAddKeyDefs: 1) execute SetKeyset' Keyset SubKeysets) 'SetKeyset' Keyset SubKeysets -- active, redefine and exec keyset cmds else --dprintf( 'SetAddKeyDefs: 2) call SetKeysAVar( keyset.'Keyset', 'SubKeysets')') call SetKeysAVar( 'keyset.'Keyset, SubKeysets) -- not active, just redefine endif enddo call WriteConfigKey( KeyPathSelected, AddKeyDefs) ; --------------------------------------------------------------------------- ; Open a listbox to select aditional key defs. The additional defs must be ; placed in a separate E file, without using the defkeys statement. When ; simply linking such a file, all special keysets for already loaded files ; would be lost and the keyset EDIT_KEYS is set for all loaded files. ; Therefore EPM will be restarted to make the changes take effect as ; expected. For unlinking a key def file, no restart is required. defc SelectKeyDefs universal activeaccel None = '-none-' parse arg Action Basename Action = upcase( Action) lp = lastpos( '\', strip( Basename)) Basename = substr( Basename, lp + 1) Basename = lowcase( Basename) if Basename = '' then elseif rightstr( Basename, 2) = '.e' then Basename = leftstr( Basename, length( Basename) - 2) elseif rightstr( Basename, 3) = '.ex' then Basename = leftstr( Basename, length( Basename) - 3) endif if rightstr( Basename, 4) <> 'keys' then Basename = Basename'keys' endif -- Read available files from NEPMD.INI KeyPathList = '\NEPMD\User\Keysets\AddKeyDefs\List' KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected' AddKeyDefsList = QueryConfigKey( KeyPathList) -- space-separated list SelectedAddKeyDefs = QueryConfigKey( KeyPathSelected) SelectedAddKeyDefs = lowcase( SelectedAddKeyDefs) if SelectedAddKeyDefs = '' then SelectedAddKeyDefs = None endif if Action = 'ADD' & Basename <> '' then parse value Basename with NextAddKeyDefs'keys' CompleteKeysetNames = 'std' if wordpos( NextAddKeyDefs, CompleteKeysetNames) then Title = 'Adding additional key definitions' Text = 'This file "'NextAddKeyDefs'keys.e" defines the' Text = Text' "'NextAddKeyDefs'" keyset. It''s not a' Text = Text' file with additional keyset definitions, but' Text = Text' defines a basic keyset instead.'\n\n Text = Text'You may want to start with a renamed copy of' Text = Text' cuakeys.e instead.' Style = MB_OKCANCEL+MB_WARNING+MB_DEFBUTTON1+MB_MOVEABLE rcx = WinMessageBox( Title, Text, Style) if rcx = MBID_OK then -- Open this dialog again 'postme SelectKeyDefs' return else -- Cancel return endif endif if not wordpos( NextAddKeyDefs, AddKeyDefsList) then AddKeyDefsList = strip( AddKeyDefsList NextAddKeyDefs) WriteConfigKey( KeyPathList, AddKeyDefsList) endif if not IsExFileInternal( Basename) then Title = 'Adding additional key definitions' Text = 'For the additional key definition macro "'Basename'" no' Text = Text || ' entry in a LST file was found. In order to make' Text = Text || ' the RecompileNew macro aware of that file, it' Text = Text || ' should be added to "macroadd.lst".'\n\n Text = Text || 'Should the entry be added automatically?' Style = MB_YESNO+MB_QUERY+MB_DEFBUTTON1+MB_MOVEABLE rcx = WinMessageBox( Title, Text, Style) if rcx = 6 then -- Yes call AddToMacroListFile( Basename) if rc <> 0 then 'SayError Error: AddToMacroListFile( 'Basename') returned rc = 'rc return endif elseif rcx = 7 then -- No endif endif Title = 'Adding additional key definitions' Text = 'Before the macro file "'Basename'" can be loaded,' Text = Text || ' it has to be compiled.'\n\n Text = Text || 'Should RecompileNew be called now?' Style = MB_YESNO+MB_WARNING+MB_DEFBUTTON1+MB_MOVEABLE rcx = WinMessageBox( Title, Text, Style) if rcx = 6 then -- Yes -- Execute RecompileNew and open this dialog again 'RecompileNew' 'postme SelectKeyDefs' return elseif rcx = 7 then -- No endif endif -- Open listbox Sep = '/' -- Add None first Entries = Sep''None do w = 1 to words( AddKeyDefsList) Next = word( AddKeyDefsList, w)'keys' -- Add Next with 'keys' appended Entries = Entries''Sep''Next enddo DefaultItem = 1 if SelectedAddKeyDefs <> '' then wp = wordpos( SelectedAddKeyDefs, AddKeyDefsList) if wp > 0 then DefaultItem = wp + 1 endif endif DefaultButton = 1 HelpId = 0 Title = 'Select additional key definitions'copies( ' ', 20) Text = 'Current key def additions:' SelectedAddKeyDefs refresh Result = ListBox( Title, Entries, '/~Set/~Add.../~Edit/~Remove/'CANCEL__MSG, -- buttons 0, 0, --5, 5, -- top, left, Min( words( AddKeyDefsList), 15), 50, -- height, width GethWndC( APP_HANDLE) || atoi( DefaultItem) || atoi( DefaultButton) || atoi( HelpId) || Text\0) refresh -- Check result button = asc( leftstr( Result, 1)) EOS = pos( \0, Result, 2) -- CHR(0) signifies End Of String Selected = substr( Result, 2, EOS - 2) if button = 1 then -- Set if Selected = None then 'SetAddKeyDefs' if isadefproc( 'MenuText_keydefs') then MenuText_keydefs() endif Msg = 'No keyset additions file active.' 'SayHint' Msg else -- Check if .E file exists findfile EFile, Selected'.e', 'EPMPATH' if rc then -- Check if .EX file exists findfile EFile, Selected'.ex', 'EPMPATH' if rc then 'SayError Key definition file 'upcase( Selected)'.E or 'upcase( Selected)'.EX not found.' rc = 2 return endif endif parse value lowcase( Selected) with AddKeyDefs'keys' 'SetAddKeyDefs' AddKeyDefs if isadefproc( 'MenuText_keydefs') then MenuText_keydefs() endif Msg = 'Keyset additions file 'upcase( Selected)'.EX activated.' 'SayHint' Msg endif elseif button = 2 then -- Add -- Open fileselector to select an e or ex filename -- Call this Cmd again, but with args to renew the list Text = 'Select a file with additional key definitions' 'FileDlg 'Text', SelectKeyDefs ADD, 'Get_Env('NEPMD_USERDIR')'\macros\?*keys.e' rc = 0 return elseif button = 3 & Selected <> None then -- Edit -- Load file 'EditCreateUserMacro 'Selected'.e' return rc elseif button = 4 & Selected <> None then -- Remove parse value lowcase( Selected) with AddKeyDefs'keys' -- Confirm remove from list if MBID_YES = WinMessageBox( 'Remove keyset addition entry', -- title 'You''re about to remove' Selected 'from the list.' \n || ARE_YOU_SURE__MSG, MB_YESNO + MB_QUERY + MB_DEFBUTTON2 + MB_MOVEABLE) then -- Remove from list 'RemoveAddKeyDefs' AddKeyDefs if isadefproc( 'MenuText_keydefs') then MenuText_keydefs() endif endif -- Call this Cmd again 'SelectKeyDefs' else -- Cancel endif ; --------------------------------------------------------------------------- ; Definitions used for key commands ; --------------------------------------------------------------------------- ; --------------------------------------------------------------------------- ; This command allows to define 2 commands, separated by a bar char. The ; first command applies in stream mode and the second in line mode. defc StreamLine universal stream_mode parse arg cmd1'|'cmd2 cmd1 = strip( cmd1) cmd2 = strip( cmd2) if stream_mode then cmd1 else cmd2 endif ; --------------------------------------------------------------------------- defproc Shifted universal curkey -- Works for WM_CHAR messages: ks = getkeystate( VK_SHIFT) fshifted1 = (ks <> 3 & ks <> 4) -- Works for accelerator keys: parse value curkey with KeyString \1 Cmd fshifted2 = (pos( 's_', KeyString) > 0) return (fshifted1 | fshifted2) ; --------------------------------------------------------------------------- defproc UpDownKey( DownFlag) universal save_cursor_column universal cursoreverywhere universal prevkey NumLines = arg( 2) if NumLines = '' then NumLines = 1 elseif not IsNum( NumLines) then NumLines = 1 endif parse value prevkey with PrevKeyString \1 . fupdown = (wordpos( PrevKeyString, 'up down s_up s_down') > 0) if not cursoreverywhere then if not fupdown then save_cursor_column = .col endif endif if DownFlag then do n = 1 to NumLines down enddo else do n = 1 to NumLines up enddo endif if .line & not cursoreverywhere then l = length( textline( .line)) if fupdown & l >= save_cursor_column then .col = save_cursor_column elseif fupdown | l < .col then endline endif endif ; --------------------------------------------------------------------------- defproc ScrollUpDownKey( DownFlag) NumLines = arg( 2) if NumLines = '' then NumLines = 1 elseif not IsNum( NumLines) then NumLines = 1 endif if DownFlag then do n = 1 to NumLines oldcursory = .cursory if .line - .cursory + .windowheight < .last then .cursory = .windowheight down .cursory = oldcursory elseif .line < .last then down endif enddo else oldcursory = .cursory do n = 1 to NumLines if .line - .cursory > -1 then .cursory = 1 up .cursory = oldcursory elseif .line then up endif enddo endif ; --------------------------------------------------------------------------- defproc Extend_Mark( startline, startcol, forward) universal cursoreverywhere universal curkey KeyPath = '\NEPMD\User\Mark\ShiftMarkAlwaysExtends' fAlwaysExtend = (QueryConfigKey( KeyPath) = 1) getfileid curfileid getmarkg firstline, lastline, firstcol, lastcol, markfileid parse value curkey with CurKeyString \1 . fs_up = (CurKeyString = 's_up') fs_down = (CurKeyString = 's_down') funmark = 1 if markfileid <> curfileid then funmark = 1 elseif QueryUnmarkOnAnyKey() then -- keep mark and extend it (any unshifted key caused unmark before) funmark = 0 elseif fAlwaysExtend then -- keep mark and extend it funmark = 0 -- The following was added for the feature "Shift-Mark extends at mark -- boundaries only" (== "Shift-mark extends always" = deactivated): elseif not cursoreverywhere then if startline = firstline & startcol = firstcol then funmark = 0 elseif startline = lastline & startcol = lastcol then funmark = 0 endif elseif cursoreverywhere then l = length( textline( startline)) if startline = firstline & startcol = firstcol then funmark = 0 elseif startline = firstline & startcol > firstcol & startcol > l + 1 then funmark = 0 elseif startline = firstline + 1 & firstcol = 0 then -- apparently never reached funmark = 0 elseif startline = lastline & startcol = lastcol then funmark = 0 elseif startline = lastline & startcol > lastcol & startcol > l + 1 then funmark = 0 elseif startline = lastline - 1 & lastcol = 0 then funmark = 0 endif endif if funmark then unmark endif if not marktype() then call pSet_Mark( startline, .line, startcol, .col, 'CHARG', curfileid) return endif if (fs_up & .line = firstline - 1) | (fs_down & .line = firstline + 1) then if length( textline( firstline)) < .col then firstcol = .col endif endif if startline > firstline | ((startline = firstline) & (startcol > firstcol)) then -- at end of mark if not forward then if firstline = .line & firstcol = .col then unmark return endif endif call pSet_Mark( firstline, .line, firstcol, .col, 'CHARG', curfileid) else -- at beginning of mark if forward then if lastline = .line & lastcol = .col - 1 then unmark return endif endif call pSet_Mark( lastline, .line, lastcol, .col, 'CHARG', curfileid) endif ; --------------------------------------------------------------------------- ; c_home, c_end, c_left & c_right do different things if the shift key is depressed. ; The logic is extracted here mainly due to the complexity of the COMPILE IF's defproc Begin_Shift( var startline, var startcol, var shift_flag) ; unused /* universal cua_marking_switch shift_flag = Shifted() if shift_flag or not cua_marking_switch then startline = .line; startcol = .col else unmark endif */ ; --------------------------------------------------------------------------- defproc End_Shift( startline, startcol, shift_flag, forward_flag) ; unused /* ; Make this work regardless of which marking mode is active: compile if 0 -- WANT_CUA_MARKING = 'SWITCH' universal cua_marking_switch if shift_flag & cua_marking_switch then compile else if shift_flag then compile endif call Extend_Mark( startline, startcol, forward_flag) endif */ ; --------------------------------------------------------------------------- ; For compatibility. defproc Process_Mark_Like_Cua fMarkDeleted = ReplaceMark() if fMarkDeleted then rcx = 1 else rcx = '' endif return rcx ; --------------------------------------------------------------------------- defc SwitchMarkingMode universal menuloaded universal cua_marking_switch NewMarkingMode = upcase( strip( leftstr( arg( 1), 1))) CurrentMarkingMode = QueryMarkingMode() if NewMarkingMode <> CurrentMarkingMode then if NewMarkingMode = 'A' then 'ApplyMarkingBitStr' GetDefaultMarkingBitStr( 'ADV') elseif NewMarkingMode = 'C' then 'ApplyMarkingBitStr' GetDefaultMarkingBitStr( 'CUA') endif -- For compatibility if NewMarkingMode = 'C' then cua_marking_switch = 1 else cua_marking_switch = 0 endif -- Refresh display 'RefreshInfoLine MARKINGMODE' -- Refresh menus if menuloaded then -- Set menu attributes and text for the case MIA_NODISMISS attribute is on if GetMenuAVar( 'mid_mark') then 'menuinit_mark' endif -- The menu from where the action stems can't be queried with activemenu. -- After opening the 'prefspopup' menu, the universal is switched back to -- 'default'. if GetMenuAVar( 'mid_basicconfig') then 'menuinit_basicconfig' 'menuinit_markingsettings' endif endif endif ; --------------------------------------------------------------------------- ; Returns 'A' | 'C' | '' defproc QueryMarkingMode CurrentMarkingMode = '' CurrentMarkingBitStr = GetCurrentMarkingBitStr() -- E precision is max. 9 digits, DigitComp is required fAdvancedMarking = not DigitComp( CurrentMarkingBitStr, GetDefaultMarkingBitStr( 'ADV')) fCuaMarking = not DigitComp( CurrentMarkingBitStr, GetDefaultMarkingBitStr( 'CUA')) if fAdvancedMarking then CurrentMarkingMode = 'A' elseif fCuaMarking then CurrentMarkingMode = 'C' endif return CurrentMarkingMode ; --------------------------------------------------------------------------- defproc GetCurrentMarkingBitStr KeyPath = '\NEPMD\User\Mark\DefaultPaste' DefaultPaste = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\Mark\ShiftMarkAlwaysExtends' fShiftMarkExtends = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\Mark\LineInsert' InsertMarkedLines = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\Mark\ReplaceMark' fReplaceMark = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\Mark\DirectMarkActions' fDirectMarkActions = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\Mark\UnmarkOnAnyKey' fUnmarkOnAnyKey = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\Mark\UnmarkAfterMove' fUnmarkAfterMove = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\Mark\DefaultMouseMark' DefaultMouseMark = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\Mark\GoToMousePos' fGoToMouseMark = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\MB1DoubleClick\Mark' DoubleClickMarks = QueryConfigKey( KeyPath) f4os2MouseMark = Query4os2MouseMark() KeyPath = '\NEPMD\User\MB1DoubleClick\UnmarkOnSpace' fDoubleClickUnmarks = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\SearchDialog\SearchMarkIfMarked' fSearchMarkIfMarked = QueryConfigKey( KeyPath) KeyPath = '\NEPMD\User\SearchDialog\SearchMarkedWords' fSearchMarkedWords = QueryConfigKey( KeyPath) CurrentMarkingBitStr = '' || DefaultPaste || fShiftMarkExtends || InsertMarkedLines || fReplaceMark || fDirectMarkActions || fUnmarkOnAnyKey || fUnmarkAfterMove || DefaultMouseMark || fGoToMouseMark || DoubleClickMarks || f4os2MouseMark || fDoubleClickUnmarks || fSearchMarkIfMarked || fSearchMarkedWords return CurrentMarkingBitStr ; -------------------------------------------------------------------------------------- Preferences ------------------ const compile if not defined( PRESET_BITSTR_USER_CUA) PRESET_BITSTR_USER_CUA = 011100000 compile endif compile if not defined( PRESET_BITSTR_PROG_CUA) PRESET_BITSTR_PROG_CUA = 101111111 compile endif compile if not defined( PRESET_BITSTR_PROG_STD) PRESET_BITSTR_PROG_STD = 100011111 compile endif compile if not defined( MARKING_BITSTR_ADV) MARKING_BITSTR_ADV = '???01 0? ?0?? 1 ??' compile endif compile if not defined( MARKING_BITSTR_CUA) MARKING_BITSTR_CUA = 'C0A10 10 C1W? 0 ??' compile endif ; --------------------------------------------------------------------------- defproc GetDefaultMarkingBitStr MarkingType = upcase( arg( 1)) DefaultMarkingBitStr = '' if MarkingType = 'ADV' then DefaultMarkingBitStr = MARKING_BITSTR_ADV elseif MarkingType = 'CUA' then DefaultMarkingBitStr = MARKING_BITSTR_CUA endif return DefaultMarkingBitStr ; --------------------------------------------------------------------------- defc ApplyMarkingBitStr do once = 1 to 1 -- Query CurrentMarkingBitStr CurrentMarkingBitStr = SpaceStr( arg( 1), 0) -- Check CurrentMarkingBitStr if length( CurrentMarkingBitStr) <> length( SpaceStr( GetDefaultMarkingBitStr( 'ADV'), 0)) then leave endif -- Parse CurrentMarkingBitStr DefaultPaste = substr( CurrentMarkingBitStr, 1, 1) fShiftMarkExtends = substr( CurrentMarkingBitStr, 2, 1) InsertMarkedLines = substr( CurrentMarkingBitStr, 3, 1) fReplaceMark = substr( CurrentMarkingBitStr, 4, 1) fDirectMarkActions = substr( CurrentMarkingBitStr, 5, 1) fUnmarkOnAnyKey = substr( CurrentMarkingBitStr, 6, 1) fUnmarkAfterMove = substr( CurrentMarkingBitStr, 7, 1) DefaultMouseMark = substr( CurrentMarkingBitStr, 8, 1) fGoToMouseMark = substr( CurrentMarkingBitStr, 9, 1) DoubleClickMarks = substr( CurrentMarkingBitStr, 10, 1) f4os2MouseMark = substr( CurrentMarkingBitStr, 11, 1) fDoubleClickUnmarks = substr( CurrentMarkingBitStr, 12, 1) fSearchMarkIfMarked = substr( CurrentMarkingBitStr, 13, 1) fSearchMarkedWords = substr( CurrentMarkingBitStr, 14, 1) -- Apply bits KeyPath = '\NEPMD\User\Mark\DefaultPaste' if DefaultPaste = '?' then -- nop elseif DefaultPaste <> QueryConfigKey( KeyPath) then WriteConfigKey( KeyPath, DefaultPaste) RefreshMenuAccelString( 'paste') RefreshMenuAccelString( 'pastelines') RefreshMenuAccelString( 'pasteblock') endif KeyPath = '\NEPMD\User\Mark\ShiftMarkAlwaysExtends' if fShiftMarkExtends = '?' then -- nop elseif fShiftMarkExtends <> QueryConfigKey( KeyPath) then 'toggle_shift_mark_extends' endif KeyPath = '\NEPMD\User\Mark\LineInsert' if InsertMarkedLines = '?' then -- nop elseif InsertMarkedLines <> QueryConfigKey( KeyPath) then 'toggle_lineinsert' endif if fReplaceMark = '?' then -- nop else 'SwitchReplaceMark 'fReplaceMark endif if fDirectMarkActions = '?' then -- nop else 'SwitchDirectMarkActions 'fDirectMarkActions endif if fUnmarkOnAnyKey = '?' then -- nop else 'SwitchUnmarkOnAnyKey 'fUnmarkOnAnyKey endif KeyPath = '\NEPMD\User\Mark\UnmarkAfterMove' if fUnmarkAfterMove = '?' then -- nop elseif fUnmarkAfterMove <> QueryConfigKey( KeyPath) then 'toggle_unmark_after_move' endif if DefaultMouseMark = '?' then -- nop else 'SwitchDefaultMouseMark 'DefaultMouseMark endif if fGoToMouseMark = '?' then -- nop else 'SwitchGoToMouseMarkPos 'fGoToMouseMark endif if DoubleClickMarks = '?' then -- nop else 'SwitchDoubleClickMarks 'DoubleClickMarks endif if f4os2MouseMark = '?' then -- nop elseif f4os2MouseMark <> Query4os2MouseMark() then 'Toggle4os2MouseMark' endif if fDoubleClickUnmarks = '?' then -- nop else 'SwitchDoubleClickUnmarks 'fDoubleClickUnmarks endif KeyPath = '\NEPMD\User\SearchDialog\SearchMarkIfMarked' if fSearchMarkIfMarked = '?' then -- nop elseif fSearchMarkIfMarked <> QueryConfigKey( KeyPath) then 'toggle_SearchMarkIfMarked' endif KeyPath = '\NEPMD\User\SearchDialog\SearchMarkedWords' if fSearchMarkedWords = '?' then -- nop elseif fSearchMarkedWords <> QueryConfigKey( KeyPath) then 'toggle_SearchMarkedWords' endif if GetMenuAVar( 'mid_markingsettings') then 'menuinit_markingsettings' endif call MH_Set_Mouse() 'ReloadKeyset' -- -> SetKeyset2 -> SwitchKeyset -> RefreshMenu - required for hint text -- E precision is max. 9 digits, DigitComp is required if GetMenuAVar( 'mid_advancedmarking') then SetMenuAttribute( 'advancedmarking', MIA_CHECKED, DigitComp( CurrentMarkingBitStr, GetDefaultMarkingBitStr( 'ADV'))) endif if GetMenuAVar( 'mid_cuamarking') then SetMenuAttribute( 'cuamarking', MIA_CHECKED, DigitComp( CurrentMarkingBitStr, GetDefaultMarkingBitStr( 'CUA'))) endif enddo ; --------------------------------------------------------------------------- defproc ReplaceMark do once = 1 to 1 fMarkDeleted = 0 -- Config key KeyPath = '\NEPMD\User\Mark\ReplaceMark' fReplaceMark = QueryConfigKey( KeyPath) if not fReplaceMark then leave endif -- File not marked if not FileIsMarked() then if marktype() then -- Unmark mark in other file unmark endif leave endif getmark firstline, lastline, firstcol, lastcol, markfileid -- Delete mark buffer, see clipbrd.e for details 'Copy2DMBuff' -- Place cursor and delete mark firstline .col = firstcol call NextCmdAltersText() call pDelete_Mark() -- Remove content in EPM shared text buffer 'ClearSharBuff' fMarkDeleted = 1 enddo return fMarkDeleted ; --------------------------------------------------------------------------- defc SwitchReplaceMark do once = 1 to 1 KeyPath = '\NEPMD\User\Mark\ReplaceMark' NewState = upcase( strip( leftstr( arg( 1), 1))) if NewState = 'T' then fReplaceMark = QueryConfigKey( KeyPath) NewState = not fReplaceMark elseif NewState = 0 then -- nop elseif NewState = 1 then -- nop else 'SayError SwitchReplaceMark: Undefined arg 'arg( 1)' specified.' leave endif WriteConfigKey( KeyPath, NewState) if GetMenuAVar( 'mid_replacemark') then SetMenuAttribute( 'replacemark', MIA_CHECKED, not NewState) endif enddo ; --------------------------------------------------------------------------- defproc QueryReplaceMark KeyPath = '\NEPMD\User\Mark\ReplaceMark' fReplaceMark = QueryConfigKey( KeyPath) return fReplaceMark ; --------------------------------------------------------------------------- defc SwitchDirectMarkActions do once = 1 to 1 KeyPath = '\NEPMD\User\Mark\DirectMarkActions' NewState = upcase( strip( leftstr( arg( 1), 1))) if NewState = 'T' then fDirectMarkActions = QueryConfigKey( KeyPath) NewState = not fDirectMarkActions elseif NewState = 0 then -- nop elseif NewState = 1 then -- nop else 'SayError SwitchDirectMarkActions: Undefined arg 'arg( 1)' specified.' leave endif WriteConfigKey( KeyPath, NewState) if GetMenuAVar( 'mid_directmarkactions') then SetMenuAttribute( 'directmarkactions', MIA_CHECKED, not NewState) endif if NewState = 1 then -- Uncheck 'Unmark on any key' 'SwitchUnmarkOnAnyKey 0' endif -- Direct mark menu items (Copy, Move, Overlay, Adjust) are added/removed 'RefreshMenu' enddo ; --------------------------------------------------------------------------- defproc QueryDirectMarkActions KeyPath = '\NEPMD\User\Mark\DirectMarkActions' fDirectMarkActions = QueryConfigKey( KeyPath) return fDirectMarkActions ; --------------------------------------------------------------------------- defproc UnmarkOnAnyKey KeyPath = '\NEPMD\User\Mark\UnmarkOnAnyKey' fUnmarkOnAnyKey = QueryConfigKey( KeyPath) if fUnmarkOnAnyKey then unmark endif return fUnmarkOnAnyKey ; --------------------------------------------------------------------------- defproc QueryUnmarkOnAnyKey KeyPath = '\NEPMD\User\Mark\UnmarkOnAnyKey' fUnmarkOnAnyKey = QueryConfigKey( KeyPath) return fUnmarkOnAnyKey ; --------------------------------------------------------------------------- defc SwitchUnmarkOnAnyKey do once = 1 to 1 KeyPath = '\NEPMD\User\Mark\UnmarkOnAnyKey' NewState = upcase( strip( leftstr( arg( 1), 1))) if NewState = 'T' then fUnmarkOnAnyKey = QueryConfigKey( KeyPath) NewState = not fUnmarkOnAnyKey elseif NewState = 0 then -- nop elseif NewState = 1 then -- nop else 'SayError SwitchUnmarkOnAnyKey: Undefined arg 'arg( 1)' specified.' leave endif WriteConfigKey( KeyPath, NewState) if GetMenuAVar( 'mid_unmarkonanykey') then SetMenuAttribute( 'unmarkonanykey', MIA_CHECKED, not NewState) endif if NewState = 1 then -- Switch 'Direct mark actions' off 'SwitchDirectMarkActions 0' -- Switch 'Sh-mark always extends' off 'SwitchShiftMarkAlwaysExtends 0' endif enddo ; --------------------------------------------------------------------------- defc SwitchShiftMarkAlwaysExtends do once = 1 to 1 KeyPath = '\NEPMD\User\MarkShiftMarkExtends' NewState = upcase( strip( leftstr( arg( 1), 1))) if NewState = 'T' then fShiftMarkAlwaysExtends = QueryConfigKey( KeyPath) NewState = not fShiftMarkAlwaysExtends elseif NewState = 0 then -- nop elseif NewState = 1 then -- nop else 'SayError SwitchShiftMarkAlwaysExtends: Undefined arg 'arg( 1)' specified.' leave endif WriteConfigKey( KeyPath, NewState) if GetMenuAVar( 'mid_shiftmarkextends') then SetMenuAttribute( 'shiftmarkextends', MIA_CHECKED, not NewState) endif if NewState = 1 then -- Switch 'Unmark on any key' off 'SwitchUnmarkOnAnyKey 0' endif enddo ; --------------------------------------------------------------------------- ; Moves the cursor to the pos. of the pointer. This is used at the end of ; mouse marking. The cursor pos. must be limitted to text pos. or just after ; the last column plus line end. defproc GoToMouseMarkPos do once = 1 to 1 -- This is not active for advanced marking KeyPath = '\NEPMD\User\Mark\GoToMousePos' fGoToMousePos = QueryConfigKey( KeyPath) if not fGoToMousePos then leave endif -- Save horiz. scrolled pels oldsx = .scrollx -- Query pointer pos. call GetPointerPos( MouseLine, MouseCol) CursorLine = MouseLine CursorCol = MouseCol -- Limit CursorLine if CursorLine < 1 then KeyPath = '\NEPMD\User\Mark\LineInsert' LineInsert = QueryConfigKey( KeyPath) if LineInsert = 'A' then -- above current line MinCursorLine = 1 else MinCursorLine = 0 endif CursorLine = MinCursorLine endif if CursorLine > .last then CursorLine = .last endif -- Limit CursorCol -- If mouse button was released after line end, limit cursor pos. -- to after line end, like the mark. CursorLineLen = length( textline( CursorLine)) if CursorCol > CursorLineLen + 2 then CursorCol = CursorLineLen + 2 endif -- Set cursor pos. .lineg = CursorLine -- without scrolling .col = CursorCol -- Restore horiz. scrolled pels .scrollx = oldsx enddo return ; --------------------------------------------------------------------------- defc SwitchGoToMouseMarkPos do once = 1 to 1 KeyPath = '\NEPMD\User\Mark\GoToMousePos' NewState = upcase( strip( leftstr( arg( 1), 1))) if NewState = 'T' then fGoToMousePos = QueryConfigKey( KeyPath) NewState = not fGoToMousePos elseif NewState = 0 then -- nop elseif NewState = 1 then -- nop else 'SayError SwitchGoToMouseMarkPos: Undefined arg 'arg( 1)' specified.' leave endif WriteConfigKey( KeyPath, NewState) if GetMenuAVar( 'mid_gotomousemark') then SetMenuAttribute( 'gotomousemark', MIA_CHECKED, not NewState) SetMenuAttribute( 'gotomousemark2', MIA_CHECKED, not NewState) endif enddo ; --------------------------------------------------------------------------- defproc QueryGoToMouseMarkPos KeyPath = '\NEPMD\User\Mark\GoToMousePos' fGoToMouseMarkPos = QueryConfigKey( KeyPath) return fGoToMouseMarkPos ; --------------------------------------------------------------------------- defc SwitchDoubleClickUnmarks do once = 1 to 1 KeyPath = '\NEPMD\User\MB1DoubleClick\UnmarkOnSpace' NewState = upcase( strip( leftstr( arg( 1), 1))) if NewState = 'T' then fDoubleClickUnmarks = QueryConfigKey( KeyPath) NewState = not fDoubleClickUnmarks elseif NewState = 0 then -- nop elseif NewState = 1 then -- nop else 'SayError SwitchDoubleClickUnmarks: Undefined arg 'arg( 1)' specified.' leave endif WriteConfigKey( KeyPath, NewState) if GetMenuAVar( 'mid_doubleclickunmarks') then SetMenuAttribute( 'doubleclickunmarks', MIA_CHECKED, not NewState) SetMenuAttribute( 'doubleclickunmarks2', MIA_CHECKED, not NewState) endif enddo ; --------------------------------------------------------------------------- defproc QueryDoubleClickUnmarks KeyPath = '\NEPMD\User\MB1DoubleClick\UnmarkOnSpace' fDoubleClickUnmarks = QueryConfigKey( KeyPath) return fDoubleClickUnmarks ; --------------------------------------------------------------------------- defc SwitchDoubleClickMarks do once = 1 to 1 KeyPath = '\NEPMD\User\MB1DoubleClick\Mark' NewState = upcase( strip( leftstr( arg( 1), 1))) if NewState = 'T' then CurState = upcase( strip( leftstr( QueryConfigKey( KeyPath), 1))) if CurState = 'W' then NewState = 'I' elseif CurState = 'I' then NewState = 0 else NewState = 'W' endif endif if NewState = 0 then Val = 'doesn''t mark' elseif NewState = 'W' then Val = 'marks word' elseif NewState = 'I' then Val = 'marks identifier' else 'SayError SwitchDoubleClickMarks: Undefined arg 'arg( 1)' specified.' leave endif WriteConfigKey( KeyPath, NewState) if GetMenuAVar( 'mid_doubleclickmarks') then SetMenuVarText( 'doubleclickmarks', Val) SetMenuVarText( 'doubleclickmarks2', Val) endif enddo ; --------------------------------------------------------------------------- defproc QueryDoubleClickMarks KeyPath = '\NEPMD\User\MB1DoubleClick\Mark' DoubleClickMarks = QueryConfigKey( KeyPath) return DoubleClickMarks ; --------------------------------------------------------------------------- defproc QueryDoubleClickOpensUrl KeyPath = '\NEPMD\User\MB1DoubleClick\OpenUrl' DoubleClickOpensUrl = QueryConfigKey( KeyPath) return DoubleClickOpensUrl ; --------------------------------------------------------------------------- defproc QueryDoubleClickDirOpensFile KeyPath = '\NEPMD\User\MB1DoubleClick\DirOpenFile' DoubleClickDirOpensFile = QueryConfigKey( KeyPath) return DoubleClickDirOpensFile ; --------------------------------------------------------------------------- defc SwitchDefaultMouseMark do once = 1 to 1 KeyPath = '\NEPMD\User\Mark\DefaultMouseMark' NewState = upcase( strip( leftstr( arg( 1), 1))) if NewState = 'T' then DefaultMouseMark = QueryConfigKey( KeyPath) if DefaultMouseMark = 'B' then -- toggle DefaultMouseMark = 'C' new = 'char' else DefaultMouseMark = 'B' new = 'block' endif elseif NewState = 'B' then DefaultMouseMark = 'B' new = 'block' elseif NewState = 'C' then DefaultMouseMark = 'C' new = 'char' else 'SayError SwitchReplaceMark: Undefined arg 'arg( 1)' specified.' leave endif WriteConfigKey( KeyPath, DefaultMouseMark) if GetMenuAVar( 'mid_defaultmousemark') then SetMenuVarText( 'defaultmousemark', new) SetMenuVarText( 'defaultmousemark2', new) endif call MH_Set_Mouse() enddo ; --------------------------------------------------------------------------- defproc DoubleClickMarksWord do once = 1 to 1 if not .line then leave endif -- Config key KeyPath = '\NEPMD\User\MB1DoubleClick\MarkWord' fMarkWord = QueryConfigKey( KeyPath) if not fMarkWord then leave endif fMouseAfterLine = 0 -- Won't position cursor after line end in stream mode 'MH_GoToLastClick' MouseCol = .col endline if .col <= MouseCol then fMouseAfterLine = 1 endif if fMouseAfterLine then -- Mark only line end endline getfileid fid call pSet_Mark( .line, .line, .col, .col + 1, 'CHAR', fid) else --call pMark_Word() -- pMark_Word doesn't include white space; the following does: call pBegin_Word() KeyPath = '\NEPMD\User\Mark\WordMarkType' WordMarkType = QueryConfigKey( KeyPath) if WordMarkType = 'B' then markblock else markchar endif startcol = .col tabword .col = .col - 1 if WordMarkType = 'B' then markblock else markchar endif .col = startcol endif -- Copy mark to shared text buffer 'Copy2SharBuff' 'MatchFindOnMove' enddo return ; --------------------------------------------------------------------------- defc ConfigureNewlineCmd universal newline_enter universal default_stream_mode -- Menu item name miname = arg( 1) if miname = '' then miname = 'newline' endif key = lowcase( miname) if newline_enter = 'enter' then key = ChangeStr( 'newline', key, 'enter') endif KeyPath = '\NEPMD\User\SpecialKeys' if default_stream_mode then KeyPath = KeyPath'\Stream' else KeyPath = KeyPath'\Line' endif KeyPath = KeyPath'\'key next = QueryConfigKey( KeyPath) if next = '' then next = 'Split,KeepIndent' endif parse value next with SplitCfg','ColCfg','fCmd','Cmd Title = 'Configure command for 'key Text = 'Enter an E command:' Text = Text''copies( ' ', Max( 100 - length(Text), 0)) Buttons = '/~Set/~Reset/'CANCEL__MSG Entry = Cmd if rightstr( Entry, 2) <> ':\' then Entry = strip( Entry, 'T', '\') endif parse value EntryBox( Title, Buttons, Entry, '', '', atoi( 1) || atoi( 0) || atol( 0) || Text) with button 2 Cmd \0 Cmd = strip( Cmd) if button = \1 then -- Set -- nop elseif button = \2 then -- Reset Cmd = '' else -- Cancel return endif fCmd = 1 Val = SplitCfg','ColCfg','fCmd','Cmd WriteConfigKey( KeyPath, Val) MenuText_newlinesplit( key) ; --------------------------------------------------------------------------- defproc GetExpandKeys KeyPath = '\NEPMD\User\SpecialKeys\ExpandKeys' ExpandKeys = QueryConfigKey( KeyPath, 'space newline') return ExpandKeys ; --------------------------------------------------------------------------- defproc SetExpandKeys KeyPath = '\NEPMD\User\SpecialKeys\ExpandKeys' NewExpandKeys = arg( 1) if NewExpandKeys <> '' then call WriteConfigKey( KeyPath, NewExpandKeys) else call DeleteConfigKey( KeyPath) endif if isadefproc( 'MenuText_syntaxexpansionkeys') then MenuText_syntaxexpansionkeys() endif ; --------------------------------------------------------------------------- defc SelectExpandKeys universal nodismiss CurExpandKeys = GetExpandKeys() Title = 'Configure syntax expansion keys' Text = 'Specify e.g. "space newline" or "c_space c_newline":' Text = Text''copies( ' ', Max( 100 - length( Text), 0)) Buttons = '/~Set/~Reset/'CANCEL__MSG Entry = CurExpandKeys parse value EntryBox( Title, Buttons, Entry, '', '', atoi( 1) || atoi( 0) || atol( 0) || Text) with button 2 NewExpandKeys \0 NewExpandKeys = strip( NewExpandKeys) if button = \1 then -- Set -- nop elseif button = \2 then -- Reset NewExpandKeys = '' else -- Cancel return endif if NewExpandKeys <> CurExpandKeys then call SetExpandKeys( NewExpandKeys) else 'SayError Syntax expansion keys not changed.' endif ; --------------------------------------------------------------------------- defproc ExpandSyntax() universal curkey --dprintf( 'ExpandSyntax: curkey = 'curkey) KeyPath = '\NEPMD\User\SpecialKeys\ExpandKeys' CurExpandKeys = QueryConfigKey( KeyPath, 'space newline') fExpanded = 0 parse value curkey with KeyString \1 Cmd wp = wordpos( KeyString, CurExpandKeys) if wp = 1 then fExpanded = ExpandFirstSecond( 0) elseif wp = 2 then fExpanded = ExpandFirstSecond( 1) endif return fExpanded ; --------------------------------------------------------------------------- ; Process syntax expansion. defproc ExpandFirstSecond( fSecond) universal expand_on fExpanded = 0 ExpandMode = GetFileAVar( 'expandmode') --dprintf( 'ExpandFirstSecond( 'fSecond'): expand_on = 'expand_on', ExpandMode = 'ExpandMode) do once = 1 to 1 if not expand_on then leave endif if ExpandMode = '' then leave endif if wordpos( upcase( ExpandMode), '0 OFF') > 0 then leave endif if fSecond then ExpandCmd = ExpandMode'SecondExpansion' else ExpandCmd = ExpandMode'FirstExpansion' endif if isadefc( ExpandCmd) then ExpandCmd fExpanded = (rc == 0) endif enddo return fExpanded ; --------------------------------------------------------------------------- ; rc = 0 after expansion, otherwise rc = 1 defc ForceExpansion universal expand_on fExpanded = 0 ExpandMode = GetFileAVar( 'expandmode') do once = 1 to 1 if not expand_on then leave endif if ExpandMode = '' then leave endif if wordpos( upcase( ExpandMode), '0 OFF') > 0 then leave endif rc = -1 if isadefc( ExpandMode'FirstExpansion') then ExpandMode'FirstExpansion force' endif if rc <> 0 then if isadefc( ExpandMode'SecondExpansion') then ExpandMode'SecondExpansion force' endif endif fExpanded = (rc == 0) enddo rc = (fExpanded == 0) -- rc = 1 means: not expanded ; --------------------------------------------------------------------------- defc HeaderWidthDlg universal header_width KeyPath = '\NEPMD\User\Format\HeaderWidth' NewHeaderWidth = arg( 1) if NewHeaderWidth <> '' then if IsUInt( NewHeaderWidth) then call WriteConfigKey( KeyPath, NewHeaderWidth) header_width = NewHeaderWidth return elseif upcase( NewHeaderWidth) = 'RESET' then call DeleteConfigKey( KeyPath) header_width = QueryConfigKey( KeyPath) return endif endif Title = 'Set header width' Text = 'Number of columns used for boxes, center, wrap and syntax expansion:' Text = Text''copies( ' ', Max( 100 - length( Text), 0)) Buttons = '/~Set/~Reset/'CANCEL__MSG Entry = header_width parse value EntryBox( Title, Buttons, Entry, 0, 240, atoi( 1) || atoi( 0) || atol( 0) || Text) with Button 2 NewHeaderWidth \0 NewHeaderWidth = strip( NewHeaderWidth) if Button = \1 then -- Set -- nop elseif Button = \2 then -- Reset NewHeaderWidth = '' else -- Cancel return endif if NewHeaderWidth <> header_width & IsUInt( NewHeaderWidth) then 'HeaderWidthDlg' NewHeaderWidth else 'HeaderWidthDlg RESET' endif ; --------------------------------------------------------------------------- ; Syntax: ; FoundLineNum = ; WordWithIndentExists( Wrd, IndentLen [, Case [, MaxLines]]) ; Case = 0 means caseless, the default value is 1 (case-sensitive). ; Finds e.g. 'endddo' in next lines with the same indent. Stops at max. ; processed lines. Stops if indent is lower. Recognizes comments and ; literals. Handles tabs correctly. ; This is used by syntax expansion procs. ; IndentLen is the length of the blank area after expanding tabs. ; Return the found line number. If Wrd is not found, 0 is returned. defproc WordWithIndentExists( Wrd, IndentLen) Case = arg( 3) if Case <> 0 then Case = 1 -- case-sensitive endif MaxLines = arg( 4) if MaxLines = '' then MaxLines = 100 endif CurMode = GetMode() -- Search in comments if the Wrd to search is a comment char itself fSearchInComments = 0 CommentChars = QueryModeKey( CurMode, 'LineComment') CommentChars = CommentChars' 'QueryModeKey( CurMode, 'MultiLineCommentStart') CommentChars = CommentChars' 'QueryModeKey( CurMode, 'MultiLineCommentEnd') if wordpos( Wrd, CommentChars) then fSearchInComments = 1 endif FoundLineNum = 0 --dprintf( 'KeyWord = 'KeyWord', IndentLen = 'IndentLen' ------') l = .line do forever l = l + 1 if l > .last then leave endif if l - .line > MaxLines then leave endif getline NextLineStr, l NextFirstWrd = word( translate( NextLineStr, ' ', \9), 1) UpNextFirstWrd = upcase( NextFirstWrd) pNextFirstWrd = pos( UpNextFirstWrd, upcase( NextLineStr)) NextSpc = leftstr( NextLineStr, Max( 0, pNextFirstWrd - 1)) -- Indent of line with tabs and spaces NextExpSpc = TabExpandStr( NextSpc, TabWidth, junk) NextExpSpcLen = length( NextExpSpc) --InComment = InsideCommentLiteral( GetMode(), l, pNextFirstWrd) --dprintf( rightstr( l, 2)': NextFirstWrd = 'NextFirstWrd', pNextFirstWrd = 'pNextFirstWrd', NextExpSpcLen = 'NextExpSpcLen', InComment = 'InComment', fSearchInComments = 'fSearchInComments) if NextFirstWrd = '' then iterate elseif not fSearchInComments & InsideCommentLiteral( CurMode, l, pNextFirstWrd) then iterate elseif NextExpSpcLen < IndentLen then leave elseif NextExpSpcLen > IndentLen then iterate else if Case = 1 then if NextFirstWrd = Wrd then FoundLineNum = l leave endif else if UpNextFirstWrd = upcase( Wrd) then FoundLineNum = l leave endif endif endif enddo return FoundLineNum ; --------------------------------------------------------------------------- defc Space call NextCmdAltersText( 'S') call Process_Key( ' ') ; --------------------------------------------------------------------------- defc AdjustMark call NextCmdAltersText() call pCommon_Adjust_Overlay( 'A') ; --------------------------------------------------------------------------- defc OverlayMark call NextCmdAltersText() if marktype() then call pCommon_Adjust_Overlay( 'O') else -- If no mark, look into shared text buffer 'GetSharBuff O' endif ; --------------------------------------------------------------------------- defc CopyMark universal stream_mode -- This creates only a new state if required, not when just the mark -- has changed call NextCmdAltersText() -- Ensure that cursor is on a line > 0 if .line = 0 then -- Not for insert below KeyPath = '\NEPMD\User\Mark\LineInsert' LineInsert = QueryConfigKey( KeyPath) if LineInsert = 'A' then if .last = 0 then insertline '', 1 endif down endif -- Not for line mode if stream_mode then .col = 1 endif endif if marktype() then -- Ensure that pos and mark before the action is saved getfileid fid StateRange = QueryUndoState() parse value StateRange with OldestState NewestState -- Eventually override the previously saved pos and mark call SetUndoStatePos( fid, NewestState) call pCopy_Mark() else -- If no mark, look into shared text buffer 'GetSharBuff' endif ; --------------------------------------------------------------------------- defc MoveMark universal stream_mode -- This creates only a new state if required, not when just the mark -- has changed call NextCmdAltersText() -- Ensure that cursor is on a line > 0 if .line = 0 then -- Not for insert below KeyPath = '\NEPMD\User\Mark\LineInsert' LineInsert = QueryConfigKey( KeyPath) if LineInsert = 'A' then if .last = 0 then insertline '', 1 endif down endif -- Not for line mode if stream_mode then .col = 1 endif endif -- Ensure that pos and mark before the action is saved getfileid fid StateRange = QueryUndoState() parse value StateRange with OldestState NewestState -- Eventually override the previously saved pos and mark call SetUndoStatePos( fid, NewestState) call pMove_Mark() KeyPath = '\NEPMD\User\Mark\UnmarkAfterMove' UnmarkAfterMove = QueryConfigKey( KeyPath) if UnmarkAfterMove = 1 then unmark -- Remove content in shared text buffer 'ClearSharBuff' endif ; --------------------------------------------------------------------------- defc DeleteMark getmark firstline, lastline, firstcol, lastcol, markfileid MkType = marktype() getfileid fileid if fileid <> markfileid then 'SayError 'MARKED_OTHER__MSG unmark endif -- Position cursor if it was on a marked line if .line >= firstline & .line <= lastline then if MkType = 'CHAR' & .line = firstline & .col <= firstcol then -- nop elseif MkType = 'BLOCK' & .col <= firstcol then -- nop elseif MkType = 'CHAR' | MkType = 'LINE' then firstline .col = firstcol elseif MkType = 'BLOCK' then .col = firstcol endif endif call NextCmdAltersText() -- Ensure that pos and mark before the action is saved getfileid fid StateRange = QueryUndoState() parse value StateRange with OldestState NewestState -- Eventually override the previously saved pos and mark call SetUndoStatePos( fid, NewestState) 'Copy2DMBuff' call pDelete_Mark() 'ClearSharBuff' -- Remove content in shared text buffer ; --------------------------------------------------------------------------- defc Unmark unmark 'ClearSharBuff' -- Remove content in shared text buffer ; --------------------------------------------------------------------------- defc BeginMark mt = leftstr( marktype(), 1) if mt then getmark firstline, lastline, firstcol, lastcol, fileid activatefile fileid fMarkedLineOnScreen = OnScreen( firstline) call pBegin_Mark() if mt = 'L' then .col = 1 endif -- Ensure that the cursor is within the window area if not fMarkedLineOnScreen then 'CenterLine' endif else 'SayError 'NO_MARK_HERE__MSG endif ; --------------------------------------------------------------------------- defc EndMark mt = leftstr( marktype(), 1) if mt then getmark firstline, lastline, firstcol, lastcol, fileid activatefile fileid fMarkedLineOnScreen = OnScreen( lastline) call pEnd_Mark() if mt = 'L' then endline elseif mt = 'C' then getmark firstline, lastline, firstcol, lastcol, fileid if lastcol = 0 then .lineg = lastline - 1 endline endif endif -- Ensure that the cursor is within the window area if not fMarkedLineOnScreen then 'CenterLine' endif else 'SayError 'NO_MARK_HERE__MSG endif ; --------------------------------------------------------------------------- defc AfterMark mt = leftstr( marktype(), 1) if mt then getmark firstline, lastline, firstcol, lastcol, fileid activatefile fileid fMarkedLineOnScreen = OnScreen( lastline) LastLineStr = textline( lastline) LastLineLen = length( lastline) if mt = 'L' then .lineg = lastline + 1 .col = 1 elseif mt = 'B' then .lineg = lastline .col = lastcol + 1 elseif mt = 'C' then if lastcol = 0 then .lineg = lastline .col = 1 elseif lastcol = LastLineLen + 1 then .lineg = lastline + 1 .col = 1 else .lineg = lastline .col = lastcol + 1 endif endif -- Ensure that the cursor is within the window area if not fMarkedLineOnScreen then 'CenterLine' endif else 'SayError 'NO_MARK_HERE__MSG endif ; --------------------------------------------------------------------------- ; This is a callback command used by drag & drop of a marked area. defc DupMark Type = upcase( arg( 1)) if Type = 'M' then -- M = move call NextCmdAltersText() call pMove_Mark() elseif Type = 'C' then -- C = copy call NextCmdAltersText() if marktype() then call pCopy_Mark() else -- If no mark, look into shared text buffer 'GetSharBuff' endif elseif Type = 'O' then -- O = overlay call NextCmdAltersText() if marktype() then call pCommon_Adjust_Overlay( 'O') else -- If no mark, look into shared text buffer 'GetSharBuff O' endif elseif Type = 'A' then -- A = adjust call NextCmdAltersText() call pCommon_Adjust_Overlay( 'A') elseif Type = 'U' then -- U = unmark unmark 'ClearSharBuff' elseif Type = 'U2' then -- U2 = unmark w/o clearing buffer, for drag/drop unmark elseif Type = 'D' then -- D = delete mark 'Copy2DMBuff' -- DMBuff = delete-mark buffer call NextCmdAltersText() call pDelete_Mark() 'ClearSharBuff' elseif Type = 'D2' then -- D2 = delete mark w/o touching buffers, for drag/drop call NextCmdAltersText() call pDelete_Mark() elseif Type = 'P' then -- P = print marked area call CheckMark() -- verify there is a marked area, 'Print' -- then print it. endif ; --------------------------------------------------------------------------- defc TypeFrameChars call NextCmdAltersText() call Process_Keys( 'ş Ì É È Ê Í Ë ĵ ğ ı Î ³ Ú À Á Ä Â Ù ż ´ Ċ Û ² ħ °') ; --------------------------------------------------------------------------- defc ShiftLeft MkType = marktype() if not MkType then return endif getmark firstline, lastline, firstcol, lastcol, fid getfileid curfid if curfid <> fid then unmark 'SayError 'MARKED_OTHER__MSG return endif call NextCmdAltersText() if MkType = 'CHAR' then -- Change to line mark if lastCol = 0 then lastLine = lastLine - 1 endif firstcol = 1 lastcol = MAXCOL unmark call pSet_Mark( firstline, lastline, firstcol, lastcol, 'LINE', fid) endif -- Get minimum indent of current block if MkType = 'BLOCK' then pStart = firstcol else pStart = 1 endif MinIndent = MAXCOL do l = firstline to lastline getline LineStr, l LineStr = substr( LineStr, pStart) CurIndent = Max( 1, verify( LineStr, ' '\t)) - 1 -- Don't count indent of empty lines if substr( LineStr, CurIndent + 1) = '' then iterate endif if CurIndent < MinIndent then MinIndent = CurIndent endif enddo -- Don't delete chars at the left if MinIndent < 1 then return endif shift_left if marktype() = 'BLOCK' then -- code by Bob Langer KeyPath = '\NEPMD\User\Mark\ShiftBlockOnly' fShiftBlockOnly = QueryConfigKey( KeyPath) -- If fShiftBlockOnly, then the part after the block is fix, -- otherwise it will be moved with the block, which is the default. if fShiftBlockOnly then getmark fl, ll, fc, lc, fid call pSet_Mark( fl, ll, lc, MAXCOL, 'BLOCK', fid) shift_right call pSet_Mark( fl, ll, fc, lc, 'BLOCK', fid) endif endif ; --------------------------------------------------------------------------- defc ShiftRight MkType = marktype() if not MkType then return endif getmark firstline, lastline, firstcol, lastcol, fid getfileid curfid if curfid <> fid then unmark 'SayError 'MARKED_OTHER__MSG return endif call NextCmdAltersText() if MkType = 'CHAR' then -- Change to line mark if lastCol = 0 then lastLine = lastLine - 1 endif firstcol = 1 lastcol = MAXCOL unmark call pSet_Mark( firstline, lastline, firstcol, lastcol, 'LINE', fid) endif -- Get maximum space after last word in all lines within current block if MkType = 'BLOCK' then pEnd = lastcol - 1 MinSpace = MAXCOL do l = firstline to lastline getline LineStr, l LineStr = substr( LineStr, firstcol, lastcol - firstcol + 1) LineStr = translate( LineStr, ' ', \t) StrippedLineStr = strip( LineStr, 'T') CurSpace = length( LineStr) - length( StrippedLineStr) if CurSpace < MinSpace then MinSpace = CurSpace endif enddo -- Don't delete chars at the right if MinSpace < 1 then return endif endif if marktype() = 'BLOCK' then -- code by Bob Langer KeyPath = '\NEPMD\User\Mark\ShiftBlockOnly' fShiftBlockOnly = QueryConfigKey( KeyPath) -- If fShiftBlockOnly, then the part after the block is fix, -- otherwise it will be moved with the block, which is the default. if fShiftBlockOnly then getmark fl, ll, fc, lc, fid call pSet_Mark( fl, ll, lc, MAXCOL, 'BLOCK', fid) shift_left call pSet_Mark( fl, ll, fc, lc, 'BLOCK', fid) endif endif shift_right ; --------------------------------------------------------------------------- defc JoinLines call NextCmdAltersText() call JoinLines() 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc MarkBlock getmark firstline, lastline, firstcol, lastcol, markfileid getfileid fileid if fileid <> markfileid then unmark endif if wordpos( marktype(), 'LINE CHAR') then --call pset_mark( firstline, lastline, firstcol, lastcol, BLOCKGMARK, fileid) unmark endif markblock 'Copy2SharBuff' -- Copy mark to shared text buffer ; --------------------------------------------------------------------------- defc MarkLine getmark firstline, lastline, firstcol, lastcol, markfileid getfileid fileid if fileid <> markfileid then unmark endif if wordpos( marktype(), 'BLOCK CHAR') then --call pset_mark( firstline, lastline, firstcol, lastcol, LINEMARK, fileid) unmark endif mark_line 'Copy2SharBuff' -- Copy mark to shared text buffer ; --------------------------------------------------------------------------- defc MarkChar getmark firstline, lastline, firstcol, lastcol, markfileid getfileid fileid if fileid <> markfileid then unmark endif if wordpos( marktype(), 'BLOCK LINE') then --call pset_mark( firstline, lastline, firstcol, lastcol, CHARGMARK, fileid) unmark endif mark_char 'Copy2SharBuff' -- Copy mark to shared text buffer ; --------------------------------------------------------------------------- defc ShowCursor if not OnScreen() then 'CenterLine' endif -- Set focus to client -- EPM bug: -- On dismissing a popup menu, the focus is often not set back to the edit -- window. Click into it first. Focus switching was also addded to -- ShowCursor (Ctrl+.) and ProcessEscape (Esc). 'SetFocusToEditClient' 'PostMe HighlightCursor 1' ; --------------------------------------------------------------------------- defc HighlightCursor universal lastcommand on = arg( 1) if not wordpos( on, '0 1') then KeyPath = '\NEPMD\User\CursorPos\HighlightCursor' on = QueryConfigKey( KeyPath) endif if on = 1 then circleit 5, .line, .col - 1, .col + 1, 16777220 lastcommand = 'highlightcursor' endif ; --------------------------------------------------------------------------- defc TypeFileName -- Type the full name of the current file call NextCmdAltersText() call Process_Keys( .filename) ; --------------------------------------------------------------------------- defc TypeDateTime -- Type the current date and time call NextCmdAltersText() call Process_Keys( DateTime()) ; --------------------------------------------------------------------------- defc Select_All, SelectAll getfileid fid call pSet_Mark( 1, .last, 1, length( textline( .last)), 'CHAR' , fid) 'Copy2SharBuff' -- Copy mark to shared text buffer ; --------------------------------------------------------------------------- defproc ReflowGetAvailableModes Available = '' ModeList = NepmdQueryModeList() do w = 1 to words( ModeList) ThisMode = word( ModeList, w) if ThisMode = 'TEXT' then if length( Available) > 0 then Available = Available' ' endif Available = Available''ThisMode elseif isadefc( 'Reflow'ThisMode) then if length( Available) > 0 then Available = Available' ' endif Available = Available''ThisMode endif enddo return Available ; --------------------------------------------------------------------------- ; This suffices to add a mode to the reflow list: ; Reflow menu items in newmenu should also be defined for a new mode. ; Extend menuinit_Reflow and optionally ReflowMenuCmd. ReflowMenuCmd executes ; Reflow if not otherwise defined. defc ReflowCONFIGSYS 'SplitPathLines' ; --------------------------------------------------------------------------- ; Splits CONFIGSYS path lines at ';' or at '+'. defc SplitPathLines l = 0 NumSplitDirs = 0 SplitWords = '; +' SavedModify = .modify SavedAutoSave = .autosave .autosave = 0 do forever l = l + 1 if l > .last then leave endif getline LineStr, l do w = 1 to words( SplitWords) SplitWord = word( SplitWords, w) NumSplitWord = count( SplitWord, LineStr) if NumSplitWord >= 2 then parse value LineStr with VarName'='ValueStr if ValueStr = '' then leave endif replaceline VarName'=', l rest = ValueStr NumDirs = 0 do while rest <> '' PrevRest = rest -- Parse at SplitWord parse value rest with ThisDir(SplitWord)rest -- Append SplitWord if in the original p = pos( SplitWord, PrevRest) if p = length( ThisDir) + 1 then ThisDir = ThisDir''SplitWord endif -- Insert ThisDir NumDirs = NumDirs + 1 insertline ' 'ThisDir, l + NumDirs enddo l = l + NumDirs NumSplitDirs = NumSplitDirs + NumDirs endif if l = .last then leave else iterate endif enddo enddo if NumSplitDirs then 'SayError Split 'NumSplitDirs' dirs. Lines will be reconcatenated on Save.' .modify = SavedModify -- Save split state SetFileAVar( 'splitpathlines', 1) else 'SayError No line split.' .modify = SavedModify endif .autosave = SavedAutoSave ; --------------------------------------------------------------------------- ; Joins CONFIGSYS path lines. It stops joining if next line is empty, ; has no '=' char or has 'REM ' prepended. ; This is executed for files of mode CONFIGSYS on Save. defc JoinPathLines do once = 1 to 1 -- Ensure to process this only when split before fLinesSplitBefore = (GetFileAVar( 'splitpathlines')) if not fLinesSplitBefore then leave endif l = 1 SavedAutoSave = .autosave .autosave = 0 do forever if l = .last then leave endif getline LineStr, l getline NextLineStr, l + 1 if LineStr = '' then l = l + 1 iterate elseif NextLineStr = '' then l = l + 1 iterate elseif pos( '=', NextLineStr) then l = l + 1 iterate elseif wordpos( 'REM', upcase( NextLineStr)) = 1 then l = l + 1 iterate else -- Append NextLineStr replaceline LineStr''strip( NextLineStr), l deleteline l + 1 endif enddo .autosave = SavedAutoSave enddo ; --------------------------------------------------------------------------- defc ReflowSelectMode universal lastselectedreflowmode KeyPath = '\NEPMD\User\Format\Reflow' SelectedMode = QueryConfigKey( KeyPath'\SpecialMode') Available = ReflowGetAvailableModes() Selection = wordpos( SelectedMode, Available) + 1 -- + 1 because -auto- is prepended Title = 'Select a mode for reflow'copies( ' ', 20) List = '/-auto-/'translate( Available, '/', ' ') Text = 'Available reflow modes:' ret = ListBox( Title, List, '/~Set/~Auto/'CANCEL__MSG, -- buttons 0, 0, --5, 5, -- top, left, Min( words( List), 12), 40, -- height, width GethWndC( APP_HANDLE) || atoi( Selection) || atoi( 1) || atoi( 0) || Text\0) -- Parse return string parse value ret with Button 2 Select \0 Button = asc( Button) if Button = 1 then -- Set if Select = '-auto-' then Select = 0 endif fSwitchSelected = 1 WriteConfigKey( KeyPath'\SpecialMode', Select) elseif Button = 2 then -- Auto Select = 0 WriteConfigKey( KeyPath'\SpecialMode', Select) fSwitchSelected = 1 else -- Cancel rc = 31 fSwitchSelected = 0 endif if fSwitchSelected then WriteConfigKey( KeyPath'\SpecialMode', Select) if Select = 0 then SelectedMode = GetMode() else SelectedMode = Select endif if SelectedMode <> lastselectedreflowmode then if isadefc( 'RefreshFormatMenu') then 'RefreshFormatMenu' endif lastselectedreflowmode = SelectedMode endif endif ; --------------------------------------------------------------------------- defproc ReflowGetSelectedMode FallBackMode = 'TEXT' KeyPath = '\NEPMD\User\Format\Reflow' SelectedMode = QueryConfigKey( KeyPath'\SpecialMode') if not SelectedMode then SelectedMode = GetMode() endif Available = ReflowGetAvailableModes() if not wordpos( SelectedMode, Available) then SelectedMode = FallBackMode endif return SelectedMode ; --------------------------------------------------------------------------- defproc ReflowGetReflowMargins universal header_width KeyPath = '\NEPMD\User\Mode\TEXT\Reflow' i = QueryConfigKey( KeyPath'\Margins\Selected') if i = 1 then ReflowMargins = '1 'header_width' 1' elseif i = 3 then ReflowMargins = .margins else new = QueryConfigKey( KeyPath'\Margins\'i) ReflowMargins = new endif return ReflowMargins ; --------------------------------------------------------------------------- defc Reflow2ReflowMargins ReflowMargins = ReflowGetReflowMargins() if FileIsMarked() then 'ReflowMark' ReflowMargins else 'ReflowAll' ReflowMargins endif ; --------------------------------------------------------------------------- defc ReflowAll2ReflowMargins ReflowMargins = ReflowGetReflowMargins() 'ReflowAll' ReflowMargins ; --------------------------------------------------------------------------- ; Syntax: reflow_all [] defc Reflow_All, ReflowAll call NextCmdAltersText() Savedmargins = .margins if arg( 1) <> '' then .margins = arg( 1) endif call pSave_Mark( SavedMark) call pSave_Pos( SavedPos) n = 0 display -1 fstopit = 0 top do forever getline line do while line = '' | -- Skip over blank lines or (lastpos( ':', line) = 1 & pos( '.', line) = length( line)) | -- lines containing only a GML tag or substr( line, 1, 1) = '.' -- SCRIPT commands if .line = .last then fstopit = 1 leave endif down getline line enddo if fstopit then leave endif startline = .line unmark markline call pFind_Blank_Line() if .line <> startline then up else bottom endif markline getmark prevfirstline, prevlastline n = n + (prevlastline - prevfirstline) + 1 reflow getmark firstline, lastline if lastline = .last then leave endif lastline + 1 enddo display 1 call pRestore_Mark( SavedMark) call pRestore_Pos( SavedPos) if arg( 1) <> '' then .margins = SavedMargins endif 'SayHint 'n' lines reflowed.' 'HighlightCursor' ; --------------------------------------------------------------------------- defc ReflowMark2ReflowMargins ReflowMargins = ReflowGetReflowMargins() 'ReflowMark' ReflowMargins ; --------------------------------------------------------------------------- ; Syntax: ReflowMark [] defc ReflowMark SavedMarktype = marktype() mt = strip( leftstr( SavedMarktype, 1)) if mt = '' then 'SayError 'NO_MARK__MSG stop endif getmark firstline, lastline, firstcol, lastcol, fid getfileid curfid if curfid <> fid then unmark 'SayError 'MARKED_OTHER__MSG stop endif if not Check_Mark_On_Screen() then 'SayError 'MARK_OFF_SCREEN__MSG stop endif if mt = 'C' then -- Change to line mark if lastCol = 0 then lastLine = lastLine - 1 endif firstcol = 1 lastcol = MAXCOL unmark call pSet_Mark( firstline, lastline, firstcol, lastcol, 'LINE', fid) mt = 'L' endif SavedMargins = .margins if arg( 1) <> '' then .margins = arg( 1) endif call NextCmdAltersText() display -1 n = 0 n = n + (lastline - firstline) + 1 if mt = 'B' then 'box r' elseif mt = 'L' then reflow endif display 1 if arg( 1) <> '' then .margins = SavedMargins endif 'SayHint 'n' marked lines reflowed.' 'HighlightCursor' ; --------------------------------------------------------------------------- defc ReflowPar2ReflowMargins ReflowMargins = ReflowGetReflowMargins() 'ReflowPar' ReflowMargins ; --------------------------------------------------------------------------- ; Syntax: ReflowPar [] ; Ignores mark. To reflow a marked area, use ReflowMark. defc ReflowPar saved_margins = .margins if arg( 1) <> '' then .margins = arg( 1) endif call NextCmdAltersText() display -1 call Text_Reflow() display 1 if arg( 1) <> '' then .margins = saved_margins endif ; --------------------------------------------------------------------------- ; Standard text reflow, moved from Alt+P definition in STDKEYS.E. ; Only called from Alt+P if no mark exists; users wishing to call ; this from their own code must save & restore the mark themselves ; if that's desired. defproc Text_Reflow call NextCmdAltersText() KeyPath = '\NEPMD\User\Format\Reflow' ReflowNext = QueryConfigKey( KeyPath'\Par') if .line then getline line if line <> '' then -- If currently on a blank line, don't reflow. oldcursory = .cursory oldcursorx = .cursorx oldline = .line oldcol = .col unmark mark_line call pFind_Blank_Line() -- Ver 3.11: Slightly revised test works better with GML sensitivity. if .line <> oldline then up else bottom endif mark_line reflow if ReflowNext then -- Position on next paragraph (like PE) call pFind_Blank_Line() for i = .line + 1 to .last getline line, i if line <> '' then .lineg = i .col = 1 .cursory = oldcursory .line = i leave endif endfor else -- or like old E getmark firstline, lastline firstline .cursory = oldcursory .cursorx = oldcursorx oldline .col = oldcol endif unmark endif 'HighlightCursor' endif ; --------------------------------------------------------------------------- definit -- Variable is null if alt_R is not active. universal alt_R_active -- For E3/EOS2, it's 1 if alt_R is active. alt_R_active = '' -- For EPM, it's set to querycontrol(messageline). ; --------------------------------------------------------------------------- defc ReflowBlock universal alt_R_active,tempofid universal alt_R_space call NextCmdAltersText() if alt_R_active <> '' then call pBlock_Reflow( 1, alt_R_space, tempofid) -- Complete the reflow. 'SetMessageline '\0 'ToggleFrame 2 'alt_R_active -- Restore status of messageline. alt_R_active = '' return endif if pBlock_Reflow( 0, alt_R_space, tempofid) then 'SayError 'PBLOCK_ERROR__MSG /* HurleyJ */ return endif ; if marktype() <> 'BLOCK' then unmark ; endif alt_R_active = QueryFrameControl( 2) -- Remember if messageline on or off 'ToggleFrame 2 1' -- Force it on 'SetMessageLine' BLOCK_REFLOW__MSG ; --------------------------------------------------------------------------- defc Split call NextCmdAltersText() split ; --------------------------------------------------------------------------- defc SplitLines call NextCmdAltersText() call SplitLines() ; --------------------------------------------------------------------------- ; Removes all empty lines defc RemoveAllEmptyLines if FileIsMarked() then MarkToLineMark() getmark markfirstline, marklastline, markfirstcol, marklastcol, markfid FirstLine = markfirstline LastLine = marklastline else FirstLine = 1 LastLine = .last endif call NextCmdAltersText() SavedModify = .modify pSave_Pos( SavedPos) n = 0 Line = 1 do forever if Line > LastLine then leave endif if textline( Line) = '' then .lineg = Line deleteline LastLine = LastLine - 1 n = n + 1 .modify = SavedModify + 1 else Line = Line + 1 endif enddo pRestore_Pos( SavedPos) 'SayHint 'n' lines removed.' ; --------------------------------------------------------------------------- ; Reduces multiple empty lines to one defc RemoveMultipleEmptyLines if FileIsMarked() then MarkToLineMark() getmark markfirstline, marklastline, markfirstcol, marklastcol, markfid FirstLine = markfirstline LastLine = marklastline else FirstLine = 1 LastLine = .last endif call NextCmdAltersText() SavedModify = .modify pSave_Pos( SavedPos) n = 0 Line = FirstLine do forever if Line >= LastLine then leave endif if textline( Line) = '' & textline( Line + 1) = '' then .lineg = Line deleteline LastLine = LastLine - 1 n = n + 1 .modify = SavedModify + 1 else Line = Line + 1 endif enddo pRestore_Pos( SavedPos) 'SayHint 'n' lines removed.' ; --------------------------------------------------------------------------- ; Ensures that empty lines follow trailing '.' or ':' chars at a line end ; and ensures there exist an empty line at the end. defc ReAddEmptyLines if FileIsMarked() then MarkToLineMark() getmark markfirstline, marklastline, markfirstcol, marklastcol, markfid FirstLine = markfirstline LastLine = marklastline else FirstLine = 1 LastLine = .last endif call NextCmdAltersText() SavedModify = .modify pSave_Pos( SavedPos) n = 0 Line = FirstLine do forever if Line > LastLine then leave elseif Line = LastLine then insertline '', Line + 1 n = n + 1 .modify = SavedModify + 1 leave elseif wordpos( rightstr( strip( textline( Line)), 1), '. :') > 0 & strip( textline( Line + 1)) <> '' then insertline '', Line + 1 n = n + 1 Line = Line + 2 .modify = SavedModify + 1 else Line = Line + 1 endif enddo pRestore_Pos( SavedPos) 'SayHint 'n' lines added.' ; --------------------------------------------------------------------------- defc RemoveDoubleLineEnds Option = upcase( strip( arg( 1))) if Option = 'EXACT' then -- Exact -- This is the old "SingleSpace" macro. -- Removes every 2nd line, if it's a blank line. -- Stops if a 2nd line is not blank. Starts at the forelast line, -- which must be blank. call NextCmdAltersText() do l = .last - 1 to 1 by -2 if textline( l) <> '' then 'SayError Line' l 'is not blank.' leave endif deleteline l enddo else -- Sloppy call NextCmdAltersText() l = .last do forever if l <= 1 then leave endif if textline( l) = '' then -- If line l is empty -- Backward: line l is greater than the lines above FirstEmptyLine = l LastEmptyLine = l do l2 = l - 1 to 1 by -1 if textline( l2) <> '' then leave endif LastEmptyLine = l2 enddo -- Backward: FirstEmptyLine is greater than the lines above NumEmptyLines = FirstEmptyLine - LastEmptyLine + 1 NumDelete = (NumEmptyLines + 1) % 2 do n = 1 to NumDelete deleteline l l = l - 1 enddo l = l - (NumDelete - 1) else l = l - 1 endif enddo endif ; --------------------------------------------------------------------------- ; For campatibility. defc SingleSpace 'RemoveDoubleLineEnds exact' ; --------------------------------------------------------------------------- ; Remove double lines defc RemoveDoubleLines if FileIsMarked() then MarkToLineMark() getmark markfirstline, marklastline, markfirstcol, marklastcol, markfid FirstLine = markfirstline LastLine = marklastline else FirstLine = 1 LastLine = .last endif call NextCmdAltersText() SavedModify = .modify pSave_Pos( SavedPos) n = 0 Line = FirstLine do forever if Line > .last then leave endif if Line >= LastLine then leave endif LineStr = textline( Line) if strip( translate( LineStr, ' ', \9)) = '' then Line = Line + 1 iterate endif j = Line + 1 do forever if j > .last then leave endif if LineStr == textline( j) then .lineg = j deleteline n = n + 1 .modify = SavedModify + 1 else j = j + 1 endif enddo Line = Line + 1 enddo pRestore_Pos( SavedPos) 'SayHint 'n' lines removed.' ; --------------------------------------------------------------------------- defc StripBlanksFromLines Option = upcase( arg( 1)) fStripLeading = 0 if abbrev( Option, 'L', 1) then fStripLeading = 1 endif if FileIsMarked() then MarkToLineMark() getmark markfirstline, marklastline, markfirstcol, marklastcol, markfid FirstLine = markfirstline LastLine = marklastline else FirstLine = 1 LastLine = .last endif call NextCmdAltersText() n = 0 do Line = FirstLine to LastLine -- Determine LineStr before calling SearchReplaceLine getline LineStr, Line if length( LineStr) = 0 then iterate endif -- Remove leading whitespace rcx1 = 1 if fStripLeading then -- Running SearchReplaceLine on every line with extended grep is -- slow. Therefore avoid the call if possible. if leftstr( LineStr, 1) == ' ' | leftstr( LineStr, 1) == \9 then rcx1 = SearchReplaceLine( '^:w', '', 1, 'x', Line, 1) endif endif -- Remove trailing whitespace -- Running SearchReplaceLine on every line with extended grep is -- slow. Therefore avoid the call if possible. rcx2 = 1 if rightstr( LineStr, 1) == ' ' | rightstr( LineStr, 1) == \9 then rcx2 = SearchReplaceLine( ':w$', '', 1, 'x', Line, 1) endif -- Count changes if rcx1 = 0 | rcx2 = 0 then n = n + 1 endif enddo 'SayHint 'n' lines stripped.' ; --------------------------------------------------------------------------- defc CenterMark, Center call NextCmdAltersText() call pCenter_Mark() ; --------------------------------------------------------------------------- ; Centers the text within the mark, linewise. Reduces 1599 as EndCol to 78 ; to place the text at a useful place. Replaces trailing and leading ; whitespace with spaces. Allows for all mark types. If no mark exists, then ; current line is processed and then the cursor is moved to the next line. defproc pcenter_mark universal header_width fFileIsMarked = FileIsMarked() if not fFileIsMarked then -- Not marked: Get entire line MkFirstLine = .line MkLastLine = .line MkFirstCol = 1 MkLastCol = MAXMARGIN -- Not marked: Limit to header_width TargetCol = header_width else MkType = marktype() -- Convert char mark to line mark if MkType = 'CHAR' then MarkToLineMark() MkType = marktype() endif getmark MkFirstLine, MkLastLine, MkFirstCol, MkLastCol, MkFid if MkType = 'LINE' then -- Line mark: Get entire line(s) MkFirstCol = 1 MkLastCol = MAXMARGIN -- Line mark: Limit to header_width TargetCol = header_width else -- Block mark TargetCol = MkLastCol endif endif MkLineLen = MkLastCol + 1 - MkFirstCol TargetLen = TargetCol + 1 - MkFirstCol do LineNum = MkFirstLine to MkLastLine -- Read line getline LineStr, LineNum TextPart = StripBlanks( substr( LineStr, MkFirstCol, MkLineLen)) if TextPart = '' then iterate endif -- No mark and line mark: If line is longer, don't process it if length( TextPart) > TargetLen then iterate endif -- Center line NewLineStr = overlay( center( TextPart, TargetLen), LineStr, MkFirstCol) NewLineStr = StripBlanks( NewLineStr, 'T') -- Replace line (pReplaceLine preserves bookmarks) pReplaceLine( NewLineStr, LineNum) enddo -- Move to next line after processing if no mark exists if not fFileIsMarked then if .line < .last then down endif endif return ; --------------------------------------------------------------------------- defc BackSpace universal stream_mode fMarkDeleted = ReplaceMark() if fMarkDeleted then return endif call NextCmdAltersText() if .col = 1 & .line > 1 & stream_mode then up l = length( textline( .line)) join .col = l + 1 else old_level = .levelofattributesupport if old_level & not (old_level bitand 2) then .levelofattributesupport = .levelofattributesupport + 2 -- If the following block is processed after rubout, but with col -- instead of col - 1, a bookmark at col is deleted, also at col after -- rubout, which was previously col + 1. Therefore: -- Delete the bookmark at .col - 1 before rubout. if .col <= 1 & stream_mode then line = .line - 1 col = length( textline( line)) + 1 else line = .line col = .col endif DelBookmarkAtPos( line, col - 1) -- Go over all attributes at current pos. -- Required for rubout to delete the char at col - 1. -- rubout won't go over an attribute. .cursoroffset = -300 endif -- Begin workaround for cursor just behind or at begin of a mark -- For char mark: Move mark left if cursor is on mark begin or end old_col = .col old_line = .line fCorrectMarkBegin = 0 fCorrectMarkEnd = 0 getfileid fid MkType = marktype() do once = 1 to 1 if MkType <> 'CHAR' then leave endif getmark first_line, last_line, first_col, last_col, mkfid if fid <> mkfid then leave endif if (old_col > 1) & (first_line = old_line) & (first_line = last_line) & (first_col = old_col) then -- Cursor is on mark begin and first_line = last_line fCorrectMarkBegin = 1 fCorrectMarkEnd = 1 elseif (old_col > 1) & (first_line = old_line) & (first_col = old_col) then -- Cursor is on mark begin fCorrectMarkBegin = 1 elseif (old_col > 0) & (last_line = old_line) & (last_col = old_col - 1) then -- Cursor is 1 col behind mark end fCorrectMarkEnd = 1 endif --dprintf( first_line', 'last_line', 'first_col', 'last_col', Marktype = 'MkType || -- ', fCorrectMarkEnd/Begin = 'fCorrectMarkEnd fCorrectMarkBegin) enddo -- End workaround for cursor just behind or at begin of a mark rubout -- Begin workaround for cursor just behind or at begin of a mark --MkType = wordpos( MkType, 'LINE CHAR BLOCK CHARG BLOCKG') - 1 if fCorrectMarkBegin then first_col = first_col - 1 -- move first_col left endif if fCorrectMarkEnd then last_col = last_col - 1 -- move last_col left endif if fCorrectMarkBegin | fCorrectMarkEnd then pSet_Mark( first_line, last_line, first_col, last_col, MkType, fid) endif -- End workaround for cursor just behind or at begin of a mark .levelofattributesupport = old_level endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- ; Enhanced to accept a line number as arg, like the deleteline statement. defc DeleteLine Line = arg( 1) pSave_Pos( SavedPos) if Line <> '' then .lineg = Line endif call NextCmdAltersText() call DelAttrInLine() deleteline if Line <> '' then pRestore_Pos( SavedPos) endif ; --------------------------------------------------------------------------- ; Delete from cursor until beginning of next word, UNDOable defc DeleteUntilNextword call NextCmdAltersText() getline LineStr BegCur = .col LenLine = length( LineStr) if LenLine >= BegCur then for i = BegCur to LenLine -- delete remainder of word if substr( LineStr, i, 1) <> ' ' then DelBookmarkAtPos() -- Go over all attributes at current pos. -- Required for deletechar to delete the char at col. -- deletechar won't go over an attribute. .cursoroffset = 0 deletechar else leave endif endfor for j = i to LenLine -- delete delimiters following word if substr( LineStr, j, 1) == ' ' then DelBookmarkAtPos() -- Go over all attributes at current pos. -- Required for deletechar to delete the char at col. -- deletechar won't go over an attribute. .cursoroffset = 0 deletechar else leave endif endfor endif ; --------------------------------------------------------------------------- defc DeleteUntilEndLine call NextCmdAltersText() l = length( textline( .line)) DelBookmarkInRegion( .line, .col, .line, l) erase_end_line -- Ctrl-Del is the PM way. ; --------------------------------------------------------------------------- defc EndFile universal stream_mode if stream_mode then bottom endline else if .line = .last and .line then endline endif bottom endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- ; If arg( 1) specified and > 0: Set cursor to pos of pointer. defc MarkWord if arg( 1) then 'MH_GoToLastClick' unmark endif call pMark_Word() ; --------------------------------------------------------------------------- ; If arg( 1) specified and > 0: Set cursor to pos of pointer. defc MarkSentence if arg( 1) then 'MH_GoToLastClick' unmark endif call mark_sentence() ; --------------------------------------------------------------------------- ; If arg( 1) specified and > 0: Set cursor to pos of pointer. defc MarkParagraph if arg( 1) then 'MH_GoToLastClick' unmark endif call mark_paragraph() ; --------------------------------------------------------------------------- defc ExtendSentence call mark_through_next_sentence() ; --------------------------------------------------------------------------- defc ExtendParagraph call mark_through_next_paragraph() ; --------------------------------------------------------------------------- ; If arg( 1) specified and > 0: Set cursor to pos of pointer. defc MarkToken if arg( 1) then 'MH_GoToLastClick' endif if Find_Token( startcol, endcol) then KeyPath = '\NEPMD\User\Mark\WordMarkType' WordMarkType = QueryConfigKey( KeyPath) if WordMarkType = 'B' then MkType = 'BLOCK' else MkType = 'CHAR' endif getfileid fid call pSet_Mark( .line, .line, startcol, endcol, MkType, fid) -- Copy mark to shared text buffer 'Copy2SharBuff' endif ; --------------------------------------------------------------------------- defc UppercaseWord call NextCmdAltersText() call pSave_Pos( savepos) call pSave_Mark( savemark) call pMark_Word() call pUpperCase() call pRestore_Mark( savemark) ; --------------------------------------------------------------------------- defc LowercaseWord call NextCmdAltersText() call pSave_Pos( savepos) call pSave_Mark( savemark) call pMark_Word() call pLowerCase() call pRestore_Mark( savemark) call pRestore_Pos( savepos) ; --------------------------------------------------------------------------- defc UppercaseMark call NextCmdAltersText() call pUpperCase() ; --------------------------------------------------------------------------- defc LowercaseMark call NextCmdAltersText() call pLowerCase() ; --------------------------------------------------------------------------- define compile if not defined( UPPERCHARS) UPPERCHARS = 'ABCDEFGHIJKLMNOPQRSTUVWXYZŽ™š' compile endif compile if not defined( LOWERCHARS) LOWERCHARS = 'abcdefghijklmnopqrstuvwxyz„”' compile endif ; --------------------------------------------------------------------------- ; Toggles case of word under cursor: lower -> Mixed -> UPPER -> lower defc CaseWord call pSave_Pos( savepos) -- find_token won't take '.' and '_' as word boundaries rcx = Find_Token( startcol, endcol) if rcx <> 1 & .col > 1 then -- Inspect tokens left from cursor .col = .col - 1 rcx = Find_Token( startcol, endcol) endif if rcx <> 1 then call pRestore_Pos( savepos) return endif getline LineStr, .line LeftLineStr = substr( LineStr, 1, Max( 0, startcol - 1)) Wrd = substr( LineStr, startcol, Max( 0, endcol - startcol + 1)) RightLineStr = substr( LineStr, endcol + 1) if verify( Wrd, LOWERCHARS, 'M') = 0 then -- no lowercase -> lowercase -- XXXX -> xxxx NewWrd = translate( Wrd, LOWERCHARS, UPPERCHARS) elseif verify( Wrd, UPPERCHARS, 'M') = 0 & -- no uppercase and verify( substr( Wrd, 1, 1), LOWERCHARS, 'M') then -- first char lowercase -> Capitalize -- xxxx -> Xxxx NewWrd = translate( leftstr( Wrd, 1), UPPERCHARS, LOWERCHARS) -- first letter if length( Wrd) > 1 then NewWrd = NewWrd''translate( substr( Wrd, 2), LOWERCHARS, UPPERCHARS) -- append rest endif else -- mixed case -> UPPERCASE -- xxXx -> XXXX NewWrd = translate( Wrd, UPPERCHARS, LOWERCHARS) endif -- Replace line only if anything has changed to not increase .modify otherwise if NewWrd <> Wrd then call NextCmdAltersText() --replaceline LeftLineStr''NewWrd''RightLineStr .col = startcol rcx = SearchReplaceLine( Wrd, NewWrd, 1) endif call pRestore_Pos( savepos) ; --------------------------------------------------------------------------- ; Toggles case of char under cursor. Moves right. defc CaseChar getline LineStr, .line Char = substr( LineStr, .col, 1) NewChar = Char if verify( Char, LOWERCHARS, 'M') = 0 then -- no lowercase -> lowercase -- X -> x NewChar = translate( Char, LOWERCHARS, UPPERCHARS) elseif verify( Char, UPPERCHARS, 'M') = 0 then -- no uppercase -> uppercase -- x -> X NewChar = translate( Char, UPPERCHARS, LOWERCHARS) endif -- Replace line only if anything has changed to not increase .modify otherwise if NewChar <> Char then call NextCmdAltersText() rcx = SearchReplaceLine( Char, NewChar, 1) endif 'NextChar' ; --------------------------------------------------------------------------- defc BeginWord call pBegin_Word() 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc EndWord call pEnd_Word() 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc BeginFile universal stream_mode if stream_mode then top beginline else if .line = 1 then beginline endif top endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc DuplicateLine call NextCmdAltersText() getline line insertline line, .line + 1 ; --------------------------------------------------------------------------- defc CommandDlgLine if .line then getline line 'CommandLine 'line endif ; --------------------------------------------------------------------------- defc PrevWord universal stream_mode if stream_mode & (.line > 1) & (.col = Max( 1, verify( textline( .line), ' '))) then up endline endif backtab_word 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc NextWord universal stream_mode if stream_mode & (((not .line) | (lastpos( ' ', textline( .line)) < .col)) & (.line < .last)) then down call pFirst_NonBlank() else tabword endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc MarkPrevWord universal stream_mode startline = .line startcol = .col if .line then if stream_mode & (.line > 1) & (.col = Max( 1, verify( textline( .line), ' '))) then up endline endif backtabword call Extend_Mark( startline, startcol, 0) endif ; --------------------------------------------------------------------------- defc MarkNextWord universal stream_mode startline = .line startcol = .col if .line then if stream_mode & (((not .line) | (lastpos( ' ', textline( .line)) < .col)) & (.line < .last)) then down call pFirst_NonBlank() else tabword endif call Extend_Mark( startline, startcol, 1) endif ; --------------------------------------------------------------------------- defc BeginScreen if .line then .cursory = 1 else .line = 1 endif ; --------------------------------------------------------------------------- defc EndScreen if .line then .cursory = .windowheight else .line = 1 endif ; --------------------------------------------------------------------------- defc MarkBeginScreen startline = .line startcol = .col if .line then .cursory = 1 endif if .line then call Extend_Mark( startline, startcol, 0) else .line = 1 endif defc MarkEndScreen startline = .line startcol = .col if .line then .cursory = .windowheight endif if .line then call Extend_Mark( startline, startcol, 1) else .line = 1 endif ; --------------------------------------------------------------------------- ; Record and playback key and menu commands ; The array var 'recordkeys' holds the list of \0-separated Key\1Cmd pairs. ; It is set by SaveKeyCmd, which is called by OtherKeys, ExecKeyCmd and ; ExecAccelKey. See UNDO.E:"defproc SaveKeyCmd". ; --------------------------------------------------------------------------- defproc RecKeysNew universal recfid UserDir = Get_Env( 'NEPMD_USERDIR') RecFile = UserDir'\bin\last.rec' getfileid startfid getfileid recfid, RecFile if validatefileid( recfid) then call pSave_Mark( SavedMark) activatefile recfid call pSet_Mark( 1, .last, 1, length( textline( .last)), 'CHAR' , recfid) deletemark if .last > 0 then .line = .last deleteline endif --'xcom save' -- Better keep old file until recording is saved .modify = 0 call pRestore_Mark( SavedMark) else 'xcom E /n 'RecFile getfileid recfid .visible = 0 .autosave = 0 endif if .last > 0 then .line = .last deleteline endif .modify = 0 activatefile startfid ; --------------------------------------------------------------------------- defproc RecKeysEnd UserDir = Get_Env( 'NEPMD_USERDIR') RecFile = UserDir'\bin\last.rec' getfileid startfid getfileid recfid, RecFile if validatefileid( recfid) then activatefile recfid 'xcom Save' activatefile startfid endif ; --------------------------------------------------------------------------- defproc RecKeysCancel UserDir = Get_Env( 'NEPMD_USERDIR') RecFile = UserDir'\bin\last.rec' getfileid startfid getfileid recfid, RecFile if validatefileid( recfid) then activatefile recfid .modify = 0 'xcom Quit' activatefile startfid recfid = 0 endif ; --------------------------------------------------------------------------- defc RecKeysSaveAs UserDir = Get_Env( 'NEPMD_USERDIR') RecFile = UserDir'\bin\last.rec' getfileid recfid, RecFile -- Revert to make it visible and to process defload and defselect if validatefileid( recfid) then activatefile recfid 'xcom Quit' endif 'xcom E /d' RecFile -- Open Save-as dialog 'PostMe PostMe SaveAs_Dlg' -- 2x PostMe required ; --------------------------------------------------------------------------- defproc RecKeysGetFile universal recfid if validatefileid( recfid) then RecFile = recfid.filename else UserDir = Get_Env( 'NEPMD_USERDIR') RecFile = UserDir'\bin\last.rec' endif return RecFile ; --------------------------------------------------------------------------- defc RecKeysSelectFile RecFile = RecKeysGetFile() Title = 'Select a record macro file for playback' Cmd = 'RecKeysSetFile' FileMask = RecFile 'FileDlg' Title','Cmd','FileMask ; --------------------------------------------------------------------------- defc RecKeysSetFile universal recfid universal recordingstate RecFile = arg( 1) Text = '"'RecFile'" set as record macro file for playback.' getfileid startfid getfileid fid, RecFile if fid = '' then if Exist( RecFile) then 'xcom E' RecFile .visible = 0 getfileid recfid activatefile startfid 'SayError 'Text recordingstate = 'P' endif else recfid = fid 'SayError 'Text recordingstate = 'P' endif ; --------------------------------------------------------------------------- defc RecKeysSelectEditFile RecFile = RecKeysGetFile() Title = 'Select a record macro file to edit' Cmd = 'RecKeysEditFile' FileMask = RecFile 'FileDlg' Title','Cmd','FileMask ; --------------------------------------------------------------------------- defc RecKeysEditFile RecFile = arg( 1) getfileid fid, RecFile -- Revert to make it visible and to process defload and defselect if fid then activatefile fid 'xcom Quit' endif 'Edit' RecFile ; --------------------------------------------------------------------------- defproc RecKeysAppendCurKey universal curkey universal recfid insertline curkey, recfid.last + 1, recfid recfid.modify = 0 ; --------------------------------------------------------------------------- defproc RecKeysGetNumKeys universal recfid if validatefileid( recfid) then return recfid.last else return 0 endif ; --------------------------------------------------------------------------- defproc RecKeysGetKey( line) universal recfid getline LineStr, line, recfid return LineStr ; --------------------------------------------------------------------------- defproc AddRecordKeys universal recordingstate universal curkey parse value( curkey) with KeyString \1 Cmd Cmd = strip( Cmd) -- If key recording is active, add curkey to recordkeys array var if wordpos( upcase( Cmd), 'RECORDKEYS PLAYBACKKEYS') = 0 then if recordingstate = 'R' then call RecKeysAppendCurKey() endif endif ; --------------------------------------------------------------------------- defc RecordKeys universal recordingstate RecordKeysKeyString = strip( MenuAccelString( 'RecordKeys'), 'L', \9) PlaybackKeysKeyString = strip( MenuAccelString( 'PlaybackKeys'), 'L', \9) if recordingstate = 'R' then recordingstate = 'P' --'SayHint' REMEMBERED__MSG call RecKeysEnd() 'SayHint Remembered! Press 'PlaybackKeysKeyString' to execute.' else recordingstate = 'R' call RecKeysNew() --'SayHint' CTRL_R__MSG 'SayHint Remembering keys. 'RecordKeysKeyString' to finish, 'PlaybackKeysKeyString' to finish and try, Esc to cancel.' endif ; --------------------------------------------------------------------------- defc CancelRecordKeys universal recordingstate recordingstate = '' call RecKeysCancel() 'SayHint Key recording canceled.' ; --------------------------------------------------------------------------- defc PlaybackKeys universal recordingstate universal recfid NumEntries = RecKeysGetNumKeys() PlaybackKeysKeyString = strip( MenuAccelString( 'PlaybackKeys'), 'L', \9) if recordingstate = 'R' then recordingstate = 'P' call RecKeysEnd() --'SayHint' REMEMBERED__MSG 'SayHint Remembered! Press 'PlaybackKeysKeyString' to execute.' endif if recordingstate = 'P' & validatefileid( recfid) then call NextCmdAltersText() 'DisableUndoRec' do line = 1 to NumEntries KeyDef = RecKeysGetKey( line) parse value( KeyDef) with Key \1 Cmd -- Execute either accel or standard (other) key if Cmd <> '' then -- Execute Cmd if defined Cmd elseif IsSingleKey( Key) then -- A standard char call Process_Key( Key) endif enddo 'EnableUndoRec' else 'RecKeysSelectFile' endif ; --------------------------------------------------------------------------- defc TypeTab call Process_Key( \9) ; --------------------------------------------------------------------------- defc DeleteChar universal stream_mode fMarkDeleted = ReplaceMark() if fMarkDeleted then return endif call NextCmdAltersText() l = 0 if .line then l = length( textline( .line)) endif if .line & .col > l & stream_mode then join -- Append next line to current .col = l + 1 else old_level = .levelofattributesupport if old_level & not (old_level bitand 2) then .levelofattributesupport = .levelofattributesupport + 2 endif DelBookmarkAtPos() -- Go over all attributes at current pos. -- Required for deletechar to delete the char at col. -- deletechar won't go over an attribute. .cursoroffset = 0 -- deletechar won't go over the text end and delete the line end char. -- That is the correct behavior in line mode. deletechar .levelofattributesupport = old_level endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc ScrollLockV NewValue = strip( arg( 1)) if NewValue <> '' & wordpos( NewValue, '0 1') then KeyPath = '\NEPMD\User\CursorPos\ScrollLockV' fScrollLockV = QueryConfigKey( KeyPath) if NewValue <> fScrollLockV then WriteConfigKey( KeyPath, NewValue) endif endif ; --------------------------------------------------------------------------- defc ScrollLockH NewValue = strip( arg( 1)) if NewValue <> '' & wordpos( NewValue, '0 1') then KeyPath = '\NEPMD\User\CursorPos\ScrollLockH' fScrollLockH = QueryConfigKey( KeyPath) if NewValue <> fScrollLockH then WriteConfigKey( KeyPath, NewValue) endif endif ; --------------------------------------------------------------------------- defc Nextline, Down NumLines = arg( 1) NextCmdChangesLinePos() call UnmarkOnAnyKey() 'VSyncIfKeepCursor' fScrollLockV = 0 if Scroll_Lock() then KeyPath = '\NEPMD\User\CursorPos\ScrollLockV' fScrollLockV = QueryConfigKey( KeyPath) endif if fScrollLockV then ScrollUpDownKey( 1, NumLines) else call UpDownKey( 1, NumLines) endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc PrevLine, Up NumLines = arg( 1) NextCmdChangesLinePos() call UnmarkOnAnyKey() 'VSyncIfKeepCursor' fScrollLockV = 0 if Scroll_Lock() then KeyPath = '\NEPMD\User\CursorPos\ScrollLockV' fScrollLockV = QueryConfigKey( KeyPath) endif if fScrollLockV then ScrollUpDownKey( 0, NumLines) else call UpDownKey( 0, NumLines) endif if .line = 0 then -- Not for insert below KeyPath = '\NEPMD\User\Mark\LineInsert' LineInsert = QueryConfigKey( KeyPath) if LineInsert = 'A' then .lineg = 1 endif endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc ScrollDown NumLines = arg( 1) NextCmdChangesLinePos() call UnmarkOnAnyKey() 'VSyncIfKeepCursor' fScrollLockV = 0 if Scroll_Lock() then KeyPath = '\NEPMD\User\CursorPos\ScrollLockV' fScrollLockV = QueryConfigKey( KeyPath) endif if not fScrollLockV then ScrollUpDownKey( 1, NumLines) else call UpDownKey( 1, NumLines) endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc ScrollUp NumLines = arg( 1) NextCmdChangesLinePos() call UnmarkOnAnyKey() 'VSyncIfKeepCursor' fScrollLockV = 0 if Scroll_Lock() then KeyPath = '\NEPMD\User\CursorPos\ScrollLockV' fScrollLockV = QueryConfigKey( KeyPath) endif if not fScrollLockV then ScrollUpDownKey( 0, NumLines) else call UpDownKey( 0, NumLines) endif if .line = 0 then -- Not for insert below KeyPath = '\NEPMD\User\Mark\LineInsert' LineInsert = QueryConfigKey( KeyPath) if LineInsert = 'A' then .lineg = 1 endif endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc MarkDown NextCmdChangesLinePos() startline = .line startcol = .col call UpDownKey( 1) if startline then -- required if cursor is in line 0 call Extend_Mark( startline, startcol, 1) endif ; --------------------------------------------------------------------------- defc BeginLine -- Home call UnmarkOnAnyKey() 'VSyncIfKeepCursor' KeyPath = '\NEPMD\User\SpecialKeys\HomeToggles' on = (QueryConfigKey( KeyPath) = 1) if on then -- Go to begin of text. -- If in area before or at begin of text, go to column 1. startline = .line startcol = .col call pFirst_NonBlank() if .line = startline and .col = startcol then beginline endif else -- standard Home beginline endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc MarkBeginLine -- Sh+Home KeyPath = '\NEPMD\User\SpecialKeys\HomeToggles' on = (QueryConfigKey( KeyPath) = 1) if on then -- Go to begin of text. -- If in area before or at begin of text, go to column 1. startline = .line startcol = .col call pFirst_NonBlank() if .line = startline and .col = startcol then beginline endif if .line then call Extend_Mark( startline, startcol, 0) endif else -- standard Sh+Home startline = .line startcol = .col beginline if .line then call Extend_Mark( startline, startcol, 0) endif endif ; --------------------------------------------------------------------------- defc EndLine -- End universal endkeystartpos call UnmarkOnAnyKey() 'VSyncIfKeepCursor' KeyPath = '\NEPMD\User\SpecialKeys\EndToggles' on = (QueryConfigKey( KeyPath) = 1) if on then -- If started from after end of text, save that as startcol. -- Go to end of text. If on end of text, go to startcol. parse value( endkeystartpos) with savedline savedcol startline = .line startcol = .col if .line then endline --call pEnd_Line() -- like endline, but ignore trailing blanks if savedline <> startline or startcol > .col then endkeystartpos = startline startcol else if startcol = .col and savedcol > .col then .col = savedcol endif endif endif else -- standard End if .line then endline endif --call pEnd_Line() -- like endline, but ignore trailing blanks endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc MarkEndLine -- Sh+End universal endkeystartpos KeyPath = '\NEPMD\User\SpecialKeys\EndToggles' on = (QueryConfigKey( KeyPath) = 1) if on then parse value( endkeystartpos) with savedline savedcol startline = .line startcol = .col if .line then endline --call pEnd_Line() -- like endline, but ignore trailing blanks if savedline <> startline or startcol > .col then endkeystartpos = startline startcol else if startcol = .col and savedcol > .col then .col = savedcol endif endif call Extend_Mark( startline, startcol, 1) endif else startline = .line startcol = .col --call pEnd_Line() -- like endline, but ignore trailing blanks if .line then endline call Extend_Mark( startline, startcol, 1) endif endif ; --------------------------------------------------------------------------- ; Syntax: ProcessEscape [] ; is usually set to CommandLine ; This can be specified in STDKEYS.E. defc ProcessEscape universal alt_R_active universal recordingstate universal mousemarkinginfo Cmd = strip( arg( 1)) parse value mousemarkinginfo with BeginDragLine BeginDragCol HighlightSwitchedOff Mt sayerror 0 -- Set focus to client -- EPM bug: -- On dismissing a popup menu, the focus is often not set back to the edit -- window. Click into it first. Focus switching was also addded to -- ShowCursor (Ctrl+.) and ProcessEscape (Esc). 'SetFocusToEditClient' if recordingstate = 'R' then 'CancelRecordKeys' elseif alt_R_active <> '' then 'SetMessageLine '\0 'ToggleFrame 2 'alt_R_active -- restore status of messageline alt_R_active = '' elseif mousemarkinginfo <> '' then -- Just cancel the mark action (internally defined) and don't open -- commandline. The unmarking will happen just at releasing MB 2, -- not immediately. To unmark the text immediately, another PM window -- has to be shown, like the commandline window. 'MH_CancelMark' -- Workaround for catching the last char of a line as last char of a mark call MouseMarkEnableHighlight() else 'HighlightCursor' Cmd endif ; --------------------------------------------------------------------------- defc SaveOrSaveAs fTempFile = (leftstr( .filename, 1) = '.') -- Let 'Save' open the Save-as dialog for unmodified virtual files to -- query fTempFile and PrevFilename of 'Save' correctly if .modify | fTempFile then 'Save' else 'SayError No changes. Press Enter to Save anyway.' 'SaveAs_Dlg 0' -- better show file selector -- new optional arg, 0 => no EXIST_OVERLAY__MSG endif ; --------------------------------------------------------------------------- defc SmartSave if .modify then 'Save' else 'SayError No changes.' endif ; --------------------------------------------------------------------------- defc FileOrQuit if .modify then 'File' else 'Quit' endif ; --------------------------------------------------------------------------- defc EditFileDlg universal ring_enabled if not ring_enabled then 'SayError 'NO_RING__MSG return endif 'OpenDlg EDIT' ; --------------------------------------------------------------------------- defc Prevfile -- Workaround: This avoids unwanted window scrolling of the previous file. 'VSyncCursor' prevfile ; --------------------------------------------------------------------------- defc NextFile -- Workaround: This avoids unwanted window scrolling of the previous file. 'VSyncCursor' nextfile ; --------------------------------------------------------------------------- defc UndoLine call NextCmdAltersText() undo ; --------------------------------------------------------------------------- defc InsertToggle inserttoggle call Fixup_Cursor() ; --------------------------------------------------------------------------- defc PrevChar, Left NumCols = arg( 1) call UnmarkOnAnyKey() 'VSyncIfKeepCursor' fScrollLockH = 0 if Scroll_Lock() then KeyPath = '\NEPMD\User\CursorPos\ScrollLockH' fScrollLockH = QueryConfigKey( KeyPath) endif if fScrollLockH then 'ScrollLeft' NumCols else 'MoveCursorLeft' NumCols endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- ; Moves left without unmark. defc MoveCursorLeft NumCols = arg( 1) if NumCols = '' then NumCols = 1 elseif not IsNum( NumCols) then NumCols = 1 endif 'VSyncIfKeepCursor' do n = 1 to NumCols if .line > 1 & .col = 1 then up endline else left endif enddo ; --------------------------------------------------------------------------- defc MarkPrevChar, MarkLeft startline = .line startcol = .col if .line > 1 & .col = 1 then up endline else left endif call Extend_Mark( startline, startcol, 0) ; --------------------------------------------------------------------------- defc PrevPage, PageUp NextCmdChangesLinePos() call UnmarkOnAnyKey() 'VSyncIfKeepCursor' pageup 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc NextPage, PageDown NextCmdChangesLinePos() call UnmarkOnAnyKey() 'VSyncIfKeepCursor' pagedown 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc MarkPageUp NextCmdChangesLinePos() startline = .line startcol = .col pageup if .line then call Extend_Mark( startline, startcol, 0) endif if .line = 0 then -- Not for insert below KeyPath = '\NEPMD\User\Mark\LineInsert' LineInsert = QueryConfigKey( KeyPath) if LineInsert = 'A' then .line = 1 endif endif ; --------------------------------------------------------------------------- defc MarkPageDown NextCmdChangesLinePos() startline = .line startcol = .col pagedown if .line then -- required if cursor is in line 0 call Extend_Mark( startline, startcol, 1) endif ; --------------------------------------------------------------------------- defc NextChar, Right NumCols = arg( 1) call UnmarkOnAnyKey() 'VSyncIfKeepCursor' fScrollLockH = 0 if Scroll_Lock() then KeyPath = '\NEPMD\User\CursorPos\ScrollLockH' fScrollLockH = QueryConfigKey( KeyPath) endif if fScrollLockH then 'ScrollRight' NumCols else 'MoveCursorRight' NumCols endif 'MatchFindOnMove' ; --------------------------------------------------------------------------- ; Moves right without unmark. Used for buffer. defc MoveCursorRight universal cursoreverywhere NumCols = arg( 1) if NumCols = '' then NumCols = 1 elseif not IsNum( NumCols) then NumCols = 1 endif 'VSyncIfKeepCursor' if .line then l = length( textline( .line)) else l = .col endif if (.line < .last) & (.col > l) & not cursoreverywhere then down beginline elseif (.line = .last) & (.col > l) & not cursoreverywhere then -- nop else right endif ; --------------------------------------------------------------------------- defc MarkNextChar, MarkRight startline = .line startcol = .col if .line then l = length( textline( .line)) else l = .col endif if .line < .last & .col > l then down beginline elseif .line <> .last | .col <= l then right endif call Extend_Mark( startline, startcol, 1) /* ; --------------------------------------------------------------------------- defc BeginFile .line = 1 beginline ; --------------------------------------------------------------------------- defc EndFile .line = .last endline */ ; --------------------------------------------------------------------------- defc MarkBeginFile NextCmdChangesLinePos() startline = .line startcol = .col .line = 1 beginline if startline then -- required if cursor was on line 0 call Extend_Mark( startline, startcol, 0) end ; --------------------------------------------------------------------------- defc MarkEndFile NextCmdChangesLinePos() startline = .line startcol = .col .line = .last if .line then -- required if cursor was on line 0 endline call Extend_Mark( startline, startcol, 1) endif ; --------------------------------------------------------------------------- defc ScrollLeft NumCols = arg( 1) if NumCols = '' then NumCols = 1 elseif not IsNum( NumCols) then NumCols = 1 endif call UnmarkOnAnyKey() 'VSyncIfKeepCursor' do n = 1 to NumCols oldcursorx = .cursorx if .col - .cursorx then .col = .col - .cursorx .cursorx = oldcursorx elseif .cursorx > 1 then left endif enddo 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc ScrollRight NumCols = arg( 1) if NumCols = '' then NumCols = 1 elseif not IsNum( NumCols) then NumCols = 1 endif call UnmarkOnAnyKey() 'VSyncIfKeepCursor' do n = 1 to NumCols oldcursorx = .cursorx a = .col + .windowwidth - .cursorx + 1 if a <= MAXCOL then .col = a .cursorx = oldcursorx elseif .col < MAXCOL then right endif enddo 'MatchFindOnMove' ; --------------------------------------------------------------------------- defc CenterLine call UnmarkOnAnyKey() oldline = .line .cursory = .windowheight % 2 -- .cursory makes the cursor unvisible after scrolling -- and if cursor wasn't on screen before. oldline ; --------------------------------------------------------------------------- ; Todo: Move marked lines ; Menu item: Flags: ; Backtab [moves text] Text ; [moves text over whitespace] Text Whitespace ; [moves text in insert mode] TextIns ; [moves text in insert mode over whitespace] TextIns Whitespace ; [moves cursor] Cursor defc BackTab universal matchtab_on universal curkey Options = arg( 1) if Options = '' then parse value curkey with KeyString \1 . KeyPath = '\NEPMD\User\SpecialKeys\'KeyString Options = QueryConfigKey( KeyPath) endif Options = translate( upcase( Options), ' ', ',') -- uppercase, commas to spaces fText = (wordpos( 'TEXT', Options) > 0) fTextIns = (wordpos( 'TEXTINS', Options) > 0) fCursor = (wordpos( 'CURSOR', Options) > 0) fWhitespace = (wordpos( 'WHITESPACE', Options) > 0) -- Default values if not fText & not fTextIns & not fCursor then fCursor = 1 endif TabWidth = word( .tabs, 1) call UnmarkOnAnyKey() do once = 1 to 1 LineStr = textline( .line) OldLineStr = LineStr -- Handle tabs: expand them to spaces before. TabWidth = word( .tabs, 1) if pos( \9, LineStr) then rcx = TabExpandLine( .line, TabWidth) endif oldcol = .col -- Store .col after tab expansion oldline = .line oldcursory = .cursory -- Handle MatchTab: go to word boundaries of lines above Line = .line do i = 1 to 100 if not matchtab_on then leave endif if .line < 2 then leave endif -- Go one line up Line = Line - 1 LineStr = textline( Line) -- Ignore empty lines if StripBlanks( LineStr) = '' then iterate endif -- Handle tabs: expand them to spaces before fTabExpanded = 0 if pos( \9, LineStr) then rcx = TabExpandLine( Line, TabWidth) fTabExpanded = 1 endif .lineg = Line -- Go to previous word boundary backtabword -- Restore line with tabs if fTabExpanded then call pReplaceLine( LineStr, Line) endif -- Check more lines if col is not < oldcol if .col >= oldcol then .col = oldcol iterate -- Check more lines if col 1 is reached elseif .col = 1 then .col = oldcol iterate else leave endif enddo -- Restore scroll line and cursor line .cursory = oldcursory .line = oldline if .col = oldcol then backtab endif numspc = oldcol - .col if fWhitespace then -- Delete only chars in whitespace area SubText = substr( OldLineStr, .col, numspc) if strip( SubText) = '' then fDelete = 1 else fDelete = 0 endif else -- Delete every char fDelete = 1 endif if fDelete & (fText | (fTextIns & insertstate())) then -- Remove spaces instead of just moving the cursor if numspc > 0 then .col = oldcol do n = 1 to numspc 'BackSpace' enddo endif endif enddo ; --------------------------------------------------------------------------- ; Todo: Move marked lines ; Menu item: Flags: ; Tab [moves text with spaces] Text Sapces ; [moves text with tab] Text Tab ; [moves text in insert mode with spaces] TextIns Spaces ; [moves text in insert mode with tab] TextIns Tab ; [moves cursor] Cursor defc Tab universal stream_mode universal matchtab_on universal ondbcs universal curkey Options = arg( 1) if Options = '' then parse value curkey with KeyString \1 . KeyPath = '\NEPMD\User\SpecialKeys\'KeyString Options = QueryConfigKey( KeyPath) endif Options = translate( upcase( Options), ' ', ',') -- uppercase, commas to spaces Options = ChangeStr( 'TABS', Options, 'TAB') -- eventually correct typo fText = (wordpos( 'TEXT', Options) > 0) fTextIns = (wordpos( 'TEXTINS', Options) > 0) fCursor = (wordpos( 'CURSOR', Options) > 0) fSpaces = (wordpos( 'SPACES', Options) > 0) fTab = (wordpos( 'TAB', Options) > 0) -- Default values if not fText & not fTextIns & not fCursor then fText = 1 endif if not fCursor & not fSpaces & not fTab then fSpaces = 1 endif if fCursor then fSpaces = 0 fTab = 0 endif TabWidth = word( .tabs, 1) do once = 1 to 1 if fTab & (fText | (fTextIns & insertstate())) then call Process_Key( \9) leave endif call UnmarkOnAnyKey() oldcol = .col oldline = .line oldcursory = .cursory expandedcol = .col do i = 1 to 100 if not matchtab_on then leave endif if .line < 2 then leave endif -- Go one line up .lineg = .line - 1 LineStr = textline( .line) -- Ignore empty lines if StripBlanks( LineStr) = '' then iterate endif -- Handle tabs: expand them to spaces before fTabExpanded = 0 if pos( \9, LineStr) then rcx = TabExpandLine( .line, TabWidth) fTabExpanded = 1 endif -- Go to next word boundary or to line end .col = oldcol tabword expandedcol = .col -- Restore line with tabs if fTabExpanded then call pReplaceLine( LineStr, .line) endif -- Check more lines if col is not > oldcol if expandedcol <= oldcol then expandedcol = oldcol iterate else leave endif enddo -- Restore scroll line and cursor line .cursory = oldcursory .line = oldline -- Go to tabstop col after expansion .col = expandedcol if .col = oldcol then tab endif if fText | (fTextIns & insertstate()) then -- Insert spaces instead of just moving the cursor numspc = .col - oldcol -- Handle DBCS do once2 = 1 to 1 if not ondbcs then -- If we're on DBCS, leave endif if matchtab_on and .line > 1 then -- and didn't do a matchtab, leave endif if words( .tabs) > 1 then if not wordpos( .col, .tabs) then -- check if on a tab col. do i = 1 to words( .tabs) -- If we got shifted due to being inside a DBC, if word( .tabs, i) > oldcol then -- find the col we *should* be in, and numspc = word( .tabs, i) - oldcol -- set numspc according to that. leave endif enddo endif elseif (.col // .tabs) <> 1 then numspc = .tabs - (oldcol + .tabs - 1) // .tabs endif enddo -- once2 -- Insert spaces if numspc > 0 then .col = oldcol call Process_Keys( copies( ' ', numspc)) endif endif enddo -- once ; --------------------------------------------------------------------------- defc BackTabWord backtabword ; --------------------------------------------------------------------------- defc TabWord tabword ; --------------------------------------------------------------------------- defc MarkUp NextCmdChangesLinePos() startline = .line startcol = .col call UpDownKey( 0) if .line then call Extend_Mark( startline, startcol, 0) endif if .line = 0 then -- Not for insert below KeyPath = '\NEPMD\User\Mark\LineInsert' LineInsert = QueryConfigKey( KeyPath) if LineInsert = 'A' then .lineg = 1 endif endif ; --------------------------------------------------------------------------- defc DefaultPaste call NextCmdAltersText() KeyPath = '\NEPMD\User\Mark\DefaultPaste' next = substr( upcase( QueryConfigKey( KeyPath)), 1, 1) if next = 'L' then style = 'L' elseif next = 'B' then style = 'B' else style = 'C' endif call ReplaceMark() 'Paste' style ; --------------------------------------------------------------------------- defc AlternatePaste call NextCmdAltersText() KeyPath = '\NEPMD\User\Mark\DefaultPaste' next = substr( upcase( QueryConfigKey( KeyPath)), 1, 1) if next = 'L' then altstyle = 'C' elseif next = 'B' then altstyle = 'C' else altstyle = 'L' endif call ReplaceMark() 'Paste' altstyle ; --------------------------------------------------------------------------- ; Insert the char from the line above at cursor position. ; May get executed repeatedly to copy an entire expression without ; cluttering the undo list at every single execution. ; From Luc van Bogaert. defc InsertCharAbove if .line > 1 then -- suppress autosave and undo (for during repeated use) saved_autosave = .autosave .autosave = 0 call NextCmdAltersText() -- force overwrite mode i_s = insertstate() if i_s then inserttoggle -- Turn off insert mode endif line = textline( .line - 1) -- line above char = substr( line, .col, 1) keyin char if i_s then inserttoggle endif .autosave = saved_autosave endif ; --------------------------------------------------------------------------- ; Insert the char from the line below at cursor position. ; May get executed repeatedly to copy an entire expression without ; cluttering the undo list at every single execution. ; From Luc van Bogaert. defc InsertCharBelow if .line < .last then -- suppress autosave and undo (for during repeated use) saved_autosave = .autosave .autosave = 0 call NextCmdAltersText() -- force overwrite mode i_s = insertstate() if i_s then inserttoggle -- Turn off insert mode endif line = textline( .line + 1) -- line below char = substr( line, .col, 1) keyin char if i_s then inserttoggle endif .autosave = saved_autosave endif ; --------------------------------------------------------------------------- ; Add a new line before the current, move to it, keep col. defc NewLineBefore call NextCmdAltersText() insertline '' up ; --------------------------------------------------------------------------- ; Add a new line after the current, move to it, keep col. defc NewLineAfter call NextCmdAltersText() insertline '', .line + 1 down ; --------------------------------------------------------------------------- ; Define a_1, because alt_1 is only defined since ALT_1.E is redefined. defc A_1 'Alt_1'