source: trunk/src/netlabs/macros/keys.e@ 5224

Last change on this file since 5224 was 5211, checked in by Andreas Schnellbacher, 2 years ago
  • Fixed several msgs on switching to e.g. stdmenu by moving code from unlinked to linked .ex files.
  • Property svn:keywords set to Date Revision Author HeadURL Id
File size: 210.5 KB
Line 
1/****************************** Module Header *******************************
2*
3* Module Name: keys.e
4*
5* Copyright (c) Netlabs EPM Distribution Project 2002
6*
7* $Id: keys.e 5211 2022-11-10 01:03:20Z aschn $
8*
9* ===========================================================================
10*
11* This file is part of the Netlabs EPM Distribution package and is free
12* software. You can redistribute it and/or modify it under the terms of the
13* GNU General Public License as published by the Free Software
14* Foundation, in version 2 as it comes in the "COPYING" file of the
15* Netlabs EPM Distribution. This library is distributed in the hope that it
16* will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
17* of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18* General Public License for more details.
19*
20****************************************************************************/
21
22compile if not defined( SMALL) -- If compiled separately
23 EA_comment 'This defines definitions for keysets.'
24
25define
26 INCLUDING_FILE = 'KEYS.E'
27
28 include 'stdconst.e'
29const
30 tryinclude 'mycnf.e'
31const
32 compile if not defined( NLS_LANGUAGE)
33 NLS_LANGUAGE = 'ENGLISH'
34 compile endif
35 include NLS_LANGUAGE'.e'
36
37; In case someone executes 'keys' by mistake, the module would be unlinked.
38; Therefore add a (nop) defc that would be executed then in preference:
39defc keys
40 -- nop
41compile endif
42
43; ---------------------------------------------------------------------------
44definit
45 universal blockreflowflag
46
47 blockreflowflag = 0
48compile if defined(ACTIONS_ACCEL__L) -- For CUSTEPM support
49 call AddMenuAVar( 'usedmenuaccelerators', 'A')
50compile endif
51compile if defined(TEX_BAR__MSG) -- For TFE or EPMTeX support
52 call AddMenuAVar( 'usedmenuaccelerators', 'T')
53compile endif
54compile if defined(ECO_MENU__MSG) -- For ECO support
55 call AddMenuAVar( 'usedmenuaccelerators', 'I')
56compile endif
57
58 -- These keys must be defined as WM_CHAR keys, not as accelerator keys.
59 -- Otherwise typing single accent keys like ^ï` and entering a char via
60 -- its key code with Alt and the keypad numbers won't work.
61 -- This array var value must be specified in lowercase and with the
62 -- underscore as prefix separator: c_, a_ or s_ (not + or -)
63 NonAccelKeys = ''
64 NonAccelKeys = NonAccelKeys' a_1 a_2 a_3 a_4 a_5 a_6 a_7 a_8 a_9 a_0'
65 NonAccelKeys = NonAccelKeys' space'
66 NonAccelKeys = NonAccelKeys' down up left right'
67 NonAccelKeys = NonAccelKeys' a_down a_up a_left a_right'
68 NonAccelKeys = NonAccelKeys' a_ins a_del a_home a_end a_pgdn a_pgup'
69 call AddKeysAVar( 'nonaccelkeys', NonAccelKeys)
70
71; ---------------------------------------------------------------------------
72; Apparently edit_keys must be defined in EPM.EX as first ETK keyset.
73; Therefore "defkeys edit_keys new clear" was moved to INIT.E to be
74; included early.
75;
76; The standard ETK keyset "edit_keys" is mainly a dummy keyset, compared to
77; the original EPM keyset definition. It defines all keys as otherkeys,
78; except a_0 ... a_9, which are not executable as accel keys without unwanted
79; results.
80;
81; Otherkeys processes all keys for which no accel key def exists. That are
82; mainly single char keys. Process_Key works like Keyin, but handles
83; overwriting of the marked area in CUA marking mode.
84;
85; Bug in EPM's ETK keyset handling:
86; .keyset = '<new_keyset>' works only, if <new_keyset> was defined in
87; the same .EX file, from where the keyset should be changed.
88; Therefore (as a workaround) switch temporarily to the externally
89; defined keyset in order to make it known for 'SetKeys':
90;
91; definit -- required for a separately compiled package
92; saved_keys = .keyset
93; .keyset = '<new_keyset>'
94; .keyset = saved_keys
95;
96; Note: An .EX file, that defines a keyset, can't be unlinked, when this
97; keyset is in use.
98
99; ---------------------------------------------------------------------------
100/***
101; The following is defined in INIT.E and is processed during definit of
102; EPM.E.
103
104; This defines the standard keyset. It's important to use the option 'clear'.
105; Otherwise otherkeys won't process the standard letters, numbers and chars.
106;
107; The keyset 'edit_keys' must be defined before all other keysets.
108; Therefore this file is actually included early in EPM.E. It's possible to
109; link these defs, but then other key defs must be linked after defining
110; 'edit_keys'.
111; (To do: test if defs from 'edit_keys' are overtaken by other keysets then.)
112defkeys edit_keys new clear
113
114; For testing:
115;def '„'
116; dprintf( 'lastkey() = 'lastkey()', ch = 'ch)
117; call SaveKeyCmd( lastkey())
118; call Process_Keys( 'ae')
119
120; Alt+0 ... Alt+9 keys (WM_CHAR):
121; These standard key defs are not executed as accel keys in order to keep
122; entering a char via Alt+keypad key working.
123; Because accel keys don't create a WM_CHAR message, they can't be handled
124; by lastkey or getkeystate.
125; To assign code to these keys, they have to be additionally defined via the
126; DefKey proc (which is used for defining accel keys). DefKey handles them
127; specially: It sets just an array var, that is queried and executed by
128; ExecKeyCmd.
129def a_1 'ExecKeyCmd a_1'
130def a_2 'ExecKeyCmd a_2'
131def a_3 'ExecKeyCmd a_3'
132def a_4 'ExecKeyCmd a_4'
133def a_5 'ExecKeyCmd a_5'
134def a_6 'ExecKeyCmd a_6'
135def a_7 'ExecKeyCmd a_7'
136def a_8 'ExecKeyCmd a_8'
137def a_9 'ExecKeyCmd a_9'
138def a_0 'ExecKeyCmd a_0'
139
140; Space key (WM_CHAR):
141; In order to type the single accent key '^' which is created by
142; <hat_key>+<space>, space must not be defined as accel key. Therefore
143; Space is defined with ExecKeyCmd. That means that it executes the
144; command that is stored by DefKey( Space, cmd) as an array var.
145def space 'ExecKeyCmd space'
146
147; Cursor keys (WM_CHAR):
148; When processed as accel keys, cursor key messages send by another app
149; are ignored. This happens if AMouse is configured to send keyboard
150; messages instead of scroll window messages.
151def down 'ExecKeyCmd down'
152def up 'ExecKeyCmd up'
153def left 'ExecKeyCmd left'
154def right 'ExecKeyCmd right'
155
156; Processing the keys above in the 'otherkeys' command would work, but
157; their scancode may vary with different keyboard layouts. The E toolkit
158; key names (used after 'def') handle that.
159
160; Add more keys here that have to be processed as standard E toolkit keys
161; or can't be processed as accelerator keys. The cursor keys above are
162; defined as both. When being processed, the accel def wins. To ignore
163; the accel def, a key must be added to the 'noaccelkeys' array var above.
164
165; OtherKeys processes all other single keys plus those virtual keys that
166; are also defined as number keys on the keypad block (WM_CHAR):
167def otherkeys
168 'OtherKeys' -- Defined in KEYS.E
169***/
170
171; ---------------------------------------------------------------------------
172defproc CtrlIsDown
173 ks = getkeystate( VK_CTRL)
174 fDown = (ks = 1 | ks = 2)
175 return fDown
176
177; ---------------------------------------------------------------------------
178defproc AltIsDown
179 ks = getkeystate( VK_ALT)
180 fDown = (ks = 1 | ks = 2)
181 return fDown
182
183; ---------------------------------------------------------------------------
184defproc ShiftIsDown
185 ks = getkeystate( VK_SHIFT)
186 fDown = (ks = 1 | ks = 2)
187 return fDown
188
189; ---------------------------------------------------------------------------
190; This is used to separate standard char keys from modifier keys
191; (Ctrl/Alt/Sh) and virtual keys.
192defproc IsSingleKey
193 k = arg( 1)
194 fSingle = 0
195 -- This can't work on DBCS systems:
196 if length( k) = 1 then
197 fSingle = 1
198 -- This should work on DBCS systems:
199 elseif IsDbcs( k) then
200 fSingle = 1
201 endif
202 return fSingle
203
204; ---------------------------------------------------------------------------
205; OtherKeys processes all other single keys plus those Alt+virtual keys that
206; are also defined as number keys on the keypad block (WM_CHAR).
207defc OtherKeys
208 k = lastkey()
209 parse value lastkey( 2) with Flags 3 Repeat 4 ScanCode 5 CharCode 7 VkCode 9
210 ScanCode = Hex2Dec( c2x( ScanCode))
211 VkCode = itoa( VkCode, 10)
212
213 fExpanded = 0
214
215 if IsSingleKey( k) then
216
217 call SaveKeyCmd( k)
218
219 fExpanded = ExpandKey()
220 if fExpanded = 0 then
221 call Process_Key( k)
222 endif
223
224 elseif AltIsDown() then
225 -- Filter out keypad keys in order to keep entering a char via
226 -- Alt+keypad key working.
227 -- Usually keypad keys have a decimal scancode < 95. The scancode is
228 -- hardware-specific. The following line has to be changed for other
229 -- unusual keyboards.
230 -- The scancode (in hex) can be shown both in a PMPrintf window and
231 -- on EPM's mesageline by the TestKeys command.
232 if ScanCode >= 95 then
233
234 if VkCode = VK_UP then
235 'ExecKeyCmd a_up'
236 elseif VkCode = VK_DOWN then
237 'ExecKeyCmd a_down'
238 elseif VkCode = VK_LEFT then
239 'ExecKeyCmd a_left'
240 elseif VkCode = VK_RIGHT then
241 'ExecKeyCmd a_right'
242 elseif VkCode = VK_INSERT then
243 'ExecKeyCmd a_ins'
244 elseif VkCode = VK_DELETE then
245 'ExecKeyCmd a_del'
246 elseif VkCode = VK_HOME then
247 'ExecKeyCmd a_home'
248 elseif VkCode = VK_END then
249 'ExecKeyCmd a_end'
250 elseif VkCode = VK_PAGEDOWN then
251 'ExecKeyCmd a_pgdn'
252 elseif VkCode = VK_PAGEUP then
253 'ExecKeyCmd a_pgup'
254 endif
255
256 endif
257 endif
258
259; ---------------------------------------------------------------------------
260; Standard key defs don't work for keypad keys, only for normal keys.
261; Therefore keypad keys don't have to be filtered out here.
262; Keypad keys can be redefined via accel keys, but then entering chars by
263; entering its keycode via Alt+keypad keys won't work anymore.
264defc ExecKeyCmd
265 -- The array var is internally set by the DefKey proc if Alt+num keys
266 -- were defined via DefKey.
267 KeyString = arg( 1)
268 Cmd = GetKeysAVar( 'keydef.'KeyString)
269
270 call SaveKeyCmd( KeyString''\1''Cmd)
271 fExpanded = ExpandKey()
272 --dprintf( 'ExecKeyCmd: KeyString = 'KeyString', fExpanded = 'fExpanded)
273
274 if fExpanded = 0 then
275 if Cmd <> '' then
276 Cmd
277 else
278 k = lastkey()
279 call Process_Key( k)
280 endif
281 endif
282
283; ---------------------------------------------------------------------------
284; This ignores modifier key combinations. Therefore it can be used for single
285; chars only.
286defproc Process_Key( char)
287 if IsSingleKey( char) & char <> \0 then
288 call Process_Keys( char)
289 endif
290
291; ---------------------------------------------------------------------------
292; This types one or multiple chars. It handles replacing a marked area while
293; CUA marking is active.
294defproc Process_Keys( chars)
295 universal lastcommand
296
297 fInsert = insertstate()
298 fMarked = 0
299 fInsertToggled = 0
300 fMarkDeleted = (ReplaceMark() = 1)
301 if not fInsert & fMarkDeleted then
302 -- Turn on insert mode because the key should replace
303 -- the mark, not the character after the mark.
304 inserttoggle
305 fInsertToggled = 1
306 endif
307 lastcommand = chars
308
309 keyin chars
310
311 if fInsertToggled then
312 inserttoggle
313 endif
314
315; ---------------------------------------------------------------------------
316; An easier to remember synonym for Process_Keys.
317defproc TypeChars( chars)
318 call Process_Keys( chars)
319
320; ---------------------------------------------------------------------------
321; Defined as command for use in key definition files.
322defc TypeChars
323 parse arg chars
324 call Process_Keys( chars)
325
326; ---------------------------------------------------------------------------
327; This takes ascii values of one or multiple chars. Multiple chars can be
328; separated by '\'. An leading '\' is optional.
329; Example: TypeAscChars \0\170 gives a null char followed by a not char.
330defc TypeAscChars, TypeEscapedChars
331 Rest = strip( arg( 1))
332 Chars = ''
333 do while Rest <> ''
334 if leftstr( Rest, 1) <> '\' then
335 Rest = '\'Rest
336 endif
337 parse value Rest with '\'Num'\'Rest
338 Num = strip( Num)
339 Rest = strip( Rest)
340
341 if IsNum( Num) and Num < 256 then
342 Chars = Chars''chr( Num)
343 else
344 -- Maybe give an error msg here or ignore this one
345 Chars = Chars''Num
346 endif
347 enddo
348 call Process_Keys( Chars)
349
350; ---------------------------------------------------------------------------
351; executekey can only execute single WM_CHAR keys, either chars or virtual
352; keys defined in the ETK. For multiple keys, keyin can be used.
353defc DoKey, ExecuteKey
354 'Key '1 arg( 1)
355
356; ---------------------------------------------------------------------------
357; Syntax: Key <loopnum> <keystring>
358; In EPM we don't do a getkey() to ask you for the key. You must supply it
359; as part of the command, as in 'key 80 ='.
360defc Key, LoopKey
361 do once = 1 to 1
362 parse value arg( 1) with LoopNum k .
363 if not upcase( LoopNum) = 'RC' then
364 if not IsNum( LoopNum) then
365 sayerror INVALID_NUMBER__MSG
366 leave
367 endif
368 endif
369 fSingleKey = IsSingleKey( k)
370
371 -- jbl: Allow the user to specify the key in the command, so he can
372 -- say 'key 80 =' and avoid the prompt.
373 if k == '' then
374 -- Please specify the key to repeat, as in
375 'SayError' KEY_PROMPT2__MSG '"Key 'loopnum' =", "Key 'loopnum' S+F3".'
376 leave
377 endif
378
379 call NextCmdAltersText()
380 i = 0
381 do forever
382 i = i + 1
383 if IsNum( LoopNum) then
384 if i > LoopNum then
385 leave
386 endif
387 endif
388
389 -- Execute key
390 if fSingleKey then
391 -- Type char
392 executekey k
393 else
394 KeyString = NormalizeKeyString( k)
395 Cmd = GetKeysAVar( 'keydef.'KeyString)
396 if Cmd <> '' then
397 -- Execute Cmd
398 Cmd
399 else
400 -- Execute virtual WM_CHAR key (not used anymore in NEPMD)
401 executekey Resolve_Key( k)
402 endif
403 endif
404
405 if upcase( LoopNum) = 'RC' then
406 if rc then
407 leave
408 endif
409 endif
410
411 enddo
412 enddo
413
414; ---------------------------------------------------------------------------
415defc Keyin
416 parse arg chars
417 --'SayError chars = "'chars'"'
418 if chars == '' then
419 keyin ' '
420 else
421 keyin chars
422 endif
423
424; ---------------------------------------------------------------------------
425; In E3 and EOS2, we can use a_X to enter the value of any key. In EPM,
426; we can't, so the following routine is used by KEY and LOOPKEY to convert
427; from an ASCII key name to the internal value. It handles shift or alt +
428; any letter, or a function key (optionally, with any shift prefix). LAM
429
430; suffix for virtual keys
431; hex dec
432; 02 2 without prefix
433; 0a 10 Sh
434; 12 18 Ctrl
435; 22 34 Alt
436;
437; suffix for letters
438; hex dec
439; 10 16 Ctrl
440; 20 32 Alt
441;
442defproc Resolve_Key( k)
443 kl = lowcase( k)
444 suffix = \2 -- For unshifted function keys
445 if length( k) >= 3 & pos( substr( k, 2, 1), '_-+') then
446 if length( k) > 3 then
447 if substr( kl, 3, 1) = 'f' then -- Shifted function key
448 suffix = substr( \10\34\18, pos( leftstr( kl, 1), 'sac'), 1) -- Set suffix,
449 kl = substr( kl, 3) -- strip shift prefix, and more later...
450 elseif wordpos( substr( kl, 3), 'left up right down') then
451 suffix = substr( \10\34\18, pos( leftstr( kl, 1), 'sac'), 1) -- Set suffix,
452 kl = substr( kl, 3) -- strip shift prefix, and more later...
453 else -- Something we don't handle...
454 'SayError Resolve_key:' sayerrortext(-328)
455 rc = -328
456 endif
457 else -- alt+letter or ctrl+letter
458 k = substr( kl, 3, 1) || substr( \32\16, pos( leftstr( kl, 1), 'ac'), 1)
459 endif
460 endif
461 if leftstr( kl, 1) = 'f' & isnum( substr( kl, 2)) then
462 k = chr( substr( kl, 2) + 31) || suffix
463 elseif wordpos( kl, 'left up right down') then
464 k = chr( wordpos( kl, 'left up right down') + 20) || suffix
465 endif
466 return k
467
468; ---------------------------------------------------------------------------
469; An accelerator key issues a WM_COMMAND message, which is processed by the
470; ProcessCommand command defined in menu.e.
471; Some other defs where accelerator keys are filtered are:
472; def otherkeys, defproc process_key, defc ProcessOtherKeys
473; queryaccelstring returns the command connected with the specified menu item
474; or accelerator key def.
475
476; ---------------------------------------------------------------------------
477; Add or redefine an entry to the active named accelerator key table.
478;
479; Syntax: DefKey( KeyString, Cmd[, 'L'])
480;
481; KeyString prefixes are separated by '_', '+' or '-'. The following
482; prefixes are defined:
483; 'c_' Ctrl
484; 's_' Shift
485; 'a_' Alt
486; In this definition the order of the prefixes doesn't matter, while
487; on execution, the KeyString prefixes are used in the above order.
488; Cmd must be an E command string, not E code.
489; 'L' is the option for defining the key as a lonekey
490; (a lonekey is executed once on releasing the key)
491;
492; Examples:
493; DefKey( 'c_s_Q', 'SayError Ctrl+Shift+Q pressed')
494; DefKey( 'c+s+q', 'SayError Ctrl+Shift+Q pressed') (equivalent)
495; DefKey( 'C-S-q', 'SayError Ctrl+Shift+Q pressed') (equivalent)
496; DefKey( 'altgraf', 'SayError AltGraf key pressed', 'L')
497; For defining non-ASCII keys that don't match the upcase or lowcase
498; procedure processing, the key has to be defined in the correct
499; case:
500; DefKey( '„', 'SayError Lowercase „ (a-umlaut) pressed')
501; DefKey( 's_Ž', 'SayError Uppercase „ (a-umlaut) pressed')
502;
503; For standard accel table defs, the first def wins. This command changes it,
504; so that an accel table can be extended as expected: An already existing
505; accel table entry is overridden by a new one. That makes the last def win
506; and avoids multiple defs for a key.
507;
508defproc DefKey( KeyString, Cmd)
509 universal activeaccel
510 universal lastkeyaccelid
511 universal cua_menu_accel
512 Flags = 0
513
514 String = KeyString
515 call GetAFFlags( String, KeyString, Char, Flags) -- parses modifier prefixes of String
516
517 -- Parse lonekey option
518 fPadKey = 0
519 Options = upcase( arg( 3))
520 if Options <> '' then
521 if pos( Options, 'L') > 0 then
522 Flags = Flags + AF_LONEKEY
523 endif
524 endif
525
526 -- Handle deactivated 'block Alt+letter keys from jumping to menu bar'
527 -- Note: These keys and F10 can't be recorded, they are handled by PM.
528 -- There exists no ETK procs to activate the menu.
529 if IsSingleKey( Char) then
530 if cua_menu_accel then
531 if Flags = AF_ALT & wordpos( Char, upcase( GetMenuAVar( 'usedmenuaccelerators'))) then
532 return
533 endif
534 endif
535 endif
536
537 -- Remove previous key def in array vars, if any
538 PrevCmd = GetKeysAVar('keydef.'KeyString)
539 DelKeysAVar( 'keycmd.'PrevCmd, KeyString)
540
541 -- Save key def in array to allow for searching for KeyString and Cmd
542 SetKeysAVar( 'keydef.'KeyString, Cmd)
543 AddKeysAVar( 'keycmd.'Cmd, KeyString) -- may have multiple key defs
544
545 -- Add KeyString to category array vars
546 SaveKeyCat( KeyString)
547
548 -- Handle key defs that have to be defined as ETK keys instead of PM
549 -- accelerator keys.
550 -- In order to type the single accent key '^' which is created by
551 -- <hat_key>+<space>, space must not be defined as accel key. Therefore
552 -- Space is defined with ExecKeyCmd. That means that it executes the
553 -- command that is stored by DefKey( Space, cmd) as an array var.
554 -- Ignore Alt+keypad number keys as accel keys here. Just save key in
555 -- array to query it by ExecKeyCmd.
556 -- That makes the Alt+keypad number keys work for entering a char by its
557 -- key code.
558 NonAccelKeys = GetKeysAVar( 'nonaccelkeys')
559 if wordpos( KeyString, NonAccelKeys) then
560 -- Save key def in a keyset-specific array
561 SetKeysAVar( 'nonaccelkeydef.'activeaccel'.'KeyString, Cmd)
562 return
563 endif
564
565 if IsSingleKey( Char) then
566 Flags = Flags + AF_CHAR
567 if Flags bitand AF_SHIFT then
568 Key = asc( upcase( Char))
569 else
570 Key = asc( lowcase( Char))
571 endif
572 else
573 VK = GetVKConst( Char)
574 if VK > 0 then
575 Key = VK
576 Flags = Flags + AF_VIRTUALKEY
577 else
578 'SayError Error: Unknown key string 'KeyString' specified.'
579 --dprintf( 'KeyString = 'KeyString', Cmd = 'Cmd', Flags = 'Flags', Key = 'Key', last id = 'lastkeyaccelid)
580 return
581 endif
582 endif
583
584 AccelId = GetKeysAVar( 'keyid.'KeyString)
585 if AccelId = '' then
586 lastkeyaccelid = lastkeyaccelid + 1
587 if lastkeyaccelid = 8101 then -- 8101 is hardcoded as 'configdlg SYS'
588 lastkeyaccelid = lastkeyaccelid + 1
589 endif
590 AccelId = lastkeyaccelid
591 endif
592 -- Avoid to define c_break as accelerator key to keep the internal
593 -- definition working. That key is additionally defined as ProcessBreak
594 -- in STDKEYS.E, to make MenuAccelString() work.
595 if KeyString <> 'c_break' then
596 buildacceltable activeaccel, KeyString''\1''Cmd, Flags, Key, AccelId
597 endif
598
599 -- Save key def in array to allow for searching for KeyString and Cmd
600 SetKeysAVar( 'keyid.'KeyString, AccelId)
601
602 --if KeyString = 'alt' then
603 -- dprintf( 'KeyString = 'KeyString', Cmd = 'Cmd', Flags = 'Flags', Key = 'Key', id = 'lastkeyaccelid)
604 --endif
605 --if KeyString = 'c_s' then
606 -- dprintf( 'KeyString = 'KeyString', Cmd = 'Cmd', Flags = 'Flags', Key = 'Key', this id = 'AccelId', last id = 'lastkeyaccelid)
607 --endif
608
609/*
610 -- For non-letter chars: define also the shifted variant automatically
611 -- to make the defs more keyboard-independible.
612 if Flags bitand AF_CHAR and not Flags bitand AF_SHIFT then
613 if upcase( Key) = lowcase( Key) then
614 Flags = Flags + AF_SHIFT
615 lastkeyaccelid = lastkeyaccelid + 1
616 buildacceltable activeaccel, KeyString''\1''Cmd, Flags, Key, AccelId
617 endif
618 endif
619*/
620
621 return
622
623; Define a cmd to call the proc in profile.erx or for testing
624defc DefKey
625 parse arg KeyString Cmd
626 if upcase( lastword( Cmd)) = 'L' then
627 Options = 'L'
628 Cmd = subword( Cmd, 1, words( Cmd) - 1)
629 else
630 Options = ''
631 endif
632 call DefKey( KeyString, Cmd, Options)
633
634; ---------------------------------------------------------------------------
635; Syntax: UnDefKey( KeyString)
636defproc UnDefKey( KeyString)
637 universal activeaccel
638
639 AccelId = GetKeysAVar( 'keyid.'KeyString)
640 if AccelId <> '' then
641 -- Define Ctrl+Alt (= nothing) for this id
642 -- Don't change the array var to allow for redefining this id again
643 buildacceltable activeaccel, '', AF_CONTROL+AF_VIRTUALKEY, VK_ALT, AccelId
644 -- Remove KeyString from 'keycmd.' array var
645 Cmd = GetKeysAVar('keydef.'KeyString)
646 DelKeysAVar( 'keycmd.'Cmd, KeyString)
647 else
648 -- No error message if key was not defined before
649 endif
650
651 -- Remove KeyString from category array vars
652 DelKeyCat( KeyString)
653
654 return
655
656; Define a cmd to call the proc in profile.erx or for testing
657defc UnDefKey
658 parse arg KeyString
659 call UnDefKey( KeyString)
660
661; ---------------------------------------------------------------------------
662defproc DefKeyCategory( CategoryName)
663 universal activeaccel
664
665 do once = 1 to 1
666 if CategoryName = '' then
667 leave
668 endif
669 Keyset = activeaccel
670 if Keyset = '' then
671 leave
672 endif
673
674 --LastNum = GetKeysAVar( 'keycatname.0')
675 LastNum = GetKeysAVar( 'keycatname.'Keyset'.0')
676 if LastNum = '' then
677 LastNum = 0
678 endif
679
680 -- Add only new categories for keyset
681 fLeave = 0
682 do n = 1 to LastNum
683 KeyCat = GetKeysAVar( 'keycatname.'Keyset'.'n)
684 if CategoryName = KeyCat then
685 -- Don't add existing categories
686 fLeave = 1
687 leave
688 endif
689 enddo
690 if fLeave then
691 leave
692 endif
693
694 LastNum = LastNum + 1
695 --dprintf( 'Keyset = 'Keyset', n = 'LastNum', Category = 'CategoryName)
696 SetKeysAVar( 'keycatname.'Keyset'.'LastNum, CategoryName)
697 SetKeysAVar( 'keycatname.'Keyset'.0', LastNum)
698 enddo
699
700 -- Allow for reset CategoryName if empty
701 SetKeysAVar( 'curkeycatname', CategoryName)
702
703 return
704
705; ---------------------------------------------------------------------------
706; Add KeyString to category array vars
707defproc SaveKeyCat( KeyString)
708 -- Query current key category
709 KeyCat = GetKeysAVar( 'curkeycatname')
710 if KeyCat = '' then
711 KeyCat = 'Miscellaneous'
712 endif
713 Keyset = GetKeysAVar( 'curkeysetcmd')
714 if Keyset <> '' then
715 -- Query previous category array var for KeyString
716 PrevKeyCat = GetKeysAVar( 'keycat.'Keyset'.'KeyString)
717 -- Process only, if change required
718 if PrevKeyCat <> KeyCat then
719 -- Remove KeyString from previous category list
720 DelKeysAVar( 'catkeys.'Keyset'.'PrevKeyCat, KeyString)
721 -- Add KeyString to category list
722 AddKeysAVar( 'catkeys.'Keyset'.'KeyCat, KeyString)
723 -- Save key def in array to allow for searching for KeyString and KeyCat
724 SetKeysAVar( 'keycat.'Keyset'.'KeyString, KeyCat)
725 endif
726 endif
727 return
728
729; ---------------------------------------------------------------------------
730; Remove KeyString from category array vars
731defproc DelKeyCat( KeyString)
732 Keyset = GetKeysAVar( 'curkeysetcmd')
733 if Keyset <> '' then
734 -- Query previous category array var for KeyString
735 PrevKeyCat = GetKeysAVar( 'keycat.'Keyset'.'KeyString)
736 -- Remove KeyString from previous category list
737 DelKeysAVar( 'catkeys.'Keyset'.'PrevKeyCat, KeyString)
738 -- Remove var name from array
739 DropKeysAVar( 'keycat.'Keyset'.'KeyString)
740 endif
741 return
742
743; ---------------------------------------------------------------------------
744defproc GetAFFlags( String, var KeyString, var Char, var Flags)
745 TmpStr = String
746
747 -- Get prefix
748 fC_Prefix = 0
749 fA_Prefix = 0
750 fS_Prefix = 0
751 do l = 1 to length( TmpStr) -- Just an upper limit to prevent looping forever
752 if length( TmpStr) <= 2 then
753 leave
754 endif
755 ch1 = upcase( leftstr( TmpStr, 1))
756 ch2 = substr( TmpStr, 2, 1)
757 p1 = pos( ch1, 'CAS')
758 if not p1 then
759 leave
760 endif
761 p2 = pos( ch2, '_-+')
762 if not p2 then
763 leave
764 endif
765
766 TmpStr = substr( TmpStr, 3)
767 if p1 = 1 then
768 fC_Prefix = 1
769 elseif p1 = 2 then
770 fA_Prefix = 1
771 elseif p1 = 3 then
772 fS_Prefix = 1
773 endif
774 enddo
775
776 -- Char is String without prefix
777 Char = TmpStr
778
779 Flags = 0
780 PrefixString = ''
781 if fC_Prefix = 1 then
782 Flags = Flags + AF_CONTROL -- 16
783 PrefixString = PrefixString'c_'
784 endif
785 if fA_Prefix = 1 then
786 Flags = Flags + AF_ALT -- 32
787 PrefixString = PrefixString'a_'
788 endif
789 if fS_Prefix = 1 then
790 Flags = Flags + AF_SHIFT -- 8
791 PrefixString = PrefixString's_'
792 endif
793
794 -- Try to resolve virtual keys
795 VK = GetVKName( Char)
796
797 -- Build return string
798 if VK = '' then
799 -- If not defined as virtual key, change KeyString to lowercase.
800 -- This allows to use these procs for mouse definitions as well.
801 KeyString = PrefixString''lowcase( Char)
802 else
803 KeyString = PrefixString''VK
804 endif
805
806 return
807
808; ---------------------------------------------------------------------------
809defproc NormalizeKeyString( String)
810 KeyString = ''
811 call GetAFFlags( String, KeyString, Char, Flags)
812 --dprintf( 'NormalizeKeyString( 'arg( 1)'): GetAFFlags( 'String', 'KeyString', 'Char', 'Flags')')
813 return KeyString
814
815; ---------------------------------------------------------------------------
816defproc GetVKConst( String)
817 VK = 0
818 String = upcase( String)
819 if String = 'BREAK' then VK = VK_BREAK
820 elseif String = 'BACKSPACE' then VK = VK_BACKSPACE
821 elseif String = 'BKSPC' then VK = VK_BACKSPACE
822 elseif String = 'TAB' then VK = VK_TAB
823 elseif String = 'BACKTAB' then VK = VK_BACKTAB
824 elseif String = 'NEWLINE' then VK = VK_NEWLINE -- This is the regular Enter key
825 elseif String = 'SHIFT' then VK = VK_SHIFT
826 elseif String = 'CTRL' then VK = VK_CTRL
827 elseif String = 'ALT' then VK = VK_ALT
828 elseif String = 'ALTGRAF' then VK = VK_ALTGRAF
829 elseif String = 'ALTGR' then VK = VK_ALTGRAF
830 elseif String = 'PAUSE' then VK = VK_PAUSE
831 elseif String = 'CAPSLOCK' then VK = VK_CAPSLOCK
832 elseif String = 'ESC' then VK = VK_ESC
833 elseif String = 'SPACE' then VK = VK_SPACE
834 elseif String = 'PAGEUP' then VK = VK_PAGEUP
835 elseif String = 'PGUP' then VK = VK_PAGEUP
836 elseif String = 'PAGEDOWN' then VK = VK_PAGEDOWN
837 elseif String = 'PGDOWN' then VK = VK_PAGEDOWN
838 elseif String = 'PGDN' then VK = VK_PAGEDOWN
839 elseif String = 'END' then VK = VK_END
840 elseif String = 'HOME' then VK = VK_HOME
841 elseif String = 'LEFT' then VK = VK_LEFT
842 elseif String = 'UP' then VK = VK_UP
843 elseif String = 'RIGHT' then VK = VK_RIGHT
844 elseif String = 'DOWN' then VK = VK_DOWN
845 elseif String = 'DN' then VK = VK_DOWN
846 elseif String = 'PRINTSCRN' then VK = VK_PRINTSCRN
847 elseif String = 'INSERT' then VK = VK_INSERT
848 elseif String = 'INS' then VK = VK_INSERT
849 elseif String = 'DELETE' then VK = VK_DELETE
850 elseif String = 'DEL' then VK = VK_DELETE
851 elseif String = 'SCRLLOCK' then VK = VK_SCRLLOCK
852 elseif String = 'NUMLOCK' then VK = VK_NUMLOCK
853 elseif String = 'ENTER' then VK = VK_ENTER -- This is the numeric keypad Enter key
854 elseif String = 'PADENTER' then VK = VK_ENTER -- This is the numeric keypad Enter key
855 elseif String = 'SYSRQ' then VK = VK_SYSRQ
856 elseif String = 'F1' then VK = VK_F1
857 elseif String = 'F2' then VK = VK_F2
858 elseif String = 'F3' then VK = VK_F3
859 elseif String = 'F4' then VK = VK_F4
860 elseif String = 'F5' then VK = VK_F5
861 elseif String = 'F6' then VK = VK_F6
862 elseif String = 'F7' then VK = VK_F7
863 elseif String = 'F8' then VK = VK_F8
864 elseif String = 'F9' then VK = VK_F9
865 elseif String = 'F10' then VK = VK_F10
866 elseif String = 'F11' then VK = VK_F11
867 elseif String = 'F12' then VK = VK_F12
868 endif
869 return VK
870
871; ---------------------------------------------------------------------------
872defproc GetVKName( String)
873 VK = ''
874 String = upcase( String)
875 if String = 'BREAK' then VK = 'break'
876 elseif String = 'BACKSPACE' then VK = 'backspace'
877 elseif String = 'BKSPC' then VK = 'backspace'
878 elseif String = 'TAB' then VK = 'tab'
879 elseif String = 'BACKTAB' then VK = 'backtab'
880 elseif String = 'NEWLINE' then VK = 'newline' -- This is the regular Enter key
881 elseif String = 'SHIFT' then VK = 'shift'
882 elseif String = 'CTRL' then VK = 'ctrl'
883 elseif String = 'ALT' then VK = 'alt'
884 elseif String = 'ALTGRAF' then VK = 'altgraf'
885 elseif String = 'ALTGR' then VK = 'altgraf'
886 elseif String = 'PAUSE' then VK = 'pause'
887 elseif String = 'CAPSLOCK' then VK = 'capslock'
888 elseif String = 'ESC' then VK = 'esc'
889 elseif String = 'SPACE' then VK = 'space'
890 elseif String = 'PAGEUP' then VK = 'pageup'
891 elseif String = 'PGUP' then VK = 'pageup'
892 elseif String = 'PAGEDOWN' then VK = 'pagedown'
893 elseif String = 'PGDOWN' then VK = 'pagedown'
894 elseif String = 'PGDN' then VK = 'pagedown'
895 elseif String = 'END' then VK = 'end'
896 elseif String = 'HOME' then VK = 'home'
897 elseif String = 'LEFT' then VK = 'left'
898 elseif String = 'UP' then VK = 'up'
899 elseif String = 'RIGHT' then VK = 'right'
900 elseif String = 'DOWN' then VK = 'down'
901 elseif String = 'DN' then VK = 'down'
902 elseif String = 'PRINTSCRN' then VK = 'printscrn'
903 elseif String = 'INSERT' then VK = 'insert'
904 elseif String = 'INS' then VK = 'insert'
905 elseif String = 'DELETE' then VK = 'delete'
906 elseif String = 'DEL' then VK = 'delete'
907 elseif String = 'SCRLLOCK' then VK = 'scrllock'
908 elseif String = 'NUMLOCK' then VK = 'numlock'
909 elseif String = 'ENTER' then VK = 'enter' -- This is the numeric keypad Enter key
910 elseif String = 'PADENTER' then VK = 'enter' -- This is the numeric keypad Enter key
911 elseif String = 'SYSRQ' then VK = 'sysrq'
912 elseif String = 'F1' then VK = 'f1'
913 elseif String = 'F2' then VK = 'f2'
914 elseif String = 'F3' then VK = 'f3'
915 elseif String = 'F4' then VK = 'f4'
916 elseif String = 'F5' then VK = 'f5'
917 elseif String = 'F6' then VK = 'f6'
918 elseif String = 'F7' then VK = 'f7'
919 elseif String = 'F8' then VK = 'f8'
920 elseif String = 'F9' then VK = 'f9'
921 elseif String = 'F10' then VK = 'f10'
922 elseif String = 'F11' then VK = 'f11'
923 elseif String = 'F12' then VK = 'f12'
924 endif
925 return VK
926
927; ---------------------------------------------------------------------------
928const
929; Also added to ENGLISH.E
930compile if not defined( NEWLINE_KEY__MSG)
931 NEWLINE_KEY__MSG = 'Newline'
932compile endif
933
934defproc GetVKMenuName( String)
935 VK = ''
936 String = upcase( String)
937 if String = 'BREAK' then VK = 'Brk'
938 elseif String = 'BACKSPACE' then VK = BACKSPACE_KEY__MSG
939 elseif String = 'BKSPC' then VK = BACKSPACE_KEY__MSG
940 elseif String = 'TAB' then VK = 'Tab'
941 elseif String = 'BACKTAB' then VK = 'BackTab'
942 elseif String = 'NEWLINE' then VK = NEWLINE_KEY__MSG -- This is the regular Enter key
943 elseif String = 'SHIFT' then VK = SHIFT_KEY__MSG
944 elseif String = 'CTRL' then VK = CTRL_KEY__MSG
945 elseif String = 'ALT' then VK = ALT_KEY__MSG
946 elseif String = 'ALTGRAF' then VK = 'AltGraf'
947 elseif String = 'ALTGR' then VK = 'AltGraf'
948 elseif String = 'PAUSE' then VK = 'Pause'
949 elseif String = 'CAPSLOCK' then VK = 'Capslock'
950 elseif String = 'ESC' then VK = ESCAPE_KEY__MSG
951 elseif String = 'SPACE' then VK = 'Space'
952 elseif String = 'PAGEUP' then VK = 'PgUp'
953 elseif String = 'PGUP' then VK = 'PgUp'
954 elseif String = 'PAGEDOWN' then VK = 'PgDown'
955 elseif String = 'PGDOWN' then VK = 'PgDown'
956 elseif String = 'PGDN' then VK = 'PgDown'
957 elseif String = 'END' then VK = 'End'
958 elseif String = 'HOME' then VK = 'Home'
959 elseif String = 'LEFT' then VK = 'Left'
960 elseif String = 'UP' then VK = UP_KEY__MSG
961 elseif String = 'RIGHT' then VK = 'Right'
962 elseif String = 'DOWN' then VK = DOWN_KEY__MSG
963 elseif String = 'DN' then VK = DOWN_KEY__MSG
964 elseif String = 'PRINTSCRN' then VK = 'PrtScrn'
965 elseif String = 'INSERT' then VK = INSERT_KEY__MSG
966 elseif String = 'INS' then VK = INSERT_KEY__MSG
967 elseif String = 'DELETE' then VK = DELETE_KEY__MSG
968 elseif String = 'DEL' then VK = DELETE_KEY__MSG
969 elseif String = 'SCRLLOCK' then VK = 'ScrlLock'
970 elseif String = 'NUMLOCK' then VK = 'NumLock'
971 elseif String = 'ENTER' then VK = PADENTER_KEY__MSG -- This is the numeric keypad Enter key
972 elseif String = 'PADENTER' then VK = PADENTER_KEY__MSG -- This is the numeric keypad Enter key
973 elseif String = 'SYSRQ' then VK = 'SysRq'
974 elseif String = 'F1' then VK = 'F1'
975 elseif String = 'F2' then VK = 'F2'
976 elseif String = 'F3' then VK = 'F3'
977 elseif String = 'F4' then VK = 'F4'
978 elseif String = 'F5' then VK = 'F5'
979 elseif String = 'F6' then VK = 'F6'
980 elseif String = 'F7' then VK = 'F7'
981 elseif String = 'F8' then VK = 'F8'
982 elseif String = 'F9' then VK = 'F9'
983 elseif String = 'F10' then VK = 'F10'
984 elseif String = 'F11' then VK = 'F11'
985 elseif String = 'F12' then VK = 'F12'
986 endif
987 return VK
988
989; ---------------------------------------------------------------------------
990defproc GetVKString( VkCode)
991 String = ''
992 if VkCode = VK_BREAK then String = 'break'
993 elseif VkCode = VK_BACKSPACE then String = 'backspace'
994 elseif VkCode = VK_TAB then String = 'tab'
995 elseif VkCode = VK_BACKTAB then String = 'backtab'
996 elseif VkCode = VK_NEWLINE then String = 'newline'
997 elseif VkCode = VK_SHIFT then String = 'shift'
998 elseif VkCode = VK_CTRL then String = 'ctrl'
999 elseif VkCode = VK_ALT then String = 'alt'
1000 elseif VkCode = VK_ALTGRAF then String = 'altgraf'
1001 elseif VkCode = VK_PAUSE then String = 'pause'
1002 elseif VkCode = VK_CAPSLOCK then String = 'capslock'
1003 elseif VkCode = VK_ESC then String = 'esc'
1004 elseif VkCode = VK_SPACE then String = 'space'
1005 elseif VkCode = VK_PAGEUP then String = 'pageup'
1006 elseif VkCode = VK_PAGEDOWN then String = 'pagedown'
1007 elseif VkCode = VK_END then String = 'end'
1008 elseif VkCode = VK_HOME then String = 'home'
1009 elseif VkCode = VK_LEFT then String = 'left'
1010 elseif VkCode = VK_UP then String = 'up'
1011 elseif VkCode = VK_RIGHT then String = 'right'
1012 elseif VkCode = VK_DOWN then String = 'down'
1013 elseif VkCode = VK_DOWN then String = 'dn'
1014 elseif VkCode = VK_PRINTSCRN then String = 'printscrn'
1015 elseif VkCode = VK_INSERT then String = 'insert'
1016 elseif VkCode = VK_DELETE then String = 'delete'
1017 elseif VkCode = VK_SCRLLOCK then String = 'scrllock'
1018 elseif VkCode = VK_NUMLOCK then String = 'numlock'
1019 elseif VkCode = VK_ENTER then String = 'padenter'
1020 elseif VkCode = VK_SYSRQ then String = 'sysrq'
1021 elseif VkCode = VK_F1 then String = 'f1'
1022 elseif VkCode = VK_F2 then String = 'f2'
1023 elseif VkCode = VK_F3 then String = 'f3'
1024 elseif VkCode = VK_F4 then String = 'f4'
1025 elseif VkCode = VK_F5 then String = 'f5'
1026 elseif VkCode = VK_F6 then String = 'f6'
1027 elseif VkCode = VK_F7 then String = 'f7'
1028 elseif VkCode = VK_F8 then String = 'f8'
1029 elseif VkCode = VK_F9 then String = 'f9'
1030 elseif VkCode = VK_F10 then String = 'f10'
1031 elseif VkCode = VK_F11 then String = 'f11'
1032 elseif VkCode = VK_F12 then String = 'f12'
1033 endif
1034 return String
1035
1036; ---------------------------------------------------------------------------
1037; Get key def as appendix for a menu item text, with a prepended tab char,
1038; if any text. Supports multiple Cmds, if specified as separate args.
1039defproc MenuAccelString
1040 AccelString = ''
1041 do i = 1 to arg()
1042 Cmd = arg( i)
1043 if Cmd = '' then
1044 iterate
1045 endif
1046
1047 -- Query array var, defined by DefKey
1048 KeyString = strip( GetKeysAVar( 'keycmd.'Cmd))
1049 if KeyString = '' then
1050 iterate
1051 endif
1052
1053 -- A Cmd may have multiple key defs, each appended by a space
1054 do w = 1 to words( KeyString)
1055 Rest = word( KeyString, w)
1056 ThisString = ''
1057 if pos( 'c_', Rest) = 1 then
1058 ThisString = ThisString''CTRL_KEY__MSG'+'
1059 Rest = substr( Rest, 3)
1060 endif
1061 if pos( 'a_', Rest) = 1 then
1062 ThisString = ThisString''ALT_KEY__MSG'+'
1063 Rest = substr( Rest, 3)
1064 endif
1065 if pos( 's_', Rest) = 1 then
1066 ThisString = ThisString''SHIFT_KEY__MSG'+'
1067 Rest = substr( Rest, 3)
1068 endif
1069 if Rest <> '' then
1070 VKString = GetVKMenuName( Rest)
1071 if VKString <> '' then
1072 ThisString = ThisString''VKString
1073 else
1074 ThisString = ThisString''upcase( Rest)
1075 endif
1076 endif
1077 if AccelString <> '' then
1078 AccelString = AccelString' | 'ThisString
1079 else
1080 AccelString = ThisString
1081 endif
1082 enddo
1083 enddo
1084 if AccelString <> '' then
1085 AccelString = \9''AccelString
1086 endif
1087 return AccelString
1088
1089; For testing:
1090defc MenuAccelString
1091 Cmd = strip( arg( 1))
1092 'SayError Menu item text appendix for "'Cmd'" is: |'MenuAccelString( Cmd)'|'
1093
1094; ---------------------------------------------------------------------------
1095; This is for .KEYSET_DEFINITIONS_* files. It converts a KeyString to a
1096; String as used for menu item texts to display the key def.
1097defproc ConvertKeyString( KeyString)
1098 ThisString = ''
1099 Rest = KeyString
1100 do while Rest <> ''
1101 if pos( 'c_', Rest) = 1 then
1102 ThisString = ThisString''CTRL_KEY__MSG'+'
1103 Rest = substr( Rest, 3)
1104 iterate
1105 endif
1106 if pos( 'a_', Rest) = 1 then
1107 ThisString = ThisString''ALT_KEY__MSG'+'
1108 Rest = substr( Rest, 3)
1109 iterate
1110 endif
1111 if pos( 's_', Rest) = 1 then
1112 ThisString = ThisString''SHIFT_KEY__MSG'+'
1113 Rest = substr( Rest, 3)
1114 iterate
1115 endif
1116 if Rest <> '' then
1117 VKString = GetVKMenuName( Rest)
1118 if VKString <> '' then
1119 ThisString = ThisString''VKString
1120 else
1121 CapRest = upcase( leftstr( Rest, 1))''substr( Rest, 2)
1122 ThisString = ThisString''CapRest
1123 endif
1124 Rest = ''
1125 endif
1126 enddo
1127
1128 return ThisString
1129
1130; ---------------------------------------------------------------------------
1131; Called by ProcessCommand in MENU.E
1132defproc ExecAccelKey
1133 parse value( arg( 1)) with KeyString \1 Cmd
1134
1135 call SaveKeyCmd( arg( 1))
1136 fExpanded = ExpandKey()
1137 --dprintf( 'ExecAccelKey: KeyString = 'KeyString', fExpanded = 'fExpanded)
1138
1139 if fExpanded = 0 then
1140 Cmd
1141 endif
1142 return
1143
1144; ---------------------------------------------------------------------------
1145; ExpandKey is called by ExecKeyCmd, ExecAccelKey and ExecMenuItem.
1146defproc ExpandKey
1147 universal expand_on
1148
1149 fExpanded = 0
1150 do once = 1 to 1
1151
1152 -- Check first if any expansion is enabled
1153 KeyPath = '\NEPMD\User\SpecialKeys\MatchFindOpening'
1154 fFindOpening = QueryConfigKey( KeyPath)
1155 KeyPath = '\NEPMD\User\SpecialKeys\MatchInsertPair'
1156 fInsertPair = QueryConfigKey( KeyPath)
1157
1158 if fFindOpening | fInsertPair | expand_on then
1159 -- Ensure that cursor is not within a comment or literal
1160 Mode = GetMode()
1161 if InsideCommentLiteral( Mode) then
1162 leave
1163 endif
1164 endif
1165
1166 if fFindOpening | fInsertPair then
1167 -- Try to expand match char
1168 fExpanded = (ExpandMatchChars() == 1)
1169 if fExpanded = 1 then
1170 leave
1171 endif
1172 endif
1173
1174 if expand_on then
1175 -- Try to expand syntax
1176 fExpanded = (ExpandSyntax() == 1)
1177 if fExpanded = 1 then
1178 leave
1179 endif
1180 endif
1181 enddo
1182
1183 -- fExpanded = 1 must stop further processing in the calling proc.
1184 return fExpanded
1185
1186; ---------------------------------------------------------------------------
1187; Keyset array vars:
1188;
1189; 'keysets' list of defined keysets
1190; 'keyset.'name list of subkeysets (keyset cmds) for keyset name
1191; 'keysetused.'cmdname list of keysets that use cmdname
1192; (this var allows for changing keysets for all
1193; loaded files, not just for newly loaded files)
1194;
1195; Examples with cuakeys active: Examples without cuakeys active:
1196; 'keysets' = 'std shell' 'keysets' = 'std shell'
1197; 'keyset.std' = 'std cua' 'keyset.std' = 'std'
1198; 'keysetused.std' = 'std shell' 'keysetused.std' = 'std shell'
1199; 'keyset.shell' = 'std cua shell' 'keyset.shell' = 'std shell'
1200; 'keysetused.shell' = 'shell' 'keysetused.shell' = 'shell'
1201;
1202; ---------------------------------------------------------------------------
1203; Define a named accel table. It has to be activated with SetKeyset.
1204;
1205; Syntax: DefKeyset [<name>] [<keyset_cmd_1> <keyset_cmd_2> ...]
1206; DefKeyset [<name>] [<name_3>value] <keyset_cmd_4> ...]
1207;
1208; Instead of a keyset cmd, a keyset name can be specified (with 'value'
1209; appended). Then the specified keyset will be extended.
1210defc DefAccel, DefKeyset
1211 universal activeaccel
1212 universal lastkeyaccelid
1213 universal LoadState
1214
1215 -- Default accel table name = 'std' (standard EPM uses 'defaccel')
1216 StdName = 'std'
1217
1218 -- Init accel table defs
1219 StartAccelId = 10000 -- max. = 65534 (65535 is hardcoded as Halt cmd)
1220 if lastkeyaccelid < StartAccelId then
1221 lastkeyaccelid = StartAccelId
1222 activeaccel = StdName
1223 -- Bug in ETK: first def is ignored, therefore add a dummy def here
1224 -- This must be a valid def, otherwise the menu is not loaded at startup:
1225 buildacceltable StdName, 'SayError Ignored!', AF_VIRTUALKEY, VK_ALT, lastkeyaccelid
1226 endif
1227
1228 parse arg Keyset SubKeysets
1229
1230 Keyset = strip( Keyset)
1231 if Keyset = '' | lowcase( Keyset) = 'edit' | lowcase( Keyset) = 'default' then
1232 Keyset = StdName
1233 endif
1234 Keyset = lowcase( Keyset)
1235
1236 SubKeysets = strip( SubKeysets)
1237 SubKeysets = lowcase( SubKeysets)
1238 if SubKeysets = '' then
1239 -- Use default keyset defs
1240 if Keyset = StdName then
1241 SubKeysets = StdName -- use defc stdkeys
1242 else
1243 SubKeysets = StdName'value' Keyset -- extend stdkeys with defc Namekeys
1244 endif
1245 endif
1246
1247 SavedAccel = activeaccel
1248 activeaccel = Keyset
1249 --dprintf( 'DefKeyset: Keyset = 'Keyset', SubKeysets = 'SubKeysets', SavedAccel = 'SavedAccel)
1250
1251 -- Parse keyset definition list and get resolved list of SubKeysets.
1252 -- Keyset command defs have 'keys' appended. In the following, the
1253 -- term 'keyset cmd' means the command without 'keys'. The same applies
1254 -- for the array vars, were the string without 'keys' is used, too.
1255 List = SubKeysets
1256 SubKeysets = ''
1257 do w = 1 to words( List)
1258 SubKeyset = word( List, w)
1259 --dprintf( 'DefKeyset: SubKeyset = 'SubKeyset)
1260 -- Allow for specifying a keyset name instead of a list of keyset defs
1261 -- (e.g. 'stdvalue' instead of 'std cua')
1262 if rightstr( SubKeyset, 5) = 'value' and length( SubKeyset) > 5 then
1263 SubName = leftstr( SubKeyset, length( SubKeyset) - 5)
1264 SubList = GetKeysAVar( 'keyset.'SubName)
1265 do s = 1 to words( SubList)
1266 ThisSubKeyset = word( SubList, s)
1267 SubKeysets = SubKeysets ThisSubKeyset
1268 enddo
1269 else
1270 SubKeysets = SubKeysets SubKeyset
1271 endif
1272 enddo
1273 SubKeysets = strip( SubKeysets)
1274
1275 -- Remove doubled and undefined entries
1276 -- Try to link SubKeysets if not defined
1277 Next = ''
1278 Rest = SubKeysets
1279 do forever
1280 if Rest = '' then
1281 leave
1282 endif
1283 parse value Rest with SubKeyset Rest
1284 SubKeyset = strip( SubKeyset)
1285 Rest = strip( Rest)
1286 if wordpos( SubKeyset, Rest) then
1287 iterate
1288 endif
1289 -- Check if SubKeyset'keys' is defined as defc and
1290 -- maybe link SubKeyset'keys'
1291 fIsDefined = KeysetCmdExists( SubKeyset)
1292 -- Append SubKeyset only if defined
1293 if not fIsDefined then
1294 iterate
1295 endif
1296 Next = Next SubKeyset
1297 enddo
1298 SubKeysets = strip( Next)
1299
1300 if SubKeysets <> '' then
1301 -- Change array vars for this keyset name
1302 PrevSubKeysets = GetKeysAVar( 'keyset.'Keyset)
1303 --dprintf( 'DefKeySet: PrevSubKeysets = 'PrevSubKeysets)
1304 if PrevSubKeysets <> SubKeysets then
1305 -- For all previous keyset commands
1306 do k = 1 to words( PrevSubKeysets)
1307 SubKeyset = word( PrevSubKeysets, k)
1308 -- Remove keyset name from array var for this SubKeyset
1309 DelKeysAVar( 'keysetused.'SubKeyset, Keyset)
1310 enddo
1311 endif
1312
1313 --dprintf( 'DefKeySet: Keyset = 'Keyset', SubKeysets = 'SubKeysets)
1314
1315 -- Set array vars for this keyset name
1316 AddKeysAVar( 'keysets', Keyset)
1317 SetKeysAVar( 'keyset.'Keyset, SubKeysets)
1318
1319 -- Set array var for each keyset command and execute it
1320 do k = 1 to words( SubKeysets)
1321 SubKeyset = word( SubKeysets, k)
1322 -- Add keyset name to array var for this keyset cmd
1323 AddKeysAVar( 'keysetused.'SubKeyset, Keyset)
1324 -- Execute keyset cmd (with 'keys' appended)
1325 SubKeyset'keys'
1326 enddo
1327
1328 -- For Keyset = 'std' write also AddKeyDefs
1329 if Keyset = 'std' then
1330 AddKeyDefs = word( SubKeysets, 2) -- empty for 'std' = 'std'
1331 KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected'
1332 WriteConfigKey( KeyPathSelected, AddKeyDefs)
1333 endif
1334
1335 endif
1336
1337 -- The BlockAlt key subset needn't to be added to the 'keysets' array var
1338 'BlockAltKeys'
1339
1340 activeaccel = SavedAccel
1341
1342; ---------------------------------------------------------------------------
1343defproc KeysetCmdExists( SubKeyset)
1344 fIsDefined = 0
1345
1346 do once = 1 to 1
1347 -- Check if Keyset cmd exists
1348 if isadefc( SubKeyset'keys') then
1349 fIsDefined = 1
1350 leave
1351 endif
1352
1353 -- Check if .EX file exists
1354 findfile ExFile, SubKeyset'keys.ex', 'EPMPATH'
1355 if rc then
1356 leave
1357 endif
1358
1359 -- Check if .EX file is linked
1360 linkedrc = linked( SubKeyset'keys.ex')
1361 if linkedrc >= 0 then
1362 leave
1363 endif
1364
1365 -- Link .EX file
1366 'Link quiet' SubKeyset'keys'
1367 --dprintf( 'KeysetCmdExists: Keyset "'SubKeyset'Keys" linked, rc = 'rc)
1368
1369 -- Check rc from Link if .EX file is linked
1370 if rc < 0 then
1371 leave
1372 endif
1373
1374 -- Check if Keyset cmd exists
1375 if isadefc( SubKeyset'keys') then
1376 fIsDefined = 1
1377 leave
1378 endif
1379 enddo
1380
1381 return fIsDefined
1382
1383; ---------------------------------------------------------------------------
1384; Block Alt and/or AltGr from switching to the menu
1385; PM defines the key F10 to jump to the menu, like Alt and AltGraf.
1386; It can be used instead, if it's not redefined.
1387; To block these PM def, Alt and AltGraf have to be defined with the
1388; AF_LONEKEY flag.
1389defc BlockAltKeys
1390 -- Block Alt and/or AltGr from switching to the menu
1391 -- PM defines the key F10 to jump to the menu, like Alt and AltGraf.
1392 -- It can be used instead, if it's not redefined.
1393 -- To block these PM def, Alt and AltGraf have to be defined with the
1394 -- AF_LONEKEY flag.
1395 -- Redefine every used accel keyset
1396 KeyPath = '\NEPMD\User\SpecialKeys\Alt\BlockLeftAlt'
1397 fBlocked1 = QueryConfigKey( KeyPath)
1398 KeyPath = '\NEPMD\User\SpecialKeys\Alt\BlockRightAlt'
1399 fBlocked2 = QueryConfigKey( KeyPath)
1400
1401 if fBlocked1 = 1 then
1402 DefKeyCategory( 'Block alt keys')
1403 DefKey( 'alt', '', 'L')
1404 else
1405 UnDefKey( 'alt')
1406 endif
1407
1408 if fBlocked2 = 1 then
1409 DefKeyCategory( 'Block alt keys')
1410 DefKey( 'altgraf', '', 'L')
1411 else
1412 UnDefKey( 'altgraf')
1413 endif
1414
1415; ---------------------------------------------------------------------------
1416; Redefine every used accel keyset. This can be used by the menu commands
1417; toggle_block_left_alt_key and toggle_block_right_alt_key to activate the
1418; changed behavior for all loaded keysets.
1419defc RefreshBlockAlt
1420 universal activeaccel
1421
1422 KeyPath = '\NEPMD\User\SpecialKeys\Alt\BlockLeftAlt'
1423 fBlocked1 = QueryConfigKey( KeyPath)
1424 KeyPath = '\NEPMD\User\SpecialKeys\Alt\BlockRightAlt'
1425 fBlocked2 = QueryConfigKey( KeyPath)
1426
1427 SavedAccel = activeaccel
1428 KeySets = strip( GetKeysAVar( 'keysets'))
1429
1430 do w = 1 to words( KeySets)
1431 KeySet = word( KeySets, w)
1432 activeaccel = KeySet
1433
1434 if fBlocked1 = 1 then
1435 DefKeyCategory( 'Block alt keys')
1436 DefKey( 'alt', '', 'L')
1437 else
1438 UnDefKey( 'alt')
1439 endif
1440
1441 if fBlocked2 = 1 then
1442 DefKeyCategory( 'Block alt keys')
1443 DefKey( 'altgraf', '', 'L')
1444 else
1445 UnDefKey( 'altgraf')
1446 endif
1447
1448 enddo
1449 activeaccel = SavedAccel
1450
1451 activateacceltable activeaccel
1452
1453; ---------------------------------------------------------------------------
1454defc DisableSwitchKeyset
1455 universal switchkeysetdisabled
1456 switchkeysetdisabled = 1
1457
1458defc EnableSwitchKeyset
1459 universal switchkeysetdisabled
1460 switchkeysetdisabled = 0
1461
1462; ---------------------------------------------------------------------------
1463defproc ExpandKeyset
1464 parse arg Keyset SubKeysets
1465 Keyset = lowcase( strip( Keyset))
1466 -- Default accel table name = 'std' (standard EPM uses 'defaccel')
1467 if Keyset = '' | Keyset = 'default' then
1468 Keyset = 'std'
1469 endif
1470 SubKeysets = lowcase( strip( SubKeysets))
1471 if SubKeysets = '' then
1472 SubKeysets = GetKeysAVar( 'keyset.'Keyset)
1473 endif
1474 return strip( Keyset SubKeysets)
1475
1476; ---------------------------------------------------------------------------
1477; Init 'std' keyset. This must be executed before executing LoadAccel and
1478; before loading the menu. It is done in CONFIG.E:"defc InitConfig".
1479defc InitStdKeyset
1480 StdName = 'std'
1481 'SetKeyset2' StdName
1482
1483; ---------------------------------------------------------------------------
1484defc LoadAccel
1485 parse arg Args
1486 if Args = '' then
1487 'SetKeyset std'
1488 else
1489 'SetKeyset' Args -- defined in MODEEXEC.E
1490 endif
1491
1492; ---------------------------------------------------------------------------
1493; SetKeyset: defined in MODEEXEC.E, contains mode-specific part, calls:
1494; SetKeyset2: switches keyset and maybe defines it.
1495; Syntax: SetKeyset <keyset_name> [<list_of_keyset_defs>]
1496; Examples:
1497; SetKeyset std switch to keyset 'std'
1498; SetKeyset std std cua define and switch to keyset 'std' = StdKeys and CuaKeys
1499; SetKeyset std std define and switch to keyset 'std' = StdKeys
1500; SetKeyset rexx stdvalue rexx define and switch to keyset 'rexx' = value of 'std' and RexxKeys
1501; SetKeyset rexx switch to keyset 'rexx'
1502defc SetKeyset2
1503 universal activeaccel
1504 universal switchkeysetdisabled
1505 universal keysetchanged
1506 universal menuloaded
1507 universal refreshmenudisabled
1508 universal refreshmenustate
1509
1510 parse value ExpandKeyset( arg( 1)) with Keyset SubKeysets
1511
1512 DefinedKeysets = GetKeysAVar( 'keysets')
1513 KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected'
1514 AddKeyDefs = QueryConfigKey( KeyPathSelected)
1515 PrevSubKeysets = strip( GetKeysAVar( 'keyset.'Keyset))
1516 --dprintf( 'SetKeyset2: args = 'arg( 1)', PrevSubKeysets = 'PrevSubKeysets', '.filename)
1517
1518 -- Parse keyset definition list and get resolved list of SubKeysets.
1519 -- Keyset command defs have 'keys' appended. In the following, the
1520 -- term 'keyset cmd' means the command without 'keys'. The same applies
1521 -- for the array vars, where the string without 'keys' is used, too.
1522 List = SubKeysets
1523 SubKeysets = ''
1524 do w = 1 to words( List)
1525 SubKeyset = word( List, w)
1526 --dprintf( 'SefKeyset2: SubKeyset = 'SubKeyset)
1527 -- Allow for specifying a keyset name instead of a list of keyset defs
1528 -- (e.g. 'stdvalue' instead of 'std cua')
1529 if rightstr( SubKeyset, 5) = 'value' and length( SubKeyset) > 5 then
1530 SubName = leftstr( SubKeyset, length( SubKeyset) - 5)
1531 SubList = GetKeysAVar( 'keyset.'SubName)
1532 do s = 1 to words( SubList)
1533 ThisSubKeyset = word( SubList, s)
1534 SubKeysets = SubKeysets ThisSubKeyset
1535 enddo
1536 else
1537 SubKeysets = SubKeysets SubKeyset
1538 endif
1539 enddo
1540 SubKeysets = strip( SubKeysets)
1541
1542 if SubKeysets = '' then
1543 -- Switch to keyset only
1544 if PrevSubKeysets = '' then
1545 if Keyset = 'std' then
1546 SubKeysets = strip( Keyset AddKeyDefs)
1547 else
1548 SubKeysets = strip( strip( 'std' AddKeyDefs) Keyset)
1549 endif
1550 else
1551 SubKeysets = PrevSubKeysets
1552 endif
1553 else
1554 -- Define keyset
1555 endif
1556
1557 -- Store current keyset in array var and query LastKeyset
1558 LastKeyset = GetKeysAVar( 'lastkeyset')
1559 call SetKeysAVar( 'lastkeyset', Keyset)
1560
1561 --dprintf( 'SetKeyset2: DefinedKeysets = "'DefinedKeysets'", PrevSubKeysets = "'PrevSubKeysets'", SubKeysets = "'SubKeysets'", Keyset = 'Keyset', activeaccel = 'activeaccel)
1562 if wordpos( Keyset, DefinedKeysets) = 0 | SubKeysets <> PrevSubKeysets then
1563 -- Reset category names and keys first.
1564 -- Store Keyset. It is used for to define keyset-specific categories.
1565 -- See definitions for DefKeyCategory and SaveKeyCat procs above.
1566 SetKeysAVar( 'curkeysetcmd', Keyset)
1567
1568 -- Ensure that category is reset before DefKeyset
1569 DefKeyCategory( '')
1570
1571 -- Define keyset
1572 --dprintf( 'SetKeyset2: Define keyset, "DefKeyset' strip( Keyset SubKeysets)'" executed')
1573 'DefKeyset' strip( Keyset SubKeysets)
1574
1575 -- Ensure that category is reset after DefKeyset
1576 DefKeyCategory( '')
1577 endif
1578
1579 do once = 1 to 1
1580 if switchkeysetdisabled then
1581 leave
1582 endif
1583 --dprintf( 'SetKeyset2: SwitchKeyset' Keyset SubKeysets)
1584 -- Switch to keyset
1585 if Keyset <> LastKeyset | SubKeysets <> PrevSubkeysets then
1586 --dprintf( 'SetKeyset2: SwitchKeyset' Keyset SubKeysets)
1587 'SwitchKeyset' Keyset SubKeysets
1588 endif
1589 enddo
1590
1591 -- This is required to update the menu texts, e.g. key mnemonics
1592 -- RefreshMenu slows file switching down.
1593 do once = 1 to 1
1594 if not menuloaded then
1595 leave
1596 elseif Keyset = LastKeyset & SubKeysets = PrevSubkeysets then
1597 leave
1598 endif
1599 -- 'VSyncCursor' was added because of showwindow to keep scroll position
1600 'VSyncCursor'
1601
1602 if refreshmenudisabled <> 1 then
1603 -- Rebuild menu
1604 -- Suppress refresh of submenus
1605 refreshmenustate = 1
1606 'PostMe RefreshMenu' -- PostMe required to make it run properly
1607 --dprintf( '* RefreshMenu executed')
1608 endif
1609 enddo
1610
1611 -- Execute basic mouse defs, not defined in StdKeys
1612 -- Always required to make the mouse work, even at startup
1613 'Mouse_Init'
1614
1615; ---------------------------------------------------------------------------
1616; This ic executed by SetKeyset2.
1617defc SwitchKeyset
1618 universal activeaccel
1619
1620 PrevKeyset = activeaccel
1621 PrevSubKeysets = GetKeysAVar( 'keyset.'PrevKeyset)
1622
1623 parse value ExpandKeyset( arg( 1)) with Keyset SubKeysets
1624 --dprintf( 'SwitchKeyset: args = 'args', Keyset = 'Keyset', SubKeysets = 'SubKeysets)
1625
1626 -- Activate keyset: accelerator keys
1627 --dprintf( 'SwitchKeyset: activeaccel = 'activeaccel', Keyset = 'Keyset)
1628 activeaccel = Keyset
1629 activateacceltable activeaccel
1630
1631 -- Activate keyset: keyset-specific array defs (for ExecKeyCmd)
1632 NonAccelKeys = GetKeysAVar( 'nonaccelkeys')
1633 do w = 1 to words( NonAccelKeys)
1634 KeyString = word( NonAccelKeys, w)
1635 NonAccelKeyDef = GetKeysAVar( 'nonaccelkeydef.'Keyset'.'KeyString)
1636 SetKeysAVar( 'keydef.'KeyString, NonAccelKeyDef)
1637 enddo
1638
1639 -- Switch to previously defined keyset. Redefine menu accel strings.
1640 do k = 1 to words( SubKeysets)
1641 SubKeyset = word( SubKeysets, k)
1642
1643 -- Execute keyset cmd (with 'keys' appended). This calls a set of DefKey
1644 -- procs.
1645 --dprintf( 'SwitchKeyset: Executing "'SubKeyset'keys" for '.filename)
1646 SubKeyset'keys'
1647 enddo
1648 --dprintf( 'SwitchKeyset: Switch keyset, keyset cmds executed: 'Keyset' = 'SubKeysets)
1649
1650; ---------------------------------------------------------------------------
1651defc ReloadKeyset
1652 universal activeaccel
1653
1654 Keyset = activeaccel
1655 SubKeysets = GetKeysAVar( 'keyset.'Keyset)
1656
1657 'DelKeyset'
1658
1659 -- Reset list of defined keysets to make SetKeyset2 execute DefKeyset
1660 call SetKeysAVar( 'keysets', '')
1661
1662 -- Redef key defs
1663 --dprintf( 'ReloadKeyset: SetKeyset2' Keyset SubKeysets)
1664 'SetKeyset2' Keyset SubKeysets
1665
1666; ---------------------------------------------------------------------------
1667defc ShowKeyset
1668 universal activeaccel
1669
1670 parse arg Keyset
1671 if Keyset = '' then
1672 Keyset = activeaccel
1673 endif
1674
1675 TmpFileName = '.KEYSET_DEFINITIONS_'Keyset
1676 getfileid startfid
1677 display -3
1678 if IsFileLoaded( TmpFileName) then
1679 'xcom e /n' TmpFileName -- activate tmp file
1680 else
1681 'xcom e /c' TmpFileName -- create tmp file
1682 deleteline -- delete first line (EPM automatically creates line 1)
1683 endif
1684 getfileid tmpfid
1685 savedlast = .last
1686 .autosave = 0
1687
1688 insertline copies('-', 78), .last + 1
1689 SubKeysets = GetKeysAVar( 'keyset.'Keyset)
1690 insertline 'Keyset: 'Keyset' - Subkeysets: 'SubKeysets, .last + 1
1691 insertline '', .last + 1
1692
1693 LastNum = GetKeysAVar( 'keycatname.'Keyset'.0')
1694 --dprintf( 'LastNum = 'LastNum)
1695 Indent = copies( ' ', 3)
1696 do n = 1 to LastNum
1697 KeyCat = GetKeysAVar( 'keycatname.'Keyset'.'n)
1698 KeyStrings = GetKeysAVar( 'catkeys.'Keyset'.'KeyCat)
1699 if KeyStrings = '' then
1700 iterate
1701 endif
1702
1703 KeyCatText = KeyCat
1704 if KeyCat = 'Newline' then
1705 mmax = 2
1706 else
1707 mmax = 1
1708 endif
1709 do m = 1 to mmax
1710 if KeyCat = 'Newline' then
1711 if m = 1 then
1712 mode = 'stream'
1713 else
1714 mode = 'line'
1715 endif
1716 KeyCatText = KeyCat' in 'mode' mode'
1717 endif
1718 insertline '', .last + 1
1719 insertline Indent''KeyCatText, .last + 1
1720 insertline '', .last + 1
1721
1722 do w = 1 to words( KeyStrings)
1723 KeyString = word( KeyStrings, w)
1724 Cmd = GetKeysAVar( 'keydef.'KeyString)
1725 if Cmd = '' then
1726 Cmd = GetKeysAVar( 'mousedef.'KeyString)
1727 endif
1728
1729 if subword( upcase( Cmd), 1, 1) = 'NEWLINE' then
1730 KeyPath = '\NEPMD\User\SpecialKeys'
1731 if mode = 'stream' then
1732 KeyPath = KeyPath'\Stream'
1733 else
1734 KeyPath = KeyPath'\Line'
1735 endif
1736 KeyPath = KeyPath'\'KeyString
1737 next = QueryConfigKey( KeyPath)
1738 if next = '' then
1739 next = 'Split,KeepIndent'
1740 endif
1741 parse value next with SplitCfg','ColCfg','fCmd','NewlineCmd
1742 if fCmd <> 1 then
1743 fCmd = 0
1744 endif
1745 if fCmd then
1746 Cmd = NewlineCmd
1747 else
1748 Cmd = 'Newline' SplitCfg','ColCfg
1749 endif
1750
1751 elseif wordpos( subword( upcase( Cmd), 1, 1), 'TAB BACKTAB') then
1752 KeyPath = '\NEPMD\User\SpecialKeys\'KeyString
1753 next = QueryConfigKey( KeyPath)
1754 Cmd = Cmd next
1755 endif
1756
1757 CnvKeyString = ConvertKeyString( KeyString)
1758 -- Longest KeyString = 21
1759 KeyStringSpc = leftstr( KeyString, Max( 21 + length( Indent), length( KeyString)))''Indent
1760 -- Longest CnvKeyString = 24
1761 CnvKeyStringSpc = leftstr( CnvKeyString, Max( 24 + length( Indent), length( CnvKeyString)))''Indent
1762 -- Display only converted KeyString and Cmd columns:
1763 insertline Indent''Indent''CnvKeyStringSpc''Cmd, .last + 1
1764 -- Display an additional KeyString column:
1765 --insertline Indent''Indent''KeyStringSpc''CnvKeyStringSpc''Cmd, .last + 1
1766 enddo
1767 enddo
1768 enddo
1769 insertline '', .last + 1
1770 tmpfid.modify = 0
1771 --activatefile tmpfid
1772 .cursory = 4 -- Scroll almost to the top (must come before setting the line)
1773 .line = savedlast + 1
1774 .col = 1
1775 display 3
1776
1777; ---------------------------------------------------------------------------
1778; This must be used instead of the internally defined deleteaccel statement.
1779; Disadvantage: This closes the menu, even if nodismiss is set for a menu
1780; item. This is caused by the array var procs, because they switch
1781; temporarily to a hidden file.
1782defc DeleteAccel, DelKeyset
1783 universal activeaccel
1784 if arg( 1) = '' | lowcase( arg( 1)) = 'defaccel' then
1785 Keyset = activeaccel
1786 else
1787 Keyset = arg( 1)
1788 endif
1789 Keyset = lowcase( Keyset)
1790 deleteaccel Keyset
1791 activeaccel = ''
1792
1793 -- Change array vars for this keyset name
1794 DelKeysAVar( 'keysets', Keyset)
1795 SubKeysets = GetKeysAVar( 'keyset.'Keyset)
1796 -- For all keyset commands
1797 do k = 1 to words( SubKeysets)
1798 SubKeyset = word( SubKeysets, k)
1799 -- Remove keyset name from array var for this keyset cmd
1800 DelKeysAVar( 'keysetused.'SubKeyset, Keyset)
1801 enddo
1802 DropKeysAVar( 'keyset.'Keyset)
1803
1804 -- For all categories
1805 LastNum = GetKeysAVar( 'keycatname.'Keyset'.0')
1806 do n = 1 to LastNum
1807 KeyCat = GetKeysAVar( 'keycatname.'Keyset'.'n)
1808 KeyStrings = GetKeysAVar( 'catkeys.'Keyset'.'KeyCat)
1809 if KeyStrings = '' then
1810 iterate
1811 endif
1812
1813 -- For all keystrings
1814 do w = 1 to words( KeyStrings)
1815 KeyString = word( KeyStrings, w)
1816
1817 -- Remove KeyString array vars
1818 Cmd = GetKeysAVar( 'keydef.'KeyString)
1819 if Cmd = '' then
1820 Cmd = GetKeysAVar( 'mousedef.'KeyString)
1821 DelKeysAVar( 'mousecmd.'Cmd, KeyString)
1822 DropKeysAVar( 'mousedef.'KeyString)
1823 else
1824 DelKeysAVar( 'keycmd.'Cmd, KeyString)
1825 DropKeysAVar( 'keydef.'KeyString)
1826 endif
1827
1828 -- Remove KeyString from category list
1829 DelKeysAVar( 'catkeys.'Keyset'.'KeyCat, KeyString)
1830 -- Remove var name from array
1831 DropKeysAVar( 'keycat.'Keyset'.'KeyString)
1832 enddo
1833
1834 enddo
1835
1836; ---------------------------------------------------------------------------
1837; Ensure that default entry is present in AddKeyDefsList
1838definit
1839 'InitAddKeyDefs'
1840
1841defc InitAddKeyDefs
1842 DefaultNameList = lowcase( 'cua') -- only basenames without 'keys'
1843
1844 KeyPathList = '\NEPMD\User\Keysets\AddKeyDefs\List'
1845 KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected'
1846 AddKeyDefsList = QueryConfigKey( KeyPathList)
1847 SelectedAddKeyDefs = QueryConfigKey( KeyPathSelected)
1848
1849 -- Remove 'keys' from SelectedAddKeyDefs
1850 if rightstr( SelectedAddKeyDefs, 4) = 'keys' then
1851 parse value SelectedAddKeyDefs with SelectedAddKeyDefs'keys'
1852 --dprintf( 'definit: Write to NEPMD.INI: SelectedAddKeyDefs = 'SelectedAddKeyDefs)
1853 WriteConfigKey( KeyPathSelected, SelectedAddKeyDefs)
1854 endif
1855
1856 -- Remove 'keys' from every word of AddKeyDefsList
1857 List = ''
1858 do w = 1 to words( AddKeyDefsList)
1859 Next = word( AddKeyDefsList, w)
1860 parse value Next with Next'keys'
1861 List = strip( List Next)
1862 enddo
1863 if AddKeyDefsList <> List then
1864 WriteConfigKey( KeyPathList, List)
1865 endif
1866
1867 -- Maybe add every item of DefaultNameList to AddKeyDefsList
1868 List = AddKeyDefsList
1869 do w = 1 to words( DefaultNameList)
1870 ThisName = word( DefaultNameList, w)
1871 if not wordpos( ThisName, List) then
1872 List = strip( List ThisName)
1873 endif
1874 enddo
1875 if List <> AddKeyDefsList then
1876 WriteConfigKey( KeyPathList, List)
1877 endif
1878
1879; ---------------------------------------------------------------------------
1880; Also called in NEWMENU.E.
1881defproc GetAddKeyDefs
1882 KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected'
1883 SelectedAddKeyDefs = QueryConfigKey( KeyPathSelected)
1884 return SelectedAddKeyDefs
1885
1886; ---------------------------------------------------------------------------
1887defc RemoveAddKeyDefs
1888 KeyPathList = '\NEPMD\User\Keysets\AddKeyDefs\List'
1889 KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected'
1890
1891 AddKeyDefs = strip( arg( 1))
1892 AddKeyDefsList = QueryConfigKey( KeyPathList)
1893 SelectedAddKeyDefs = QueryConfigKey( KeyPathSelected)
1894
1895 if linked( AddKeyDefs'keys') > 0 then
1896 'unlink' AddKeyDefs'keys'
1897 endif
1898
1899 -- Remove from list
1900 wp = wordpos( AddKeyDefs, AddKeyDefsList)
1901 if wp > 0 then
1902 AddKeyDefsList = SpaceStr( DelWord( AddKeyDefsList, wp, 1))
1903 WriteConfigKey( KeyPathList, AddKeyDefsList)
1904 endif
1905
1906 -- Remove from macroadd.lst
1907 call DeleteFromMacroListFile( AddKeyDefs'keys')
1908
1909 if AddKeyDefs = SelectedAddKeyDefs then
1910 'SetAddKeyDefs' -- reset
1911 endif
1912
1913; ---------------------------------------------------------------------------
1914defc SetAddKeyDefs
1915 universal activeaccel
1916
1917 KeyPathList = '\NEPMD\User\Keysets\AddKeyDefs\List'
1918 KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected'
1919
1920 AddKeyDefs = strip( arg( 1))
1921 --dprintf( 'SetAddKeyDefs: arg( 1) = 'arg( 1))
1922 AddKeyDefsList = QueryConfigKey( KeyPathList)
1923 SelectedAddKeyDefs = QueryConfigKey( KeyPathSelected)
1924 DefinedKeysets = GetKeysAVar( 'keysets')
1925
1926 -- Save current keyset
1927 SavedKeyset = activeaccel
1928 getfileid fid
1929 CurKeyset = GetKeysAVar( fid'.keyset')
1930 CurSubKeysets = GetKeysAVar( 'keyset.'CurKeyset)
1931 --dprintf( 'SetAddKeyDefs: CurKeyset = 'CurKeyset', CurSubKeysets = 'CurSubKeysets', activeaccel = 'activeaccel)
1932
1933 -- Nothing changed: don't process further
1934 if AddKeyDefs = SelectedAddKeyDefs then
1935 --dprintf( 'SetAddKeyDefs: AddKeyDefs = 'AddKeyDefs', SelectedAddKeyDefs = 'SelectedAddKeyDefs)
1936 return
1937 endif
1938
1939 -- Delete all key defs first and re-apply all defs of main keyset
1940 'DisableSwitchKeyset'
1941
1942 -- Reset list of defined keysets to make SetKeyset2 execute DefKeyset.
1943 -- The keyset of the current file is defined and switched immediately.
1944 -- For all other files in the ring that is processed on their next
1945 -- select event.
1946 call SetKeysAVar( 'keysets', '')
1947
1948 -- Reset keyset 'std'
1949 --dprintf( 'SetAddKeyDefs: Reset keyset std, execute SetKeyset2 std std')
1950 'SetKeyset2 std std'
1951
1952 'EnableSwitchKeyset'
1953
1954 -- Change list of subkeysets and define each key def
1955 do w = 1 to words( DefinedKeysets)
1956 Keyset = word( DefinedKeysets, w)
1957 SubKeysets = strip( GetKeysAVar( 'keyset.'Keyset))
1958 --dprintf( 'SetAddKeyDefs: w = 'w', Keyset = 'Keyset', SubKeysets = 'SubKeysets', AddKeyDefs = 'AddKeyDefs', SelectedAddKeyDefs = 'SelectedAddKeyDefs)
1959
1960 -- Remove previous add. keydefs name first
1961 wp = wordpos( SelectedAddKeyDefs, SubKeysets)
1962 if wp > 0 then
1963 SubKeysets = SpaceStr( delword( SubKeysets, wp, 1))
1964 endif
1965
1966 -- Add add. keydefs name next after 'std'
1967 if AddKeyDefs <> '' then
1968 wp = wordpos( 'std', SubKeysets)
1969 LeftWords = subword( SubKeysets, 1, wp)
1970 RightWords = subword( SubKeysets, wp + 1)
1971 SubKeysets = SpaceStr( LeftWords AddKeyDefs RightWords)
1972 endif
1973
1974 if Keyset = SavedKeyset then
1975 --dprintf( 'SetAddKeyDefs: 1) execute SetKeyset' Keyset SubKeysets)
1976 'SetKeyset' Keyset SubKeysets -- active, redefine and exec keyset cmds
1977 else
1978 --dprintf( 'SetAddKeyDefs: 2) call SetKeysAVar( keyset.'Keyset', 'SubKeysets')')
1979 call SetKeysAVar( 'keyset.'Keyset, SubKeysets) -- not active, just redefine
1980 endif
1981 enddo
1982
1983 call WriteConfigKey( KeyPathSelected, AddKeyDefs)
1984
1985; ---------------------------------------------------------------------------
1986; Open a listbox to select aditional key defs. The additional defs must be
1987; placed in a separate E file, without using the defkeys statement. When
1988; simply linking such a file, all special keysets for already loaded files
1989; would be lost and the keyset EDIT_KEYS is set for all loaded files.
1990; Therefore EPM will be restarted to make the changes take effect as
1991; expected. For unlinking a key def file, no restart is required.
1992defc SelectKeyDefs
1993 universal activeaccel
1994
1995 None = '-none-'
1996
1997 parse arg Action Basename
1998 Action = upcase( Action)
1999 lp = lastpos( '\', strip( Basename))
2000 Basename = substr( Basename, lp + 1)
2001 Basename = lowcase( Basename)
2002 if Basename = '' then
2003 elseif rightstr( Basename, 2) = '.e' then
2004 Basename = leftstr( Basename, length( Basename) - 2)
2005 elseif rightstr( Basename, 3) = '.ex' then
2006 Basename = leftstr( Basename, length( Basename) - 3)
2007 endif
2008 if rightstr( Basename, 4) <> 'keys' then
2009 Basename = Basename'keys'
2010 endif
2011
2012 -- Read available files from NEPMD.INI
2013 KeyPathList = '\NEPMD\User\Keysets\AddKeyDefs\List'
2014 KeyPathSelected = '\NEPMD\User\Keysets\AddKeyDefs\Selected'
2015 AddKeyDefsList = QueryConfigKey( KeyPathList) -- space-separated list
2016 SelectedAddKeyDefs = QueryConfigKey( KeyPathSelected)
2017 SelectedAddKeyDefs = lowcase( SelectedAddKeyDefs)
2018 if SelectedAddKeyDefs = '' then
2019 SelectedAddKeyDefs = None
2020 endif
2021
2022 if Action = 'ADD' & Basename <> '' then
2023 parse value Basename with NextAddKeyDefs'keys'
2024 CompleteKeysetNames = 'std'
2025 if wordpos( NextAddKeyDefs, CompleteKeysetNames) then
2026 Title = 'Adding additional key definitions'
2027 Text = 'This file "'NextAddKeyDefs'keys.e" defines the'
2028 Text = Text' "'NextAddKeyDefs'" keyset. It''s not a'
2029 Text = Text' file with additional keyset definitions, but'
2030 Text = Text' defines a basic keyset instead.'\n\n
2031 Text = Text'You may want to start with a renamed copy of'
2032 Text = Text' cuakeys.e instead.'
2033 Style = MB_OKCANCEL+MB_WARNING+MB_DEFBUTTON1+MB_MOVEABLE
2034 rcx = WinMessageBox( Title,
2035 Text,
2036 Style)
2037 if rcx = MBID_OK then
2038 -- Open this dialog again
2039 'postme SelectKeyDefs'
2040 return
2041 else -- Cancel
2042 return
2043 endif
2044 endif
2045 if not wordpos( NextAddKeyDefs, AddKeyDefsList) then
2046 AddKeyDefsList = strip( AddKeyDefsList NextAddKeyDefs)
2047 WriteConfigKey( KeyPathList, AddKeyDefsList)
2048 endif
2049
2050 if not IsExFileInternal( Basename) then
2051 Title = 'Adding additional key definitions'
2052 Text = 'For the additional key definition macro "'Basename'" no'
2053 Text = Text || ' entry in a LST file was found. In order to make'
2054 Text = Text || ' the RecompileNew macro aware of that file, it'
2055 Text = Text || ' should be added to "macroadd.lst".'\n\n
2056 Text = Text || 'Should the entry be added automatically?'
2057 Style = MB_YESNO+MB_QUERY+MB_DEFBUTTON1+MB_MOVEABLE
2058 rcx = WinMessageBox( Title,
2059 Text,
2060 Style)
2061 if rcx = 6 then -- Yes
2062 call AddToMacroListFile( Basename)
2063 if rc <> 0 then
2064 'SayError Error: AddToMacroListFile( 'Basename') returned rc = 'rc
2065 return
2066 endif
2067 elseif rcx = 7 then -- No
2068 endif
2069 endif
2070
2071 Title = 'Adding additional key definitions'
2072 Text = 'Before the macro file "'Basename'" can be loaded,'
2073 Text = Text || ' it has to be compiled.'\n\n
2074 Text = Text || 'Should RecompileNew be called now?'
2075 Style = MB_YESNO+MB_WARNING+MB_DEFBUTTON1+MB_MOVEABLE
2076 rcx = WinMessageBox( Title,
2077 Text,
2078 Style)
2079 if rcx = 6 then -- Yes
2080 -- Execute RecompileNew and open this dialog again
2081 'RecompileNew'
2082 'postme SelectKeyDefs'
2083 return
2084 elseif rcx = 7 then -- No
2085 endif
2086 endif
2087
2088 -- Open listbox
2089 Sep = '/'
2090 -- Add None first
2091 Entries = Sep''None
2092 do w = 1 to words( AddKeyDefsList)
2093 Next = word( AddKeyDefsList, w)'keys'
2094 -- Add Next with 'keys' appended
2095 Entries = Entries''Sep''Next
2096 enddo
2097
2098 DefaultItem = 1
2099 if SelectedAddKeyDefs <> '' then
2100 wp = wordpos( SelectedAddKeyDefs, AddKeyDefsList)
2101 if wp > 0 then
2102 DefaultItem = wp + 1
2103 endif
2104 endif
2105 DefaultButton = 1
2106 HelpId = 0
2107 Title = 'Select additional key definitions'copies( ' ', 20)
2108 Text = 'Current key def additions:' SelectedAddKeyDefs
2109
2110 refresh
2111 Result = ListBox( Title,
2112 Entries,
2113 '/~Set/~Add.../~Edit/~Remove/'CANCEL__MSG, -- buttons
2114 0, 0, --5, 5, -- top, left,
2115 Min( words( AddKeyDefsList), 15), 50, -- height, width
2116 GethWndC( APP_HANDLE) || atoi( DefaultItem) ||
2117 atoi( DefaultButton) || atoi( HelpId) ||
2118 Text\0)
2119 refresh
2120
2121 -- Check result
2122 button = asc( leftstr( Result, 1))
2123 EOS = pos( \0, Result, 2) -- CHR(0) signifies End Of String
2124 Selected = substr( Result, 2, EOS - 2)
2125 if button = 1 then -- Set
2126 if Selected = None then
2127 'SetAddKeyDefs'
2128 if isadefproc( 'MenuText_keydefs') then
2129 MenuText_keydefs()
2130 endif
2131 Msg = 'No keyset additions file active.'
2132 'SayHint' Msg
2133 else
2134 -- Check if .E file exists
2135 findfile EFile, Selected'.e', 'EPMPATH'
2136 if rc then
2137 -- Check if .EX file exists
2138 findfile EFile, Selected'.ex', 'EPMPATH'
2139 if rc then
2140 'SayError Key definition file 'upcase( Selected)'.E or 'upcase( Selected)'.EX not found.'
2141 rc = 2
2142 return
2143 endif
2144 endif
2145 parse value lowcase( Selected) with AddKeyDefs'keys'
2146 'SetAddKeyDefs' AddKeyDefs
2147 if isadefproc( 'MenuText_keydefs') then
2148 MenuText_keydefs()
2149 endif
2150 Msg = 'Keyset additions file 'upcase( Selected)'.EX activated.'
2151 'SayHint' Msg
2152 endif
2153 elseif button = 2 then -- Add
2154 -- Open fileselector to select an e or ex filename
2155 -- Call this Cmd again, but with args to renew the list
2156 Text = 'Select a file with additional key definitions'
2157 'FileDlg 'Text', SelectKeyDefs ADD, 'Get_Env('NEPMD_USERDIR')'\macros\?*keys.e'
2158 rc = 0
2159 return
2160 elseif button = 3 & Selected <> None then -- Edit
2161 -- Load file
2162 'EditCreateUserMacro 'Selected'.e'
2163 return rc
2164 elseif button = 4 & Selected <> None then -- Remove
2165 parse value lowcase( Selected) with AddKeyDefs'keys'
2166 -- Confirm remove from list
2167 if MBID_YES = WinMessageBox( 'Remove keyset addition entry', -- title
2168 'You''re about to remove' Selected 'from the list.' \n ||
2169 ARE_YOU_SURE__MSG,
2170 MB_YESNO + MB_QUERY + MB_DEFBUTTON2 + MB_MOVEABLE) then
2171 -- Remove from list
2172 'RemoveAddKeyDefs' AddKeyDefs
2173 if isadefproc( 'MenuText_keydefs') then
2174 MenuText_keydefs()
2175 endif
2176 endif
2177 -- Call this Cmd again
2178 'SelectKeyDefs'
2179 else -- Cancel
2180 endif
2181
2182; ---------------------------------------------------------------------------
2183; Definitions used for key commands
2184; ---------------------------------------------------------------------------
2185
2186; ---------------------------------------------------------------------------
2187; This command allows to define 2 commands, separated by a bar char. The
2188; first command applies in stream mode and the second in line mode.
2189defc StreamLine
2190 universal stream_mode
2191 parse arg cmd1'|'cmd2
2192 cmd1 = strip( cmd1)
2193 cmd2 = strip( cmd2)
2194 if stream_mode then
2195 cmd1
2196 else
2197 cmd2
2198 endif
2199
2200; ---------------------------------------------------------------------------
2201defproc Shifted
2202 universal curkey
2203
2204 -- Works for WM_CHAR messages:
2205 ks = getkeystate( VK_SHIFT)
2206 fshifted1 = (ks <> 3 & ks <> 4)
2207
2208 -- Works for accelerator keys:
2209 parse value curkey with KeyString \1 Cmd
2210 fshifted2 = (pos( 's_', KeyString) > 0)
2211
2212 return (fshifted1 | fshifted2)
2213
2214; ---------------------------------------------------------------------------
2215defproc UpDownKey( DownFlag)
2216 universal save_cursor_column
2217 universal cursoreverywhere
2218 universal prevkey
2219
2220 NumLines = arg( 2)
2221 if NumLines = '' then
2222 NumLines = 1
2223 elseif not IsNum( NumLines) then
2224 NumLines = 1
2225 endif
2226
2227 parse value prevkey with PrevKeyString \1 .
2228 fupdown = (wordpos( PrevKeyString, 'up down s_up s_down') > 0)
2229 if not cursoreverywhere then
2230 if not fupdown then
2231 save_cursor_column = .col
2232 endif
2233 endif
2234
2235 if DownFlag then
2236 do n = 1 to NumLines
2237 down
2238 enddo
2239 else
2240 do n = 1 to NumLines
2241 up
2242 enddo
2243 endif
2244
2245 if .line & not cursoreverywhere then
2246 l = length( textline( .line))
2247 if fupdown & l >= save_cursor_column then
2248 .col = save_cursor_column
2249 elseif fupdown | l < .col then
2250 endline
2251 endif
2252 endif
2253
2254; ---------------------------------------------------------------------------
2255defproc ScrollUpDownKey( DownFlag)
2256
2257 NumLines = arg( 2)
2258 if NumLines = '' then
2259 NumLines = 1
2260 elseif not IsNum( NumLines) then
2261 NumLines = 1
2262 endif
2263
2264 if DownFlag then
2265 do n = 1 to NumLines
2266 oldcursory = .cursory
2267 if .line - .cursory + .windowheight < .last then
2268 .cursory = .windowheight
2269 down
2270 .cursory = oldcursory
2271 elseif .line < .last then
2272 down
2273 endif
2274 enddo
2275 else
2276 oldcursory = .cursory
2277 do n = 1 to NumLines
2278 if .line - .cursory > -1 then
2279 .cursory = 1
2280 up
2281 .cursory = oldcursory
2282 elseif .line then
2283 up
2284 endif
2285 enddo
2286 endif
2287
2288; ---------------------------------------------------------------------------
2289defproc Extend_Mark( startline, startcol, forward)
2290 universal cursoreverywhere
2291 universal curkey
2292
2293 KeyPath = '\NEPMD\User\Mark\ShiftMarkAlwaysExtends'
2294 fAlwaysExtend = (QueryConfigKey( KeyPath) = 1)
2295 getfileid curfileid
2296 getmarkg firstline, lastline, firstcol, lastcol, markfileid
2297 parse value curkey with CurKeyString \1 .
2298 fs_up = (CurKeyString = 's_up')
2299 fs_down = (CurKeyString = 's_down')
2300
2301 funmark = 1
2302 if markfileid <> curfileid then
2303 funmark = 1
2304 elseif QueryUnmarkOnAnyKey() then
2305 -- keep mark and extend it (any unshifted key caused unmark before)
2306 funmark = 0
2307 elseif fAlwaysExtend then
2308 -- keep mark and extend it
2309 funmark = 0
2310
2311 -- The following was added for the feature "Shift-Mark extends at mark
2312 -- boundaries only" (== "Shift-mark extends always" = deactivated):
2313 elseif not cursoreverywhere then
2314 if startline = firstline & startcol = firstcol then
2315 funmark = 0
2316 elseif startline = lastline & startcol = lastcol then
2317 funmark = 0
2318 endif
2319 elseif cursoreverywhere then
2320 l = length( textline( startline))
2321 if startline = firstline & startcol = firstcol then
2322 funmark = 0
2323 elseif startline = firstline & startcol > firstcol & startcol > l + 1 then
2324 funmark = 0
2325 elseif startline = firstline + 1 & firstcol = 0 then
2326 -- apparently never reached
2327 funmark = 0
2328 elseif startline = lastline & startcol = lastcol then
2329 funmark = 0
2330 elseif startline = lastline & startcol > lastcol & startcol > l + 1 then
2331 funmark = 0
2332 elseif startline = lastline - 1 & lastcol = 0 then
2333 funmark = 0
2334 endif
2335 endif
2336
2337 if funmark then
2338 unmark
2339 endif
2340
2341 if not marktype() then
2342 call pSet_Mark( startline, .line, startcol, .col, 'CHARG', curfileid)
2343 return
2344 endif
2345
2346 if (fs_up & .line = firstline - 1) | (fs_down & .line = firstline + 1) then
2347 if length( textline( firstline)) < .col then
2348 firstcol = .col
2349 endif
2350 endif
2351
2352 if startline > firstline | ((startline = firstline) & (startcol > firstcol)) then -- at end of mark
2353 if not forward then
2354 if firstline = .line & firstcol = .col then
2355 unmark
2356 return
2357 endif
2358 endif
2359 call pSet_Mark( firstline, .line, firstcol, .col, 'CHARG', curfileid)
2360 else -- at beginning of mark
2361 if forward then
2362 if lastline = .line & lastcol = .col - 1 then
2363 unmark
2364 return
2365 endif
2366 endif
2367 call pSet_Mark( lastline, .line, lastcol, .col, 'CHARG', curfileid)
2368 endif
2369
2370; ---------------------------------------------------------------------------
2371; c_home, c_end, c_left & c_right do different things if the shift key is depressed.
2372; The logic is extracted here mainly due to the complexity of the COMPILE IF's
2373defproc Begin_Shift( var startline, var startcol, var shift_flag)
2374; unused
2375/*
2376 universal cua_marking_switch
2377 shift_flag = Shifted()
2378 if shift_flag or not cua_marking_switch then
2379 startline = .line; startcol = .col
2380 else
2381 unmark
2382 endif
2383*/
2384
2385; ---------------------------------------------------------------------------
2386defproc End_Shift( startline, startcol, shift_flag, forward_flag)
2387; unused
2388/*
2389; Make this work regardless of which marking mode is active:
2390compile if 0 -- WANT_CUA_MARKING = 'SWITCH'
2391 universal cua_marking_switch
2392 if shift_flag & cua_marking_switch then
2393compile else
2394 if shift_flag then
2395compile endif
2396 call Extend_Mark( startline, startcol, forward_flag)
2397 endif
2398*/
2399
2400; ---------------------------------------------------------------------------
2401; For compatibility.
2402defproc Process_Mark_Like_Cua
2403 fMarkDeleted = ReplaceMark()
2404 if fMarkDeleted then
2405 rcx = 1
2406 else
2407 rcx = ''
2408 endif
2409 return rcx
2410
2411; ---------------------------------------------------------------------------
2412defc SwitchMarkingMode
2413 universal menuloaded
2414 universal cua_marking_switch
2415
2416 NewMarkingMode = upcase( strip( leftstr( arg( 1), 1)))
2417 CurrentMarkingMode = QueryMarkingMode()
2418 if NewMarkingMode <> CurrentMarkingMode then
2419 if NewMarkingMode = 'A' then
2420 'ApplyMarkingBitStr' GetDefaultMarkingBitStr( 'ADV')
2421 elseif NewMarkingMode = 'C' then
2422 'ApplyMarkingBitStr' GetDefaultMarkingBitStr( 'CUA')
2423 endif
2424
2425 -- For compatibility
2426 if NewMarkingMode = 'C' then
2427 cua_marking_switch = 1
2428 else
2429 cua_marking_switch = 0
2430 endif
2431
2432 -- Refresh display
2433 'RefreshInfoLine MARKINGMODE'
2434
2435 -- Refresh menus
2436 if menuloaded then
2437 -- Set menu attributes and text for the case MIA_NODISMISS attribute is on
2438 if GetMenuAVar( 'mid_mark') then
2439 'menuinit_mark'
2440 endif
2441 -- The menu from where the action stems can't be queried with activemenu.
2442 -- After opening the 'prefspopup' menu, the universal is switched back to
2443 -- 'default'.
2444 if GetMenuAVar( 'mid_basicconfig') then
2445 'menuinit_basicconfig'
2446 'menuinit_markingsettings'
2447 endif
2448 endif
2449 endif
2450
2451; ---------------------------------------------------------------------------
2452; Returns 'A' | 'C' | ''
2453defproc QueryMarkingMode
2454 CurrentMarkingMode = ''
2455 CurrentMarkingBitStr = GetCurrentMarkingBitStr()
2456 -- E precision is max. 9 digits, DigitComp is required
2457 fAdvancedMarking = not DigitComp( CurrentMarkingBitStr,
2458 GetDefaultMarkingBitStr( 'ADV'))
2459 fCuaMarking = not DigitComp( CurrentMarkingBitStr,
2460 GetDefaultMarkingBitStr( 'CUA'))
2461 if fAdvancedMarking then
2462 CurrentMarkingMode = 'A'
2463 elseif fCuaMarking then
2464 CurrentMarkingMode = 'C'
2465 endif
2466 return CurrentMarkingMode
2467
2468; ---------------------------------------------------------------------------
2469defproc GetCurrentMarkingBitStr
2470 KeyPath = '\NEPMD\User\Mark\DefaultPaste'
2471 DefaultPaste = QueryConfigKey( KeyPath)
2472
2473 KeyPath = '\NEPMD\User\Mark\ShiftMarkAlwaysExtends'
2474 fShiftMarkExtends = QueryConfigKey( KeyPath)
2475
2476 KeyPath = '\NEPMD\User\Mark\LineInsert'
2477 InsertMarkedLines = QueryConfigKey( KeyPath)
2478
2479 KeyPath = '\NEPMD\User\Mark\ReplaceMark'
2480 fReplaceMark = QueryConfigKey( KeyPath)
2481
2482 KeyPath = '\NEPMD\User\Mark\DirectMarkActions'
2483 fDirectMarkActions = QueryConfigKey( KeyPath)
2484
2485 KeyPath = '\NEPMD\User\Mark\UnmarkOnAnyKey'
2486 fUnmarkOnAnyKey = QueryConfigKey( KeyPath)
2487
2488 KeyPath = '\NEPMD\User\Mark\UnmarkAfterMove'
2489 fUnmarkAfterMove = QueryConfigKey( KeyPath)
2490
2491 KeyPath = '\NEPMD\User\Mark\DefaultMouseMark'
2492 DefaultMouseMark = QueryConfigKey( KeyPath)
2493
2494 KeyPath = '\NEPMD\User\Mark\GoToMousePos'
2495 fGoToMouseMark = QueryConfigKey( KeyPath)
2496
2497 KeyPath = '\NEPMD\User\MB1DoubleClick\Mark'
2498 DoubleClickMarks = QueryConfigKey( KeyPath)
2499
2500 f4os2MouseMark = Query4os2MouseMark()
2501
2502 KeyPath = '\NEPMD\User\MB1DoubleClick\UnmarkOnSpace'
2503 fDoubleClickUnmarks = QueryConfigKey( KeyPath)
2504
2505 KeyPath = '\NEPMD\User\SearchDialog\SearchMarkIfMarked'
2506 fSearchMarkIfMarked = QueryConfigKey( KeyPath)
2507
2508 KeyPath = '\NEPMD\User\SearchDialog\SearchMarkedWords'
2509 fSearchMarkedWords = QueryConfigKey( KeyPath)
2510
2511 CurrentMarkingBitStr = '' ||
2512 DefaultPaste ||
2513 fShiftMarkExtends ||
2514 InsertMarkedLines ||
2515 fReplaceMark ||
2516 fDirectMarkActions ||
2517 fUnmarkOnAnyKey ||
2518 fUnmarkAfterMove ||
2519 DefaultMouseMark ||
2520 fGoToMouseMark ||
2521 DoubleClickMarks ||
2522 f4os2MouseMark ||
2523 fDoubleClickUnmarks ||
2524 fSearchMarkIfMarked ||
2525 fSearchMarkedWords
2526
2527 return CurrentMarkingBitStr
2528
2529; -------------------------------------------------------------------------------------- Preferences ------------------
2530const
2531compile if not defined( PRESET_BITSTR_USER_CUA)
2532 PRESET_BITSTR_USER_CUA = 011100000
2533compile endif
2534compile if not defined( PRESET_BITSTR_PROG_CUA)
2535 PRESET_BITSTR_PROG_CUA = 101111111
2536compile endif
2537compile if not defined( PRESET_BITSTR_PROG_STD)
2538 PRESET_BITSTR_PROG_STD = 100011111
2539compile endif
2540compile if not defined( MARKING_BITSTR_ADV)
2541 MARKING_BITSTR_ADV = '???01 0? ?0?? 1 ??'
2542compile endif
2543compile if not defined( MARKING_BITSTR_CUA)
2544 MARKING_BITSTR_CUA = 'C0A10 10 C1W? 0 ??'
2545compile endif
2546
2547; ---------------------------------------------------------------------------
2548defproc GetDefaultMarkingBitStr
2549 MarkingType = upcase( arg( 1))
2550 DefaultMarkingBitStr = ''
2551 if MarkingType = 'ADV' then
2552 DefaultMarkingBitStr = MARKING_BITSTR_ADV
2553 elseif MarkingType = 'CUA' then
2554 DefaultMarkingBitStr = MARKING_BITSTR_CUA
2555 endif
2556 return DefaultMarkingBitStr
2557
2558; ---------------------------------------------------------------------------
2559defc ApplyMarkingBitStr
2560 do once = 1 to 1
2561
2562 -- Query CurrentMarkingBitStr
2563 CurrentMarkingBitStr = SpaceStr( arg( 1), 0)
2564 -- Check CurrentMarkingBitStr
2565 if length( CurrentMarkingBitStr) <>
2566 length( SpaceStr( GetDefaultMarkingBitStr( 'ADV'), 0)) then
2567 leave
2568 endif
2569 -- Parse CurrentMarkingBitStr
2570 DefaultPaste = substr( CurrentMarkingBitStr, 1, 1)
2571 fShiftMarkExtends = substr( CurrentMarkingBitStr, 2, 1)
2572 InsertMarkedLines = substr( CurrentMarkingBitStr, 3, 1)
2573 fReplaceMark = substr( CurrentMarkingBitStr, 4, 1)
2574 fDirectMarkActions = substr( CurrentMarkingBitStr, 5, 1)
2575 fUnmarkOnAnyKey = substr( CurrentMarkingBitStr, 6, 1)
2576 fUnmarkAfterMove = substr( CurrentMarkingBitStr, 7, 1)
2577 DefaultMouseMark = substr( CurrentMarkingBitStr, 8, 1)
2578 fGoToMouseMark = substr( CurrentMarkingBitStr, 9, 1)
2579 DoubleClickMarks = substr( CurrentMarkingBitStr, 10, 1)
2580 f4os2MouseMark = substr( CurrentMarkingBitStr, 11, 1)
2581 fDoubleClickUnmarks = substr( CurrentMarkingBitStr, 12, 1)
2582 fSearchMarkIfMarked = substr( CurrentMarkingBitStr, 13, 1)
2583 fSearchMarkedWords = substr( CurrentMarkingBitStr, 14, 1)
2584
2585 -- Apply bits
2586
2587 KeyPath = '\NEPMD\User\Mark\DefaultPaste'
2588 if DefaultPaste = '?' then
2589 -- nop
2590 elseif DefaultPaste <> QueryConfigKey( KeyPath) then
2591 WriteConfigKey( KeyPath, DefaultPaste)
2592 RefreshMenuAccelString( 'paste')
2593 RefreshMenuAccelString( 'pastelines')
2594 RefreshMenuAccelString( 'pasteblock')
2595 endif
2596
2597 KeyPath = '\NEPMD\User\Mark\ShiftMarkAlwaysExtends'
2598 if fShiftMarkExtends = '?' then
2599 -- nop
2600 elseif fShiftMarkExtends <> QueryConfigKey( KeyPath) then
2601 'toggle_shift_mark_extends'
2602 endif
2603
2604 KeyPath = '\NEPMD\User\Mark\LineInsert'
2605 if InsertMarkedLines = '?' then
2606 -- nop
2607 elseif InsertMarkedLines <> QueryConfigKey( KeyPath) then
2608 'toggle_lineinsert'
2609 endif
2610
2611 if fReplaceMark = '?' then
2612 -- nop
2613 else
2614 'SwitchReplaceMark 'fReplaceMark
2615 endif
2616
2617 if fDirectMarkActions = '?' then
2618 -- nop
2619 else
2620 'SwitchDirectMarkActions 'fDirectMarkActions
2621 endif
2622
2623 if fUnmarkOnAnyKey = '?' then
2624 -- nop
2625 else
2626 'SwitchUnmarkOnAnyKey 'fUnmarkOnAnyKey
2627 endif
2628
2629 KeyPath = '\NEPMD\User\Mark\UnmarkAfterMove'
2630 if fUnmarkAfterMove = '?' then
2631 -- nop
2632 elseif fUnmarkAfterMove <> QueryConfigKey( KeyPath) then
2633 'toggle_unmark_after_move'
2634 endif
2635
2636 if DefaultMouseMark = '?' then
2637 -- nop
2638 else
2639 'SwitchDefaultMouseMark 'DefaultMouseMark
2640 endif
2641
2642 if fGoToMouseMark = '?' then
2643 -- nop
2644 else
2645 'SwitchGoToMouseMarkPos 'fGoToMouseMark
2646 endif
2647
2648 if DoubleClickMarks = '?' then
2649 -- nop
2650 else
2651 'SwitchDoubleClickMarks 'DoubleClickMarks
2652 endif
2653
2654 if f4os2MouseMark = '?' then
2655 -- nop
2656 elseif f4os2MouseMark <> Query4os2MouseMark() then
2657 'Toggle4os2MouseMark'
2658 endif
2659
2660 if fDoubleClickUnmarks = '?' then
2661 -- nop
2662 else
2663 'SwitchDoubleClickUnmarks 'fDoubleClickUnmarks
2664 endif
2665
2666 KeyPath = '\NEPMD\User\SearchDialog\SearchMarkIfMarked'
2667 if fSearchMarkIfMarked = '?' then
2668 -- nop
2669 elseif fSearchMarkIfMarked <> QueryConfigKey( KeyPath) then
2670 'toggle_SearchMarkIfMarked'
2671 endif
2672
2673 KeyPath = '\NEPMD\User\SearchDialog\SearchMarkedWords'
2674 if fSearchMarkedWords = '?' then
2675 -- nop
2676 elseif fSearchMarkedWords <> QueryConfigKey( KeyPath) then
2677 'toggle_SearchMarkedWords'
2678 endif
2679
2680 if GetMenuAVar( 'mid_markingsettings') then
2681 'menuinit_markingsettings'
2682 endif
2683 call MH_Set_Mouse()
2684 'ReloadKeyset' -- -> SetKeyset2 -> SwitchKeyset -> RefreshMenu - required for hint text
2685
2686 -- E precision is max. 9 digits, DigitComp is required
2687 if GetMenuAVar( 'mid_advancedmarking') then
2688 SetMenuAttribute( 'advancedmarking', MIA_CHECKED,
2689 DigitComp( CurrentMarkingBitStr, GetDefaultMarkingBitStr( 'ADV')))
2690 endif
2691 if GetMenuAVar( 'mid_cuamarking') then
2692 SetMenuAttribute( 'cuamarking', MIA_CHECKED,
2693 DigitComp( CurrentMarkingBitStr, GetDefaultMarkingBitStr( 'CUA')))
2694 endif
2695
2696 enddo
2697
2698; ---------------------------------------------------------------------------
2699defproc ReplaceMark
2700 do once = 1 to 1
2701 fMarkDeleted = 0
2702
2703 -- Config key
2704 KeyPath = '\NEPMD\User\Mark\ReplaceMark'
2705 fReplaceMark = QueryConfigKey( KeyPath)
2706 if not fReplaceMark then
2707 leave
2708 endif
2709
2710 -- File not marked
2711 if not FileIsMarked() then
2712 if marktype() then
2713 -- Unmark mark in other file
2714 unmark
2715 endif
2716 leave
2717 endif
2718
2719 getmark firstline, lastline, firstcol, lastcol, markfileid
2720 -- Delete mark buffer, see clipbrd.e for details
2721 'Copy2DMBuff'
2722
2723 -- Place cursor and delete mark
2724 firstline
2725 .col = firstcol
2726 call NextCmdAltersText()
2727 call pDelete_Mark()
2728
2729 -- Remove content in EPM shared text buffer
2730 'ClearSharBuff'
2731 fMarkDeleted = 1
2732 enddo
2733 return fMarkDeleted
2734
2735; ---------------------------------------------------------------------------
2736defc SwitchReplaceMark
2737 do once = 1 to 1
2738 KeyPath = '\NEPMD\User\Mark\ReplaceMark'
2739 NewState = upcase( strip( leftstr( arg( 1), 1)))
2740 if NewState = 'T' then
2741 fReplaceMark = QueryConfigKey( KeyPath)
2742 NewState = not fReplaceMark
2743 elseif NewState = 0 then
2744 -- nop
2745 elseif NewState = 1 then
2746 -- nop
2747 else
2748 'SayError SwitchReplaceMark: Undefined arg 'arg( 1)' specified.'
2749 leave
2750 endif
2751 WriteConfigKey( KeyPath, NewState)
2752 if GetMenuAVar( 'mid_replacemark') then
2753 SetMenuAttribute( 'replacemark', MIA_CHECKED, not NewState)
2754 endif
2755 enddo
2756
2757; ---------------------------------------------------------------------------
2758defproc QueryReplaceMark
2759 KeyPath = '\NEPMD\User\Mark\ReplaceMark'
2760 fReplaceMark = QueryConfigKey( KeyPath)
2761 return fReplaceMark
2762
2763; ---------------------------------------------------------------------------
2764defc SwitchDirectMarkActions
2765 do once = 1 to 1
2766 KeyPath = '\NEPMD\User\Mark\DirectMarkActions'
2767 NewState = upcase( strip( leftstr( arg( 1), 1)))
2768 if NewState = 'T' then
2769 fDirectMarkActions = QueryConfigKey( KeyPath)
2770 NewState = not fDirectMarkActions
2771 elseif NewState = 0 then
2772 -- nop
2773 elseif NewState = 1 then
2774 -- nop
2775 else
2776 'SayError SwitchDirectMarkActions: Undefined arg 'arg( 1)' specified.'
2777 leave
2778 endif
2779 WriteConfigKey( KeyPath, NewState)
2780 if GetMenuAVar( 'mid_directmarkactions') then
2781 SetMenuAttribute( 'directmarkactions', MIA_CHECKED, not NewState)
2782 endif
2783 if NewState = 1 then
2784 -- Uncheck 'Unmark on any key'
2785 'SwitchUnmarkOnAnyKey 0'
2786 endif
2787 -- Direct mark menu items (Copy, Move, Overlay, Adjust) are added/removed
2788 'RefreshMenu'
2789 enddo
2790
2791; ---------------------------------------------------------------------------
2792defproc QueryDirectMarkActions
2793 KeyPath = '\NEPMD\User\Mark\DirectMarkActions'
2794 fDirectMarkActions = QueryConfigKey( KeyPath)
2795 return fDirectMarkActions
2796
2797; ---------------------------------------------------------------------------
2798defproc UnmarkOnAnyKey
2799 KeyPath = '\NEPMD\User\Mark\UnmarkOnAnyKey'
2800 fUnmarkOnAnyKey = QueryConfigKey( KeyPath)
2801 if fUnmarkOnAnyKey then
2802 unmark
2803 endif
2804 return fUnmarkOnAnyKey
2805
2806; ---------------------------------------------------------------------------
2807defproc QueryUnmarkOnAnyKey
2808 KeyPath = '\NEPMD\User\Mark\UnmarkOnAnyKey'
2809 fUnmarkOnAnyKey = QueryConfigKey( KeyPath)
2810 return fUnmarkOnAnyKey
2811
2812; ---------------------------------------------------------------------------
2813defc SwitchUnmarkOnAnyKey
2814 do once = 1 to 1
2815 KeyPath = '\NEPMD\User\Mark\UnmarkOnAnyKey'
2816 NewState = upcase( strip( leftstr( arg( 1), 1)))
2817 if NewState = 'T' then
2818 fUnmarkOnAnyKey = QueryConfigKey( KeyPath)
2819 NewState = not fUnmarkOnAnyKey
2820 elseif NewState = 0 then
2821 -- nop
2822 elseif NewState = 1 then
2823 -- nop
2824 else
2825 'SayError SwitchUnmarkOnAnyKey: Undefined arg 'arg( 1)' specified.'
2826 leave
2827 endif
2828 WriteConfigKey( KeyPath, NewState)
2829 if GetMenuAVar( 'mid_unmarkonanykey') then
2830 SetMenuAttribute( 'unmarkonanykey', MIA_CHECKED, not NewState)
2831 endif
2832 if NewState = 1 then
2833 -- Switch 'Direct mark actions' off
2834 'SwitchDirectMarkActions 0'
2835 -- Switch 'Sh-mark always extends' off
2836 'SwitchShiftMarkAlwaysExtends 0'
2837 endif
2838 enddo
2839
2840; ---------------------------------------------------------------------------
2841defc SwitchShiftMarkAlwaysExtends
2842 do once = 1 to 1
2843 KeyPath = '\NEPMD\User\MarkShiftMarkExtends'
2844 NewState = upcase( strip( leftstr( arg( 1), 1)))
2845 if NewState = 'T' then
2846 fShiftMarkAlwaysExtends = QueryConfigKey( KeyPath)
2847 NewState = not fShiftMarkAlwaysExtends
2848 elseif NewState = 0 then
2849 -- nop
2850 elseif NewState = 1 then
2851 -- nop
2852 else
2853 'SayError SwitchShiftMarkAlwaysExtends: Undefined arg 'arg( 1)' specified.'
2854 leave
2855 endif
2856 WriteConfigKey( KeyPath, NewState)
2857 if GetMenuAVar( 'mid_shiftmarkextends') then
2858 SetMenuAttribute( 'shiftmarkextends', MIA_CHECKED, not NewState)
2859 endif
2860 if NewState = 1 then
2861 -- Switch 'Unmark on any key' off
2862 'SwitchUnmarkOnAnyKey 0'
2863 endif
2864 enddo
2865
2866; ---------------------------------------------------------------------------
2867; Moves the cursor to the pos. of the pointer. This is used at the end of
2868; mouse marking. The cursor pos. must be limitted to text pos. or just after
2869; the last column plus line end.
2870defproc GoToMouseMarkPos
2871 do once = 1 to 1
2872 -- This is not active for advanced marking
2873 KeyPath = '\NEPMD\User\Mark\GoToMousePos'
2874 fGoToMousePos = QueryConfigKey( KeyPath)
2875 if not fGoToMousePos then
2876 leave
2877 endif
2878
2879 -- Save horiz. scrolled pels
2880 oldsx = .scrollx
2881
2882 -- Query pointer pos.
2883 call GetPointerPos( MouseLine, MouseCol)
2884 CursorLine = MouseLine
2885 CursorCol = MouseCol
2886
2887 -- Limit CursorLine
2888 if CursorLine < 1 then
2889 KeyPath = '\NEPMD\User\Mark\LineInsert'
2890 LineInsert = QueryConfigKey( KeyPath)
2891 if LineInsert = 'A' then -- above current line
2892 MinCursorLine = 1
2893 else
2894 MinCursorLine = 0
2895 endif
2896 CursorLine = MinCursorLine
2897 endif
2898 if CursorLine > .last then
2899 CursorLine = .last
2900 endif
2901
2902 -- Limit CursorCol
2903 -- If mouse button was released after line end, limit cursor pos.
2904 -- to after line end, like the mark.
2905 CursorLineLen = length( textline( CursorLine))
2906 if CursorCol > CursorLineLen + 2 then
2907 CursorCol = CursorLineLen + 2
2908 endif
2909
2910 -- Set cursor pos.
2911 .lineg = CursorLine -- without scrolling
2912 .col = CursorCol
2913
2914 -- Restore horiz. scrolled pels
2915 .scrollx = oldsx
2916 enddo
2917
2918 return
2919
2920; ---------------------------------------------------------------------------
2921defc SwitchGoToMouseMarkPos
2922 do once = 1 to 1
2923 KeyPath = '\NEPMD\User\Mark\GoToMousePos'
2924 NewState = upcase( strip( leftstr( arg( 1), 1)))
2925 if NewState = 'T' then
2926 fGoToMousePos = QueryConfigKey( KeyPath)
2927 NewState = not fGoToMousePos
2928 elseif NewState = 0 then
2929 -- nop
2930 elseif NewState = 1 then
2931 -- nop
2932 else
2933 'SayError SwitchGoToMouseMarkPos: Undefined arg 'arg( 1)' specified.'
2934 leave
2935 endif
2936 WriteConfigKey( KeyPath, NewState)
2937 if GetMenuAVar( 'mid_gotomousemark') then
2938 SetMenuAttribute( 'gotomousemark', MIA_CHECKED, not NewState)
2939 SetMenuAttribute( 'gotomousemark2', MIA_CHECKED, not NewState)
2940 endif
2941 enddo
2942
2943; ---------------------------------------------------------------------------
2944defproc QueryGoToMouseMarkPos
2945 KeyPath = '\NEPMD\User\Mark\GoToMousePos'
2946 fGoToMouseMarkPos = QueryConfigKey( KeyPath)
2947 return fGoToMouseMarkPos
2948
2949; ---------------------------------------------------------------------------
2950defc SwitchDoubleClickUnmarks
2951 do once = 1 to 1
2952 KeyPath = '\NEPMD\User\MB1DoubleClick\UnmarkOnSpace'
2953 NewState = upcase( strip( leftstr( arg( 1), 1)))
2954 if NewState = 'T' then
2955 fDoubleClickUnmarks = QueryConfigKey( KeyPath)
2956 NewState = not fDoubleClickUnmarks
2957 elseif NewState = 0 then
2958 -- nop
2959 elseif NewState = 1 then
2960 -- nop
2961 else
2962 'SayError SwitchDoubleClickUnmarks: Undefined arg 'arg( 1)' specified.'
2963 leave
2964 endif
2965 WriteConfigKey( KeyPath, NewState)
2966 if GetMenuAVar( 'mid_doubleclickunmarks') then
2967 SetMenuAttribute( 'doubleclickunmarks', MIA_CHECKED, not NewState)
2968 SetMenuAttribute( 'doubleclickunmarks2', MIA_CHECKED, not NewState)
2969 endif
2970 enddo
2971
2972; ---------------------------------------------------------------------------
2973defproc QueryDoubleClickUnmarks
2974 KeyPath = '\NEPMD\User\MB1DoubleClick\UnmarkOnSpace'
2975 fDoubleClickUnmarks = QueryConfigKey( KeyPath)
2976 return fDoubleClickUnmarks
2977
2978; ---------------------------------------------------------------------------
2979defc SwitchDoubleClickMarks
2980 do once = 1 to 1
2981 KeyPath = '\NEPMD\User\MB1DoubleClick\Mark'
2982 NewState = upcase( strip( leftstr( arg( 1), 1)))
2983 if NewState = 'T' then
2984 CurState = upcase( strip( leftstr( QueryConfigKey( KeyPath), 1)))
2985 if CurState = 'W' then
2986 NewState = 'I'
2987 elseif CurState = 'I' then
2988 NewState = 0
2989 else
2990 NewState = 'W'
2991 endif
2992 endif
2993 if NewState = 0 then
2994 Val = 'doesn''t mark'
2995 elseif NewState = 'W' then
2996 Val = 'marks word'
2997 elseif NewState = 'I' then
2998 Val = 'marks identifier'
2999 else
3000 'SayError SwitchDoubleClickMarks: Undefined arg 'arg( 1)' specified.'
3001 leave
3002 endif
3003 WriteConfigKey( KeyPath, NewState)
3004 if GetMenuAVar( 'mid_doubleclickmarks') then
3005 SetMenuVarText( 'doubleclickmarks', Val)
3006 SetMenuVarText( 'doubleclickmarks2', Val)
3007 endif
3008 enddo
3009
3010; ---------------------------------------------------------------------------
3011defproc QueryDoubleClickMarks
3012 KeyPath = '\NEPMD\User\MB1DoubleClick\Mark'
3013 DoubleClickMarks = QueryConfigKey( KeyPath)
3014 return DoubleClickMarks
3015
3016; ---------------------------------------------------------------------------
3017defproc QueryDoubleClickOpensUrl
3018 KeyPath = '\NEPMD\User\MB1DoubleClick\OpenUrl'
3019 DoubleClickOpensUrl = QueryConfigKey( KeyPath)
3020 return DoubleClickOpensUrl
3021
3022; ---------------------------------------------------------------------------
3023defproc QueryDoubleClickDirOpensFile
3024 KeyPath = '\NEPMD\User\MB1DoubleClick\DirOpenFile'
3025 DoubleClickDirOpensFile = QueryConfigKey( KeyPath)
3026 return DoubleClickDirOpensFile
3027
3028; ---------------------------------------------------------------------------
3029defc SwitchDefaultMouseMark
3030 do once = 1 to 1
3031 KeyPath = '\NEPMD\User\Mark\DefaultMouseMark'
3032 NewState = upcase( strip( leftstr( arg( 1), 1)))
3033 if NewState = 'T' then
3034 DefaultMouseMark = QueryConfigKey( KeyPath)
3035 if DefaultMouseMark = 'B' then -- toggle
3036 DefaultMouseMark = 'C'
3037 new = 'char'
3038 else
3039 DefaultMouseMark = 'B'
3040 new = 'block'
3041 endif
3042 elseif NewState = 'B' then
3043 DefaultMouseMark = 'B'
3044 new = 'block'
3045 elseif NewState = 'C' then
3046 DefaultMouseMark = 'C'
3047 new = 'char'
3048 else
3049 'SayError SwitchReplaceMark: Undefined arg 'arg( 1)' specified.'
3050 leave
3051 endif
3052 WriteConfigKey( KeyPath, DefaultMouseMark)
3053 if GetMenuAVar( 'mid_defaultmousemark') then
3054 SetMenuVarText( 'defaultmousemark', new)
3055 SetMenuVarText( 'defaultmousemark2', new)
3056 endif
3057 call MH_Set_Mouse()
3058 enddo
3059
3060; ---------------------------------------------------------------------------
3061defproc DoubleClickMarksWord
3062 do once = 1 to 1
3063 if not .line then
3064 leave
3065 endif
3066
3067 -- Config key
3068 KeyPath = '\NEPMD\User\MB1DoubleClick\MarkWord'
3069 fMarkWord = QueryConfigKey( KeyPath)
3070 if not fMarkWord then
3071 leave
3072 endif
3073
3074 fMouseAfterLine = 0
3075 -- Won't position cursor after line end in stream mode
3076 'MH_GoToLastClick'
3077 MouseCol = .col
3078 endline
3079 if .col <= MouseCol then
3080 fMouseAfterLine = 1
3081 endif
3082
3083 if fMouseAfterLine then
3084 -- Mark only line end
3085 endline
3086 getfileid fid
3087 call pSet_Mark( .line, .line, .col, .col + 1, 'CHAR', fid)
3088 else
3089 --call pMark_Word()
3090 -- pMark_Word doesn't include white space; the following does:
3091 call pBegin_Word()
3092 KeyPath = '\NEPMD\User\Mark\WordMarkType'
3093 WordMarkType = QueryConfigKey( KeyPath)
3094 if WordMarkType = 'B' then
3095 markblock
3096 else
3097 markchar
3098 endif
3099 startcol = .col
3100 tabword
3101 .col = .col - 1
3102 if WordMarkType = 'B' then
3103 markblock
3104 else
3105 markchar
3106 endif
3107 .col = startcol
3108 endif
3109
3110 -- Copy mark to shared text buffer
3111 'Copy2SharBuff'
3112 'MatchFindOnMove'
3113 enddo
3114 return
3115
3116; ---------------------------------------------------------------------------
3117defc ConfigureNewlineCmd
3118 universal newline_enter
3119 universal default_stream_mode
3120
3121 -- Menu item name
3122 miname = arg( 1)
3123 if miname = '' then
3124 miname = 'newline'
3125 endif
3126 key = lowcase( miname)
3127 if newline_enter = 'enter' then
3128 key = ChangeStr( 'newline', key, 'enter')
3129 endif
3130
3131 KeyPath = '\NEPMD\User\SpecialKeys'
3132 if default_stream_mode then
3133 KeyPath = KeyPath'\Stream'
3134 else
3135 KeyPath = KeyPath'\Line'
3136 endif
3137 KeyPath = KeyPath'\'key
3138 next = QueryConfigKey( KeyPath)
3139 if next = '' then
3140 next = 'Split,KeepIndent'
3141 endif
3142 parse value next with SplitCfg','ColCfg','fCmd','Cmd
3143
3144 Title = 'Configure command for 'key
3145 Text = 'Enter an E command:'
3146 Text = Text''copies( ' ', Max( 100 - length(Text), 0))
3147 Buttons = '/~Set/~Reset/'CANCEL__MSG
3148 Entry = Cmd
3149 if rightstr( Entry, 2) <> ':\' then
3150 Entry = strip( Entry, 'T', '\')
3151 endif
3152 parse value EntryBox( Title,
3153 Buttons,
3154 Entry,
3155 '',
3156 '',
3157 atoi( 1) || atoi( 0) || atol( 0) ||
3158 Text) with button 2 Cmd \0
3159 Cmd = strip( Cmd)
3160 if button = \1 then -- Set
3161 -- nop
3162 elseif button = \2 then -- Reset
3163 Cmd = ''
3164 else -- Cancel
3165 return
3166 endif
3167
3168 fCmd = 1
3169 Val = SplitCfg','ColCfg','fCmd','Cmd
3170 WriteConfigKey( KeyPath, Val)
3171 MenuText_newlinesplit( key)
3172
3173; ---------------------------------------------------------------------------
3174defproc GetExpandKeys
3175 KeyPath = '\NEPMD\User\SpecialKeys\ExpandKeys'
3176 ExpandKeys = QueryConfigKey( KeyPath, 'space newline')
3177 return ExpandKeys
3178
3179; ---------------------------------------------------------------------------
3180defproc SetExpandKeys
3181 KeyPath = '\NEPMD\User\SpecialKeys\ExpandKeys'
3182 NewExpandKeys = arg( 1)
3183 if NewExpandKeys <> '' then
3184 call WriteConfigKey( KeyPath, NewExpandKeys)
3185 else
3186 call DeleteConfigKey( KeyPath)
3187 endif
3188 if isadefproc( 'MenuText_syntaxexpansionkeys') then
3189 MenuText_syntaxexpansionkeys()
3190 endif
3191
3192; ---------------------------------------------------------------------------
3193defc SelectExpandKeys
3194 universal nodismiss
3195
3196 CurExpandKeys = GetExpandKeys()
3197
3198 Title = 'Configure syntax expansion keys'
3199 Text = 'Specify e.g. "space newline" or "c_space c_newline":'
3200 Text = Text''copies( ' ', Max( 100 - length( Text), 0))
3201 Buttons = '/~Set/~Reset/'CANCEL__MSG
3202 Entry = CurExpandKeys
3203 parse value EntryBox( Title,
3204 Buttons,
3205 Entry,
3206 '',
3207 '',
3208 atoi( 1) || atoi( 0) || atol( 0) ||
3209 Text) with button 2 NewExpandKeys \0
3210 NewExpandKeys = strip( NewExpandKeys)
3211 if button = \1 then -- Set
3212 -- nop
3213 elseif button = \2 then -- Reset
3214 NewExpandKeys = ''
3215 else -- Cancel
3216 return
3217 endif
3218
3219 if NewExpandKeys <> CurExpandKeys then
3220 call SetExpandKeys( NewExpandKeys)
3221 else
3222 'SayError Syntax expansion keys not changed.'
3223 endif
3224
3225; ---------------------------------------------------------------------------
3226defproc ExpandSyntax()
3227 universal curkey
3228--dprintf( 'ExpandSyntax: curkey = 'curkey)
3229
3230 KeyPath = '\NEPMD\User\SpecialKeys\ExpandKeys'
3231 CurExpandKeys = QueryConfigKey( KeyPath, 'space newline')
3232 fExpanded = 0
3233 parse value curkey with KeyString \1 Cmd
3234 wp = wordpos( KeyString, CurExpandKeys)
3235 if wp = 1 then
3236 fExpanded = ExpandFirstSecond( 0)
3237 elseif wp = 2 then
3238 fExpanded = ExpandFirstSecond( 1)
3239 endif
3240 return fExpanded
3241
3242; ---------------------------------------------------------------------------
3243; Process syntax expansion.
3244defproc ExpandFirstSecond( fSecond)
3245 universal expand_on
3246
3247 fExpanded = 0
3248 getfileid fid
3249 ExpandMode = GetAVar( fid'.expand')
3250 if ExpandMode = 1 then
3251 ExpandMode = GetMode()
3252 endif
3253 --dprintf( 'ExpandFirstSecond( 'fSecond'): expand_on = 'expand_on', ExpandMode = 'ExpandMode)
3254 do once = 1 to 1
3255 if not expand_on then
3256 leave
3257 endif
3258 if ExpandMode = '' then
3259 leave
3260 endif
3261 if wordpos( upcase( ExpandMode), '0 OFF') > 0 then
3262 leave
3263 endif
3264
3265 if fSecond then
3266 ExpandCmd = ExpandMode'SecondExpansion'
3267 else
3268 ExpandCmd = ExpandMode'FirstExpansion'
3269 endif
3270 if isadefc( ExpandCmd) then
3271 ExpandCmd
3272 fExpanded = (rc == 0)
3273 endif
3274 enddo
3275 return fExpanded
3276
3277; ---------------------------------------------------------------------------
3278; rc = 0 after expansion, otherwise rc = 1
3279defc ForceExpansion
3280 universal expand_on
3281
3282 fExpanded = 0
3283 getfileid fid
3284 ExpandMode = GetAVar( fid'.expand')
3285 do once = 1 to 1
3286 if not expand_on then
3287 leave
3288 endif
3289 if ExpandMode = '' then
3290 leave
3291 endif
3292 if wordpos( upcase( ExpandMode), '0 OFF') > 0 then
3293 leave
3294 endif
3295
3296 rc = -1
3297 if isadefc( ExpandMode'FirstExpansion') then
3298 ExpandMode'FirstExpansion force'
3299 endif
3300 if rc <> 0 then
3301 if isadefc( ExpandMode'SecondExpansion') then
3302 ExpandMode'SecondExpansion force'
3303 endif
3304 endif
3305 fExpanded = (rc == 0)
3306 enddo
3307 rc = (fExpanded == 0) -- rc = 1 means: not expanded
3308
3309; ---------------------------------------------------------------------------
3310defproc GetHeaderWidth
3311 KeyPath = '\NEPMD\User\Mode\DEFAULT\HeaderWidth'
3312 DefaultVal = QueryConfigKey( KeyPath)
3313 KeyPath = '\NEPMD\User\Format\HeaderWidth'
3314 HeaderWidth = QueryConfigKey( KeyPath, DefaultVal)
3315 return HeaderWidth
3316
3317; ---------------------------------------------------------------------------
3318defc HeaderWidthDlg
3319 KeyPath = '\NEPMD\User\Format\HeaderWidth'
3320 NewHeaderWidth = arg( 1)
3321 if NewHeaderWidth <> '' then
3322 if IsUInt( NewHeaderWidth) then
3323 call WriteConfigKey( KeyPath, NewHeaderWidth)
3324 return
3325 elseif upcase( NewHeaderWidth) = 'RESET' then
3326 call DeleteConfigKey( KeyPath)
3327 return
3328 endif
3329 endif
3330
3331 CurHeaderWidth = GetHeaderWidth()
3332
3333 Title = 'Select header width'
3334 Text = 'Number of columns used for boxes, center, wrap and syntax expansion:'
3335 Text = Text''copies( ' ', Max( 100 - length( Text), 0))
3336 Buttons = '/~Set/~Reset/'CANCEL__MSG
3337 Entry = CurHeaderWidth
3338 parse value EntryBox( Title,
3339 Buttons,
3340 Entry,
3341 0,
3342 240,
3343 atoi( 1) || atoi( 0) || atol( 0) ||
3344 Text) with button 2 NewHeaderWidth \0
3345 NewHeaderWidth = strip( NewHeaderWidth)
3346 if button = \1 then -- Set
3347 -- nop
3348 elseif button = \2 then -- Reset
3349 NewHeaderWidth = ''
3350 else -- Cancel
3351 return
3352 endif
3353
3354 if NewHeaderWidth <> CurHeaderWidth & IsNum( NewHeaderWidth) then
3355 'HeaderWidthDlg' NewHeaderWidth
3356 else
3357 'HeaderWidthDlg RESET'
3358 endif
3359
3360; ---------------------------------------------------------------------------
3361; Syntax:
3362; FoundLineNum =
3363; WordWithIndentExists( Wrd, IndentLen [, Case [, MaxLines]])
3364; Case = 0 means caseless, the default value is 1 (case-sensitive).
3365; Finds e.g. 'endddo' in next lines with the same indent. Stops at max.
3366; processed lines. Stops if indent is lower. Recognizes comments and
3367; literals. Handles tabs correctly.
3368; This is used by syntax expansion procs.
3369; IndentLen is the length of the blank area after expanding tabs.
3370; Return the found line number. If Wrd is not found, 0 is returned.
3371defproc WordWithIndentExists( Wrd, IndentLen)
3372 Case = arg( 3)
3373 if Case <> 0 then
3374 Case = 1 -- case-sensitive
3375 endif
3376 MaxLines = arg( 4)
3377 if MaxLines = '' then
3378 MaxLines = 100
3379 endif
3380 CurMode = GetMode()
3381
3382 -- Search in comments if the Wrd to search is a comment char itself
3383 fSearchInComments = 0
3384 CommentChars = QueryModeKey( CurMode, 'LineComment')
3385 CommentChars = CommentChars' 'QueryModeKey( CurMode, 'MultiLineCommentStart')
3386 CommentChars = CommentChars' 'QueryModeKey( CurMode, 'MultiLineCommentEnd')
3387 if wordpos( Wrd, CommentChars) then
3388 fSearchInComments = 1
3389 endif
3390
3391 FoundLineNum = 0
3392 --dprintf( 'KeyWord = 'KeyWord', IndentLen = 'IndentLen' ------')
3393 l = .line
3394 do forever
3395 l = l + 1
3396 if l > .last then
3397 leave
3398 endif
3399 if l - .line > MaxLines then
3400 leave
3401 endif
3402
3403 getline NextLineStr, l
3404 NextFirstWrd = word( translate( NextLineStr, ' ', \9), 1)
3405 UpNextFirstWrd = upcase( NextFirstWrd)
3406 pNextFirstWrd = pos( UpNextFirstWrd, upcase( NextLineStr))
3407 NextSpc = leftstr( NextLineStr, Max( 0, pNextFirstWrd - 1)) -- Indent of line with tabs and spaces
3408 NextExpSpc = TabExpandStr( NextSpc, TabWidth, junk)
3409 NextExpSpcLen = length( NextExpSpc)
3410 --InComment = InsideCommentLiteral( GetMode(), l, pNextFirstWrd)
3411 --dprintf( rightstr( l, 2)': NextFirstWrd = 'NextFirstWrd', pNextFirstWrd = 'pNextFirstWrd', NextExpSpcLen = 'NextExpSpcLen', InComment = 'InComment', fSearchInComments = 'fSearchInComments)
3412
3413 if NextFirstWrd = '' then
3414 iterate
3415 elseif not fSearchInComments & InsideCommentLiteral( CurMode, l, pNextFirstWrd) then
3416 iterate
3417 elseif NextExpSpcLen < IndentLen then
3418 leave
3419 elseif NextExpSpcLen > IndentLen then
3420 iterate
3421 else
3422 if Case = 1 then
3423 if NextFirstWrd = Wrd then
3424 FoundLineNum = l
3425 leave
3426 endif
3427 else
3428 if UpNextFirstWrd = upcase( Wrd) then
3429 FoundLineNum = l
3430 leave
3431 endif
3432 endif
3433 endif
3434 enddo
3435 return FoundLineNum
3436
3437; ---------------------------------------------------------------------------
3438defc Space
3439 call NextCmdAltersText( 'S')
3440 call Process_Key( ' ')
3441
3442; ---------------------------------------------------------------------------
3443; This cmd is executed by all key cmds that move the cursor.
3444defc MatchFindOnMove
3445 universal matchchars
3446 universal prevmatchdata
3447
3448 fCallMatch = 0
3449 fFindOnMove = 0
3450 do once = 1 to 1
3451 line = textline( .line)
3452 char = substr( line, .col, 1)
3453
3454 wp = wordpos( char, matchchars)
3455 if wp = 0 then
3456 leave
3457 endif
3458
3459 KeyPath = '\NEPMD\User\SpecialKeys\MatchFindOnMove'
3460 fFindOnMove = QueryConfigKey( KeyPath)
3461 if not fFindOnMove then
3462 leave
3463 endif
3464
3465 Mode = GetMode()
3466 if not InsideComment( Mode) then
3467 fCallMatch = 1
3468 endif
3469 enddo
3470
3471 if fCallMatch then
3472 call AssistMatch( char)
3473 else
3474 -- Reset prevmatchdata
3475 prevmatchdata = ''
3476 endif
3477
3478; ---------------------------------------------------------------------------
3479; Return rc to notify calling SaveKeyCmd to stop further processing.
3480; closing_brace_auto_indent is set in MODEEXEC.E by the setting
3481; 'SetClosingBraceAutoIndent'.
3482defproc ExpandMatchChars
3483 universal curkey
3484 universal matchchars
3485 universal closing_brace_auto_indent
3486 universal expand_on
3487
3488 fExpanded = 0
3489 OpeningChar = ''
3490 ClosingChar = ''
3491 parse value curkey with KeyString \1 Cmd
3492 wp = wordpos( KeyString, matchchars)
3493 fEven = (wp // 2 = 0)
3494
3495 fAutoIndentClosing = 0
3496 if KeyString = '}' then
3497 if closing_brace_auto_indent = 1 then
3498 fAutoIndentClosing = 1
3499 endif
3500 endif
3501
3502 do once = 1 to 1
3503 if wp = 0 then
3504 leave
3505 elseif fEven then
3506 -- KeyString = closing char
3507 OpeningChar = word( matchchars, wp - 1)
3508 ClosingChar = KeyString
3509 ColBefore = .col
3510
3511 if fAutoIndentClosing & expand_on then
3512 if expand_on then
3513 -- Replace current indent with matching indent
3514 call MatchAutoIndentClosing( OpeningChar, ClosingChar)
3515 ColBefore = .col
3516 endif
3517 endif
3518
3519 -- Type closing char and highlight matching opening char
3520 call NextCmdAltersText()
3521 call Process_Keys( ClosingChar)
3522 ColAfter = .col
3523 fExpanded = 1
3524
3525 -- Highlight matching opening char
3526 KeyPath = '\NEPMD\User\SpecialKeys\MatchFindOpening'
3527 fFindOpening = QueryConfigKey( KeyPath)
3528 if not fFindOpening then
3529 leave
3530 endif
3531 .col = ColBefore
3532 call AssistMatch( OpeningChar, ClosingChar)
3533 .col = ColAfter
3534
3535 else
3536 -- KeyString = opening char
3537 OpeningChar = KeyString
3538 ClosingChar = word( matchchars, wp + 1)
3539
3540 KeyPath = '\NEPMD\User\SpecialKeys\MatchInsertPair'
3541 fInsertPair = QueryConfigKey( KeyPath)
3542 if not fInsertPair then
3543 leave
3544 endif
3545
3546 -- Type opening char and closing char and place cursor
3547 -- after opening char.
3548 -- Add closing char only if there's a space, tab, line end
3549 -- or another closing char at current pos.
3550 if insertstate() then
3551 NextChar = substr( textline( .line), .col, length( ClosingChar))
3552 else
3553 NextChar = substr( textline( .line), .col + length( OpeningChar), length( ClosingChar))
3554 endif
3555 if NextChar = '' or NextChar = ' ' or NextChar = \9 or NextChar = ClosingChar then
3556 call NextCmdAltersText()
3557 call Process_Keys( OpeningChar''ClosingChar)
3558 fExpanded = 1
3559 do l = 1 to length( ClosingChar)
3560 left
3561 enddo
3562
3563 -- Highlight matching opening char
3564 KeyPath = '\NEPMD\User\SpecialKeys\MatchFindOpening'
3565 fFindOpening = QueryConfigKey( KeyPath)
3566 if not fFindOpening then
3567 leave
3568 endif
3569 call AssistMatch( OpeningChar, ClosingChar)
3570 endif
3571
3572 endif
3573 enddo
3574 return fExpanded
3575
3576; ---------------------------------------------------------------------------
3577const
3578compile if not defined( MATCH_MAX_LINES)
3579 MATCH_MAX_LINES = 200
3580compile endif
3581compile if not defined( MATCH_MAX_LOOPS)
3582 MATCH_MAX_LOOPS = 50
3583compile endif
3584
3585; ---------------------------------------------------------------------------
3586; Reposition cursor column to prepare typing } for alignment with line of
3587; opening { char.
3588defproc MatchAutoIndentClosing( OpeningChar, ClosingChar)
3589 universal indent
3590
3591 do once = 1 to 1
3592 if not IsNum( indent) then
3593 leave
3594 endif
3595
3596 -- Check if line is blank, before typing }
3597 fLineIsBlank = (verify( textline( .line), ' '\t) == 0)
3598 if not fLineIsBlank then
3599 leave
3600 endif
3601
3602 -- Find indent of matching opening char
3603 display -3 -- turn off non-critical error messages and screen updates
3604 -- Note: SayHint uses temp. 'display -8' to disable message box saving.
3605 -- That results in 'display -11'.
3606 call pSave_Pos( ScreenPos)
3607
3608 startl = .line
3609 getline StartLine
3610 CloseIndent = ''
3611
3612 -- Temporarily type ClosingChar before call of passist to find the opening char
3613 ColBefore = .col
3614 keyin ClosingChar
3615 ColAfter = .col
3616 .col = ColBefore
3617 VerboseLevel = 0
3618 fHighlight = 0
3619 lrc = pAssist( VerboseLevel, fHighlight, MATCH_MAX_LINES, MATCH_MAX_LOOPS)
3620
3621 -- Match found: use indent of line with matched char
3622 if not lrc then
3623 getline ThisLine
3624 p0 = Max( 1, verify( ThisLine, ' '\t))
3625 CloseIndent = p0 - 1
3626 else
3627 -- Keep indent of typed '}'
3628 CloseIndent = ColBefore - 1
3629 endif
3630
3631 -- Restore starting line from before keyin
3632 replaceline StartLine, startl
3633 call pRestore_Pos( ScreenPos)
3634 display 3 -- turn on non-critical error messages and screen updates
3635
3636 -- Set the indent
3637 call pRestore_Pos( ScreenPos)
3638 .col = Max( 1, CloseIndent + 1)
3639 enddo
3640
3641 return
3642
3643; ---------------------------------------------------------------------------
3644defc AdjustMark
3645 call NextCmdAltersText()
3646 call pCommon_Adjust_Overlay('A')
3647
3648; ---------------------------------------------------------------------------
3649defc OverlayMark
3650 call NextCmdAltersText()
3651 if marktype() then
3652 call pCommon_Adjust_Overlay('O')
3653 else -- If no mark, look into shared text buffer
3654 'GetSharBuff O'
3655 endif
3656
3657; ---------------------------------------------------------------------------
3658defc CopyMark
3659 universal stream_mode
3660
3661 -- This creates only a new state if required, not when just the mark
3662 -- has changed
3663 call NextCmdAltersText()
3664
3665 -- Ensure that cursor is on a line > 0
3666 if .line = 0 then
3667 -- Not for insert below
3668 KeyPath = '\NEPMD\User\Mark\LineInsert'
3669 LineInsert = QueryConfigKey( KeyPath)
3670 if LineInsert = 'A' then
3671 if .last = 0 then
3672 insertline '', 1
3673 endif
3674 down
3675 endif
3676 -- Not for line mode
3677 if stream_mode then
3678 .col = 1
3679 endif
3680 endif
3681
3682 if marktype() then
3683 -- Ensure that pos and mark before the action is saved
3684 getfileid fid
3685 StateRange = QueryUndoState()
3686 parse value StateRange with OldestState NewestState
3687 -- Eventually override the previously saved pos and mark
3688 call SetUndoStatePos( fid, NewestState)
3689
3690 call pCopy_Mark()
3691 else
3692 -- If no mark, look into shared text buffer
3693 'GetSharBuff'
3694 endif
3695
3696; ---------------------------------------------------------------------------
3697defc MoveMark
3698 universal stream_mode
3699
3700 -- This creates only a new state if required, not when just the mark
3701 -- has changed
3702 call NextCmdAltersText()
3703
3704 -- Ensure that cursor is on a line > 0
3705 if .line = 0 then
3706 -- Not for insert below
3707 KeyPath = '\NEPMD\User\Mark\LineInsert'
3708 LineInsert = QueryConfigKey( KeyPath)
3709 if LineInsert = 'A' then
3710 if .last = 0 then
3711 insertline '', 1
3712 endif
3713 down
3714 endif
3715 -- Not for line mode
3716 if stream_mode then
3717 .col = 1
3718 endif
3719 endif
3720
3721 -- Ensure that pos and mark before the action is saved
3722 getfileid fid
3723 StateRange = QueryUndoState()
3724 parse value StateRange with OldestState NewestState
3725 -- Eventually override the previously saved pos and mark
3726 call SetUndoStatePos( fid, NewestState)
3727
3728 call pMove_Mark()
3729 KeyPath = '\NEPMD\User\Mark\UnmarkAfterMove'
3730 UnmarkAfterMove = QueryConfigKey( KeyPath)
3731 if UnmarkAfterMove = 1 then
3732 unmark
3733 -- Remove content in shared text buffer
3734 'ClearSharBuff'
3735 endif
3736
3737; ---------------------------------------------------------------------------
3738defc DeleteMark
3739 getmark firstline, lastline, firstcol, lastcol, markfileid
3740 MkType = marktype()
3741 getfileid fileid
3742 if fileid <> markfileid then
3743 'SayError 'MARKED_OTHER__MSG
3744 unmark
3745 endif
3746 -- Position cursor if it was on a marked line
3747 if .line >= firstline & .line <= lastline then
3748 if MkType = 'CHAR' & .line = firstline & .col <= firstcol then
3749 -- nop
3750 elseif MkType = 'BLOCK' & .col <= firstcol then
3751 -- nop
3752 elseif MkType = 'CHAR' | MkType = 'LINE' then
3753 firstline
3754 .col = firstcol
3755 elseif MkType = 'BLOCK' then
3756 .col = firstcol
3757 endif
3758 endif
3759 call NextCmdAltersText()
3760 -- Ensure that pos and mark before the action is saved
3761 getfileid fid
3762 StateRange = QueryUndoState()
3763 parse value StateRange with OldestState NewestState
3764 -- Eventually override the previously saved pos and mark
3765 call SetUndoStatePos( fid, NewestState)
3766
3767 'Copy2DMBuff'
3768 call pDelete_Mark()
3769 'ClearSharBuff' -- Remove content in shared text buffer
3770
3771; ---------------------------------------------------------------------------
3772defc Unmark
3773 unmark
3774 'ClearSharBuff' -- Remove content in shared text buffer
3775
3776; ---------------------------------------------------------------------------
3777defc BeginMark
3778 mt = leftstr( marktype(), 1)
3779 if mt then
3780 getmark firstline, lastline, firstcol, lastcol, fileid
3781 activatefile fileid
3782 fMarkedLineOnScreen = OnScreen( firstline)
3783
3784 call pBegin_Mark()
3785 if mt = 'L' then
3786 .col = 1
3787 endif
3788 -- Ensure that the cursor is within the window area
3789 if not fMarkedLineOnScreen then
3790 'CenterLine'
3791 endif
3792 else
3793 'SayError 'NO_MARK_HERE__MSG
3794 endif
3795
3796; ---------------------------------------------------------------------------
3797defc EndMark
3798 mt = leftstr( marktype(), 1)
3799 if mt then
3800 getmark firstline, lastline, firstcol, lastcol, fileid
3801 activatefile fileid
3802 fMarkedLineOnScreen = OnScreen( lastline)
3803
3804 call pEnd_Mark()
3805 if mt = 'L' then
3806 endline
3807 elseif mt = 'C' then
3808 getmark firstline, lastline, firstcol, lastcol, fileid
3809 if lastcol = 0 then
3810 .lineg = lastline - 1
3811 endline
3812 endif
3813 endif
3814 -- Ensure that the cursor is within the window area
3815 if not fMarkedLineOnScreen then
3816 'CenterLine'
3817 endif
3818 else
3819 'SayError 'NO_MARK_HERE__MSG
3820 endif
3821
3822; ---------------------------------------------------------------------------
3823defc AfterMark
3824 mt = leftstr( marktype(), 1)
3825 if mt then
3826 getmark firstline, lastline, firstcol, lastcol, fileid
3827 activatefile fileid
3828 fMarkedLineOnScreen = OnScreen( lastline)
3829 LastLineStr = textline( lastline)
3830 LastLineLen = length( lastline)
3831
3832 if mt = 'L' then
3833 .lineg = lastline + 1
3834 .col = 1
3835 elseif mt = 'B' then
3836 .lineg = lastline
3837 .col = lastcol + 1
3838 elseif mt = 'C' then
3839 if lastcol = 0 then
3840 .lineg = lastline
3841 .col = 1
3842 elseif lastcol = LastLineLen + 1 then
3843 .lineg = lastline + 1
3844 .col = 1
3845 else
3846 .lineg = lastline
3847 .col = lastcol + 1
3848 endif
3849 endif
3850 -- Ensure that the cursor is within the window area
3851 if not fMarkedLineOnScreen then
3852 'CenterLine'
3853 endif
3854 else
3855 'SayError 'NO_MARK_HERE__MSG
3856 endif
3857
3858; ---------------------------------------------------------------------------
3859; This is a callback command used by drag & drop of a marked area.
3860defc DupMark
3861 Type = upcase( arg( 1))
3862 if Type = 'M' then -- M = move
3863 call NextCmdAltersText()
3864 call pMove_Mark()
3865 elseif Type = 'C' then -- C = copy
3866 call NextCmdAltersText()
3867 if marktype() then
3868 call pCopy_Mark()
3869 else -- If no mark, look into shared text buffer
3870 'GetSharBuff'
3871 endif
3872 elseif Type = 'O' then -- O = overlay
3873 call NextCmdAltersText()
3874 if marktype() then
3875 call pCommon_Adjust_Overlay( 'O')
3876 else -- If no mark, look into shared text buffer
3877 'GetSharBuff O'
3878 endif
3879 elseif Type = 'A' then -- A = adjust
3880 call NextCmdAltersText()
3881 call pCommon_Adjust_Overlay( 'A')
3882 elseif Type = 'U' then -- U = unmark
3883 unmark
3884 'ClearSharBuff'
3885 elseif Type = 'U2' then -- U2 = unmark w/o clearing buffer, for drag/drop
3886 unmark
3887 elseif Type = 'D' then -- D = delete mark
3888 'Copy2DMBuff' -- DMBuff = delete-mark buffer
3889 call NextCmdAltersText()
3890 call pDelete_Mark()
3891 'ClearSharBuff'
3892 elseif Type = 'D2' then -- D2 = delete mark w/o touching buffers, for drag/drop
3893 call NextCmdAltersText()
3894 call pDelete_Mark()
3895 elseif Type = 'P' then -- P = print marked area
3896 call CheckMark() -- verify there is a marked area,
3897 'Print' -- then print it.
3898 endif
3899
3900; ---------------------------------------------------------------------------
3901defc TypeFrameChars
3902 call NextCmdAltersText()
3903 call Process_Keys( 'º Ì É È Ê Í Ë Œ » ¹ Î ³ Ã Ú À Á Ä Â Ù ¿ Ž Å Û ² ± °')
3904
3905; ---------------------------------------------------------------------------
3906defc ShiftLeft
3907 MkType = marktype()
3908 if not MkType then
3909 return
3910 endif
3911 getmark firstline, lastline, firstcol, lastcol, fid
3912 getfileid curfid
3913 if curfid <> fid then
3914 unmark
3915 'SayError 'MARKED_OTHER__MSG
3916 return
3917 endif
3918
3919 call NextCmdAltersText()
3920 if MkType = 'CHAR' then
3921 -- Change to line mark
3922 if lastCol = 0 then
3923 lastLine = lastLine - 1
3924 endif
3925 firstcol = 1
3926 lastcol = MAXCOL
3927 unmark
3928 call pSet_Mark( firstline, lastline, firstcol, lastcol, 'LINE', fid)
3929 endif
3930
3931 -- Get minimum indent of current block
3932 if MkType = 'BLOCK' then
3933 pStart = firstcol
3934 else
3935 pStart = 1
3936 endif
3937 MinIndent = MAXCOL
3938 do l = firstline to lastline
3939 getline LineStr, l
3940 LineStr = substr( LineStr, pStart)
3941 CurIndent = Max( 1, verify( LineStr, ' '\t)) - 1
3942 -- Don't count indent of empty lines
3943 if substr( LineStr, CurIndent + 1) = '' then
3944 iterate
3945 endif
3946 if CurIndent < MinIndent then
3947 MinIndent = CurIndent
3948 endif
3949 enddo
3950 -- Don't delete chars at the left
3951 if MinIndent < 1 then
3952 return
3953 endif
3954
3955 shift_left
3956
3957 if marktype() = 'BLOCK' then -- code by Bob Langer
3958 KeyPath = '\NEPMD\User\Mark\ShiftBlockOnly'
3959 fShiftBlockOnly = QueryConfigKey( KeyPath)
3960 -- If fShiftBlockOnly, then the part after the block is fix,
3961 -- otherwise it will be moved with the block, which is the default.
3962 if fShiftBlockOnly then
3963 getmark fl, ll, fc, lc, fid
3964 call pSet_Mark( fl, ll, lc, MAXCOL, 'BLOCK', fid)
3965 shift_right
3966 call pSet_Mark( fl, ll, fc, lc, 'BLOCK', fid)
3967 endif
3968 endif
3969
3970; ---------------------------------------------------------------------------
3971defc ShiftRight
3972 MkType = marktype()
3973 if not MkType then
3974 return
3975 endif
3976 getmark firstline, lastline, firstcol, lastcol, fid
3977 getfileid curfid
3978 if curfid <> fid then
3979 unmark
3980 'SayError 'MARKED_OTHER__MSG
3981 return
3982 endif
3983
3984 call NextCmdAltersText()
3985 if MkType = 'CHAR' then
3986 -- Change to line mark
3987 if lastCol = 0 then
3988 lastLine = lastLine - 1
3989 endif
3990 firstcol = 1
3991 lastcol = MAXCOL
3992 unmark
3993 call pSet_Mark( firstline, lastline, firstcol, lastcol, 'LINE', fid)
3994 endif
3995
3996 -- Get maximum space after last word in all lines within current block
3997 if MkType = 'BLOCK' then
3998 pEnd = lastcol - 1
3999 MinSpace = MAXCOL
4000 do l = firstline to lastline
4001 getline LineStr, l
4002 LineStr = substr( LineStr, firstcol, lastcol - firstcol + 1)
4003 LineStr = translate( LineStr, ' ', \t)
4004 StrippedLineStr = strip( LineStr, 'T')
4005 CurSpace = length( LineStr) - length( StrippedLineStr)
4006 if CurSpace < MinSpace then
4007 MinSpace = CurSpace
4008 endif
4009 enddo
4010 -- Don't delete chars at the right
4011 if MinSpace < 1 then
4012 return
4013 endif
4014 endif
4015
4016 if marktype() = 'BLOCK' then -- code by Bob Langer
4017 KeyPath = '\NEPMD\User\Mark\ShiftBlockOnly'
4018 fShiftBlockOnly = QueryConfigKey( KeyPath)
4019 -- If fShiftBlockOnly, then the part after the block is fix,
4020 -- otherwise it will be moved with the block, which is the default.
4021 if fShiftBlockOnly then
4022 getmark fl, ll, fc, lc, fid
4023 call pSet_Mark( fl, ll, lc, MAXCOL, 'BLOCK', fid)
4024 shift_left
4025 call pSet_Mark( fl, ll, fc, lc, 'BLOCK', fid)
4026 endif
4027 endif
4028
4029 shift_right
4030
4031; ---------------------------------------------------------------------------
4032defc JoinLines
4033 call NextCmdAltersText()
4034 call JoinLines()
4035 'MatchFindOnMove'
4036
4037; ---------------------------------------------------------------------------
4038defc MarkBlock
4039 getmark firstline, lastline, firstcol, lastcol, markfileid
4040 getfileid fileid
4041 if fileid <> markfileid then
4042 unmark
4043 endif
4044 if wordpos( marktype(), 'LINE CHAR') then
4045 --call pset_mark( firstline, lastline, firstcol, lastcol, BLOCKGMARK, fileid)
4046 unmark
4047 endif
4048 markblock
4049 'Copy2SharBuff' -- Copy mark to shared text buffer
4050
4051; ---------------------------------------------------------------------------
4052defc MarkLine
4053 getmark firstline, lastline, firstcol, lastcol, markfileid
4054 getfileid fileid
4055 if fileid <> markfileid then
4056 unmark
4057 endif
4058 if wordpos( marktype(), 'BLOCK CHAR') then
4059 --call pset_mark( firstline, lastline, firstcol, lastcol, LINEMARK, fileid)
4060 unmark
4061 endif
4062 mark_line
4063 'Copy2SharBuff' -- Copy mark to shared text buffer
4064
4065; ---------------------------------------------------------------------------
4066defc MarkChar
4067 getmark firstline, lastline, firstcol, lastcol, markfileid
4068 getfileid fileid
4069 if fileid <> markfileid then
4070 unmark
4071 endif
4072 if wordpos( marktype(), 'BLOCK LINE') then
4073 --call pset_mark( firstline, lastline, firstcol, lastcol, CHARGMARK, fileid)
4074 unmark
4075 endif
4076 mark_char
4077 'Copy2SharBuff' -- Copy mark to shared text buffer
4078
4079; ---------------------------------------------------------------------------
4080defc ShowCursor
4081 if not OnScreen() then
4082 'CenterLine'
4083 endif
4084
4085 -- Set focus to client
4086 -- EPM bug:
4087 -- On dismissing a popup menu, the focus is often not set back to the edit
4088 -- window. Click into it first. Focus switching was also addded to
4089 -- ShowCursor (Ctrl+.) and ProcessEscape (Esc).
4090 'SetFocusToEditClient'
4091
4092 'PostMe HighlightCursor 1'
4093
4094; ---------------------------------------------------------------------------
4095defc HighlightCursor
4096 universal lastcommand
4097
4098 on = arg( 1)
4099 if not wordpos( on, '0 1') then
4100 KeyPath = '\NEPMD\User\CursorPos\HighlightCursor'
4101 on = QueryConfigKey( KeyPath)
4102 endif
4103
4104 if on = 1 then
4105 circleit 5, .line, .col - 1, .col + 1, 16777220
4106 lastcommand = 'highlightcursor'
4107 endif
4108
4109; ---------------------------------------------------------------------------
4110defc TypeFileName -- Type the full name of the current file
4111 call NextCmdAltersText()
4112 call Process_Keys( .filename)
4113
4114; ---------------------------------------------------------------------------
4115defc TypeDateTime -- Type the current date and time
4116 call NextCmdAltersText()
4117 call Process_Keys( DateTime())
4118
4119; ---------------------------------------------------------------------------
4120defc Select_All, SelectAll
4121 getfileid fid
4122 call pSet_Mark( 1, .last, 1, length( textline( .last)), 'CHAR' , fid)
4123 'Copy2SharBuff' -- Copy mark to shared text buffer
4124
4125; ---------------------------------------------------------------------------
4126defproc ReflowGetAvailableModes
4127 Available = ''
4128 ModeList = NepmdQueryModeList()
4129 do w = 1 to words( ModeList)
4130 ThisMode = word( ModeList, w)
4131 if ThisMode = 'TEXT' then
4132 if length( Available) > 0 then
4133 Available = Available' '
4134 endif
4135 Available = Available''ThisMode
4136 elseif isadefc( 'Reflow'ThisMode) then
4137 if length( Available) > 0 then
4138 Available = Available' '
4139 endif
4140 Available = Available''ThisMode
4141 endif
4142 enddo
4143 return Available
4144
4145; ---------------------------------------------------------------------------
4146; This suffices to add a mode to the reflow list:
4147; Reflow menu items in newmenu should also be defined for a new mode.
4148; Extend menuinit_Reflow and optionally ReflowMenuCmd. ReflowMenuCmd executes
4149; Reflow<selectedmode> if not otherwise defined.
4150defc ReflowCONFIGSYS
4151 'SplitPathLines'
4152
4153; ---------------------------------------------------------------------------
4154; Splits CONFIGSYS path lines at ';' or at '+'.
4155defc SplitPathLines
4156 l = 0
4157 NumSplitDirs = 0
4158 SplitWords = '; +'
4159 SavedModify = .modify
4160 SavedAutoSave = .autosave
4161 .autosave = 0
4162 do forever
4163 l = l + 1
4164 if l > .last then
4165 leave
4166 endif
4167 getline LineStr, l
4168
4169 do w = 1 to words( SplitWords)
4170 SplitWord = word( SplitWords, w)
4171 NumSplitWord = count( SplitWord, LineStr)
4172 if NumSplitWord >= 2 then
4173 parse value LineStr with VarName'='ValueStr
4174 if ValueStr = '' then
4175 leave
4176 endif
4177 replaceline VarName'=', l
4178 rest = ValueStr
4179
4180 NumDirs = 0
4181 do while rest <> ''
4182 PrevRest = rest
4183 -- Parse at SplitWord
4184 parse value rest with ThisDir(SplitWord)rest
4185 -- Append SplitWord if in the original
4186 p = pos( SplitWord, PrevRest)
4187 if p = length( ThisDir) + 1 then
4188 ThisDir = ThisDir''SplitWord
4189 endif
4190 -- Insert ThisDir
4191 NumDirs = NumDirs + 1
4192 insertline ' 'ThisDir, l + NumDirs
4193 enddo
4194 l = l + NumDirs
4195 NumSplitDirs = NumSplitDirs + NumDirs
4196
4197 endif
4198
4199 if l = .last then
4200 leave
4201 else
4202 iterate
4203 endif
4204 enddo
4205 enddo
4206
4207 if NumSplitDirs then
4208 'SayError Split 'NumSplitDirs' dirs. Lines will be reconcatenated on Save.'
4209 .modify = SavedModify
4210 -- Save split state
4211 SetFileAVar( 'splitpathlines', 1)
4212 else
4213 'SayError No line split.'
4214 .modify = SavedModify
4215 endif
4216 .autosave = SavedAutoSave
4217
4218; ---------------------------------------------------------------------------
4219; Joins CONFIGSYS path lines. It stops joining if next line is empty,
4220; has no '=' char or has 'REM ' prepended.
4221; This is executed for files of mode CONFIGSYS on Save.
4222defc JoinPathLines
4223 do once = 1 to 1
4224 -- Ensure to process this only when split before
4225 fLinesSplitBefore = (GetFileAVar( 'splitpathlines'))
4226 if not fLinesSplitBefore then
4227 leave
4228 endif
4229
4230 l = 1
4231 SavedAutoSave = .autosave
4232 .autosave = 0
4233 do forever
4234 if l = .last then
4235 leave
4236 endif
4237
4238 getline LineStr, l
4239 getline NextLineStr, l + 1
4240
4241 if LineStr = '' then
4242 l = l + 1
4243 iterate
4244 elseif NextLineStr = '' then
4245 l = l + 1
4246 iterate
4247 elseif pos( '=', NextLineStr) then
4248 l = l + 1
4249 iterate
4250 elseif wordpos( 'REM', upcase( NextLineStr)) = 1 then
4251 l = l + 1
4252 iterate
4253 else
4254 -- Append NextLineStr
4255 replaceline LineStr''strip( NextLineStr), l
4256 deleteline l + 1
4257 endif
4258 enddo
4259 .autosave = SavedAutoSave
4260
4261 enddo
4262
4263; ---------------------------------------------------------------------------
4264defc ReflowSelectMode
4265 universal lastselectedreflowmode
4266
4267 KeyPath = '\NEPMD\User\Format\Reflow'
4268 SelectedMode = QueryConfigKey( KeyPath'\SpecialMode')
4269 Available = ReflowGetAvailableModes()
4270 Selection = wordpos( SelectedMode, Available) + 1 -- + 1 because -auto- is prepended
4271 Title = 'Select a mode for reflow'copies( ' ', 20)
4272 List = '/-auto-/'translate( Available, '/', ' ')
4273 Text = 'Available reflow modes:'
4274 ret = ListBox( Title,
4275 List,
4276 '/~Set/~Auto/'CANCEL__MSG, -- buttons
4277 0, 0, --5, 5, -- top, left,
4278 Min( words( List), 12), 40, -- height, width
4279 GethWndC( APP_HANDLE) || atoi( Selection) || atoi( 1) || atoi( 0) ||
4280 Text\0)
4281 -- Parse return string
4282 parse value ret with Button 2 Select \0
4283 Button = asc( Button)
4284 if Button = 1 then -- Set
4285 if Select = '-auto-' then
4286 Select = 0
4287 endif
4288 fSwitchSelected = 1
4289 WriteConfigKey( KeyPath'\SpecialMode', Select)
4290 elseif Button = 2 then -- Auto
4291 Select = 0
4292 WriteConfigKey( KeyPath'\SpecialMode', Select)
4293 fSwitchSelected = 1
4294 else -- Cancel
4295 rc = 31
4296 fSwitchSelected = 0
4297 endif
4298
4299 if fSwitchSelected then
4300 WriteConfigKey( KeyPath'\SpecialMode', Select)
4301 if Select = 0 then
4302 SelectedMode = GetMode()
4303 else
4304 SelectedMode = Select
4305 endif
4306 if SelectedMode <> lastselectedreflowmode then
4307 if isadefc( 'RefreshFormatMenu') then
4308 'RefreshFormatMenu'
4309 endif
4310 lastselectedreflowmode = SelectedMode
4311 endif
4312 endif
4313
4314; ---------------------------------------------------------------------------
4315defproc ReflowGetSelectedMode
4316 FallBackMode = 'TEXT'
4317 KeyPath = '\NEPMD\User\Format\Reflow'
4318 SelectedMode = QueryConfigKey( KeyPath'\SpecialMode')
4319 if not SelectedMode then
4320 SelectedMode = GetMode()
4321 endif
4322 Available = ReflowGetAvailableModes()
4323 if not wordpos( SelectedMode, Available) then
4324 SelectedMode = FallBackMode
4325 endif
4326 return SelectedMode
4327
4328; ---------------------------------------------------------------------------
4329defproc ReflowGetReflowMargins
4330 KeyPath = '\NEPMD\User\Mode\TEXT\Reflow'
4331 i = QueryConfigKey( KeyPath'\Margins\Selected')
4332 if i = 1 then
4333 ReflowMargins = '1 'GetHeaderWidth()' 1'
4334 elseif i = 3 then
4335 ReflowMargins = .margins
4336 else
4337 new = QueryConfigKey( KeyPath'\Margins\'i)
4338 ReflowMargins = new
4339 endif
4340 return ReflowMargins
4341
4342; ---------------------------------------------------------------------------
4343defc Reflow2ReflowMargins
4344 ReflowMargins = ReflowGetReflowMargins()
4345 if FileIsMarked() then
4346 'ReflowMark' ReflowMargins
4347 else
4348 'ReflowAll' ReflowMargins
4349 endif
4350
4351; ---------------------------------------------------------------------------
4352defc ReflowAll2ReflowMargins
4353 ReflowMargins = ReflowGetReflowMargins()
4354 'ReflowAll' ReflowMargins
4355
4356; ---------------------------------------------------------------------------
4357; Syntax: reflow_all [<margins>]
4358defc Reflow_All, ReflowAll
4359 call NextCmdAltersText()
4360 Savedmargins = .margins
4361 if arg( 1) <> '' then
4362 .margins = arg( 1)
4363 endif
4364 call pSave_Mark( SavedMark)
4365 call pSave_Pos( SavedPos)
4366 n = 0
4367 display -1
4368 fstopit = 0
4369 top
4370 do forever
4371 getline line
4372 do while line = '' | -- Skip over blank lines or
4373 (lastpos( ':', line) = 1 & pos( '.', line) = length( line)) | -- lines containing only a GML tag or
4374 substr( line, 1, 1) = '.' -- SCRIPT commands
4375 if .line = .last then
4376 fstopit = 1
4377 leave
4378 endif
4379 down
4380 getline line
4381 enddo
4382 if fstopit then
4383 leave
4384 endif
4385 startline = .line
4386 unmark
4387 markline
4388 call pFind_Blank_Line()
4389 if .line <> startline then
4390 up
4391 else
4392 bottom
4393 endif
4394 markline
4395 getmark prevfirstline, prevlastline
4396 n = n + (prevlastline - prevfirstline) + 1
4397 reflow
4398 getmark firstline, lastline
4399 if lastline = .last then
4400 leave
4401 endif
4402 lastline + 1
4403 enddo
4404 display 1
4405 call pRestore_Mark( SavedMark)
4406 call pRestore_Pos( SavedPos)
4407 if arg( 1) <> '' then
4408 .margins = SavedMargins
4409 endif
4410
4411 'SayHint 'n' lines reflowed.'
4412 'HighlightCursor'
4413
4414; ---------------------------------------------------------------------------
4415defc ReflowMark2ReflowMargins
4416 ReflowMargins = ReflowGetReflowMargins()
4417 'ReflowMark' ReflowMargins
4418
4419; ---------------------------------------------------------------------------
4420; Syntax: ReflowMark [<margins>]
4421defc ReflowMark
4422 SavedMarktype = marktype()
4423 mt = strip( leftstr( SavedMarktype, 1))
4424 if mt = '' then
4425 'SayError 'NO_MARK__MSG
4426 stop
4427 endif
4428
4429 getmark firstline, lastline, firstcol, lastcol, fid
4430 getfileid curfid
4431 if curfid <> fid then
4432 unmark
4433 'SayError 'MARKED_OTHER__MSG
4434 stop
4435 endif
4436
4437 if not Check_Mark_On_Screen() then
4438 'SayError 'MARK_OFF_SCREEN__MSG
4439 stop
4440 endif
4441
4442 if mt = 'C' then
4443 -- Change to line mark
4444 if lastCol = 0 then
4445 lastLine = lastLine - 1
4446 endif
4447 firstcol = 1
4448 lastcol = MAXCOL
4449 unmark
4450 call pSet_Mark( firstline, lastline, firstcol, lastcol, 'LINE', fid)
4451 mt = 'L'
4452 endif
4453
4454 SavedMargins = .margins
4455 if arg( 1) <> '' then
4456 .margins = arg( 1)
4457 endif
4458 call NextCmdAltersText()
4459 display -1
4460 n = 0
4461
4462 n = n + (lastline - firstline) + 1
4463 if mt = 'B' then
4464 'box r'
4465 elseif mt = 'L' then
4466 reflow
4467 endif
4468
4469 display 1
4470 if arg( 1) <> '' then
4471 .margins = SavedMargins
4472 endif
4473
4474 'SayHint 'n' marked lines reflowed.'
4475 'HighlightCursor'
4476
4477; ---------------------------------------------------------------------------
4478defc ReflowPar2ReflowMargins
4479 ReflowMargins = ReflowGetReflowMargins()
4480 'ReflowPar' ReflowMargins
4481
4482; ---------------------------------------------------------------------------
4483; Syntax: ReflowPar [<margins>]
4484; Ignores mark. To reflow a marked area, use ReflowMark.
4485defc ReflowPar
4486 saved_margins = .margins
4487 if arg( 1) <> '' then
4488 .margins = arg( 1)
4489 endif
4490 call NextCmdAltersText()
4491 display -1
4492
4493 call Text_Reflow()
4494
4495 display 1
4496 if arg( 1) <> '' then
4497 .margins = saved_margins
4498 endif
4499
4500; ---------------------------------------------------------------------------
4501; Standard text reflow, moved from Alt+P definition in STDKEYS.E.
4502; Only called from Alt+P if no mark exists; users wishing to call
4503; this from their own code must save & restore the mark themselves
4504; if that's desired.
4505defproc Text_Reflow
4506 call NextCmdAltersText()
4507 KeyPath = '\NEPMD\User\Format\Reflow'
4508 ReflowNext = QueryConfigKey( KeyPath'\Par')
4509 if .line then
4510 getline line
4511 if line <> '' then -- If currently on a blank line, don't reflow.
4512 oldcursory = .cursory
4513 oldcursorx = .cursorx
4514 oldline = .line
4515 oldcol = .col
4516 unmark
4517 mark_line
4518 call pFind_Blank_Line()
4519 -- Ver 3.11: Slightly revised test works better with GML sensitivity.
4520 if .line <> oldline then
4521 up
4522 else
4523 bottom
4524 endif
4525 mark_line
4526 reflow
4527 if ReflowNext then
4528 -- Position on next paragraph (like PE)
4529 call pFind_Blank_Line()
4530 for i = .line + 1 to .last
4531 getline line, i
4532 if line <> '' then
4533 .lineg = i
4534 .col = 1
4535 .cursory = oldcursory
4536 .line = i
4537 leave
4538 endif
4539 endfor
4540 else
4541 -- or like old E
4542 getmark firstline, lastline
4543 firstline
4544 .cursory = oldcursory
4545 .cursorx = oldcursorx
4546 oldline
4547 .col = oldcol
4548 endif
4549 unmark
4550 endif
4551 'HighlightCursor'
4552 endif
4553
4554; ---------------------------------------------------------------------------
4555definit -- Variable is null if alt_R is not active.
4556 universal alt_R_active -- For E3/EOS2, it's 1 if alt_R is active.
4557 alt_R_active = '' -- For EPM, it's set to querycontrol(messageline).
4558
4559; ---------------------------------------------------------------------------
4560defc ReflowBlock
4561 universal alt_R_active,tempofid
4562 universal alt_R_space
4563
4564 call NextCmdAltersText()
4565 if alt_R_active <> '' then
4566 call pBlock_Reflow( 1, alt_R_space, tempofid) -- Complete the reflow.
4567 'SetMessageline '\0
4568 'ToggleFrame 2 'alt_R_active -- Restore status of messageline.
4569 alt_R_active = ''
4570 return
4571 endif
4572 if pBlock_Reflow( 0, alt_R_space, tempofid) then
4573 'SayError 'PBLOCK_ERROR__MSG /* HurleyJ */
4574 return
4575 endif
4576; if marktype() <> 'BLOCK' then
4577 unmark
4578; endif
4579 alt_R_active = QueryFrameControl( 2) -- Remember if messageline on or off
4580 'ToggleFrame 2 1' -- Force it on
4581 'SetMessageLine' BLOCK_REFLOW__MSG
4582
4583; ---------------------------------------------------------------------------
4584defc Split
4585 call NextCmdAltersText()
4586 split
4587
4588; ---------------------------------------------------------------------------
4589defc SplitLines
4590 call NextCmdAltersText()
4591 call SplitLines()
4592
4593; ---------------------------------------------------------------------------
4594; Removes all empty lines
4595defc RemoveAllEmptyLines
4596 if FileIsMarked() then
4597 MarkToLineMark()
4598 getmark markfirstline, marklastline, markfirstcol, marklastcol, markfid
4599 FirstLine = markfirstline
4600 LastLine = marklastline
4601 else
4602 FirstLine = 1
4603 LastLine = .last
4604 endif
4605
4606 call NextCmdAltersText()
4607 SavedModify = .modify
4608 pSave_Pos( SavedPos)
4609 n = 0
4610 Line = 1
4611 do forever
4612 if Line > LastLine then
4613 leave
4614 endif
4615 if textline( Line) = '' then
4616 .lineg = Line
4617 deleteline
4618 LastLine = LastLine - 1
4619 n = n + 1
4620 .modify = SavedModify + 1
4621 else
4622 Line = Line + 1
4623 endif
4624 enddo
4625 pRestore_Pos( SavedPos)
4626
4627 'SayHint 'n' lines removed.'
4628
4629; ---------------------------------------------------------------------------
4630; Reduces multiple empty lines to one
4631defc RemoveMultipleEmptyLines
4632 if FileIsMarked() then
4633 MarkToLineMark()
4634 getmark markfirstline, marklastline, markfirstcol, marklastcol, markfid
4635 FirstLine = markfirstline
4636 LastLine = marklastline
4637 else
4638 FirstLine = 1
4639 LastLine = .last
4640 endif
4641
4642 call NextCmdAltersText()
4643 SavedModify = .modify
4644 pSave_Pos( SavedPos)
4645 n = 0
4646 Line = FirstLine
4647 do forever
4648 if Line >= LastLine then
4649 leave
4650 endif
4651 if textline( Line) = '' & textline( Line + 1) = '' then
4652 .lineg = Line
4653 deleteline
4654 LastLine = LastLine - 1
4655 n = n + 1
4656 .modify = SavedModify + 1
4657 else
4658 Line = Line + 1
4659 endif
4660 enddo
4661 pRestore_Pos( SavedPos)
4662
4663 'SayHint 'n' lines removed.'
4664
4665; ---------------------------------------------------------------------------
4666; Ensures that empty lines follow trailing '.' or ':' chars at a line end
4667; and ensures there exist an empty line at the end.
4668defc ReAddEmptyLines
4669 if FileIsMarked() then
4670 MarkToLineMark()
4671 getmark markfirstline, marklastline, markfirstcol, marklastcol, markfid
4672 FirstLine = markfirstline
4673 LastLine = marklastline
4674 else
4675 FirstLine = 1
4676 LastLine = .last
4677 endif
4678
4679 call NextCmdAltersText()
4680 SavedModify = .modify
4681 pSave_Pos( SavedPos)
4682 n = 0
4683 Line = FirstLine
4684 do forever
4685 if Line > LastLine then
4686 leave
4687 elseif Line = LastLine then
4688 insertline '', Line + 1
4689 n = n + 1
4690 .modify = SavedModify + 1
4691 leave
4692 elseif wordpos( rightstr( strip( textline( Line)), 1), '. :') > 0 &
4693 strip( textline( Line + 1)) <> '' then
4694 insertline '', Line + 1
4695 n = n + 1
4696 Line = Line + 2
4697 .modify = SavedModify + 1
4698 else
4699 Line = Line + 1
4700 endif
4701 enddo
4702 pRestore_Pos( SavedPos)
4703
4704 'SayHint 'n' lines added.'
4705
4706; ---------------------------------------------------------------------------
4707defc RemoveDoubleLineEnds
4708 Option = upcase( strip( arg( 1)))
4709 if Option = 'EXACT' then
4710
4711 -- Exact
4712 -- This is the old "SingleSpace" macro.
4713 -- Removes every 2nd line, if it's a blank line.
4714 -- Stops if a 2nd line is not blank. Starts at the forelast line,
4715 -- which must be blank.
4716 call NextCmdAltersText()
4717 do l = .last - 1 to 1 by -2
4718 if textline( l) <> '' then
4719 'SayError Line' l 'is not blank.'
4720 leave
4721 endif
4722 deleteline l
4723 enddo
4724
4725 else
4726
4727 -- Sloppy
4728 call NextCmdAltersText()
4729 l = .last
4730 do forever
4731 if l <= 1 then
4732 leave
4733 endif
4734
4735 if textline( l) = '' then -- If line l is empty
4736 -- Backward: line l is greater than the lines above
4737 FirstEmptyLine = l
4738 LastEmptyLine = l
4739 do l2 = l - 1 to 1 by -1
4740 if textline( l2) <> '' then
4741 leave
4742 endif
4743 LastEmptyLine = l2
4744 enddo
4745
4746 -- Backward: FirstEmptyLine is greater than the lines above
4747 NumEmptyLines = FirstEmptyLine - LastEmptyLine + 1
4748 NumDelete = (NumEmptyLines + 1) % 2
4749 do n = 1 to NumDelete
4750 deleteline l
4751 l = l - 1
4752 enddo
4753 l = l - (NumDelete - 1)
4754 else
4755 l = l - 1
4756 endif
4757 enddo
4758
4759 endif
4760
4761; ---------------------------------------------------------------------------
4762; For campatibility.
4763defc SingleSpace
4764 'RemoveDoubleLineEnds exact'
4765
4766; ---------------------------------------------------------------------------
4767; Remove double lines
4768defc RemoveDoubleLines
4769 if FileIsMarked() then
4770 MarkToLineMark()
4771 getmark markfirstline, marklastline, markfirstcol, marklastcol, markfid
4772 FirstLine = markfirstline
4773 LastLine = marklastline
4774 else
4775 FirstLine = 1
4776 LastLine = .last
4777 endif
4778
4779 call NextCmdAltersText()
4780 SavedModify = .modify
4781 pSave_Pos( SavedPos)
4782 n = 0
4783 Line = FirstLine
4784 do forever
4785 if Line > .last then
4786 leave
4787 endif
4788 if Line >= LastLine then
4789 leave
4790 endif
4791 LineStr = textline( Line)
4792 if strip( translate( LineStr, ' ', \9)) = '' then
4793 Line = Line + 1
4794 iterate
4795 endif
4796
4797 j = Line + 1
4798 do forever
4799 if j > .last then
4800 leave
4801 endif
4802 if LineStr == textline( j) then
4803 .lineg = j
4804 deleteline
4805 n = n + 1
4806 .modify = SavedModify + 1
4807 else
4808 j = j + 1
4809 endif
4810 enddo
4811
4812 Line = Line + 1
4813 enddo
4814 pRestore_Pos( SavedPos)
4815
4816 'SayHint 'n' lines removed.'
4817
4818; ---------------------------------------------------------------------------
4819defc StripBlanksFromLines
4820 Option = upcase( arg( 1))
4821 fStripLeading = 0
4822 if abbrev( Option, 'L', 1) then
4823 fStripLeading = 1
4824 endif
4825
4826 if FileIsMarked() then
4827 MarkToLineMark()
4828 getmark markfirstline, marklastline, markfirstcol, marklastcol, markfid
4829 FirstLine = markfirstline
4830 LastLine = marklastline
4831 else
4832 FirstLine = 1
4833 LastLine = .last
4834 endif
4835
4836 call NextCmdAltersText()
4837 n = 0
4838 do Line = FirstLine to LastLine
4839 -- Determine LineStr before calling SearchReplaceLine
4840 getline LineStr, Line
4841 if length( LineStr) = 0 then
4842 iterate
4843 endif
4844
4845 -- Remove leading whitespace
4846 rcx1 = 1
4847 if fStripLeading then
4848 -- Running SearchReplaceLine on every line with extended grep is
4849 -- slow. Therefore avoid the call if possible.
4850 if leftstr( LineStr, 1) == ' ' | leftstr( LineStr, 1) == \9 then
4851 rcx1 = SearchReplaceLine( '^:w', '', 1, 'x', Line, 1)
4852 endif
4853 endif
4854
4855 -- Remove trailing whitespace
4856 -- Running SearchReplaceLine on every line with extended grep is
4857 -- slow. Therefore avoid the call if possible.
4858 rcx2 = 1
4859 if rightstr( LineStr, 1) == ' ' | rightstr( LineStr, 1) == \9 then
4860 rcx2 = SearchReplaceLine( ':w$', '', 1, 'x', Line, 1)
4861 endif
4862
4863 -- Count changes
4864 if rcx1 = 0 | rcx2 = 0 then
4865 n = n + 1
4866 endif
4867 enddo
4868
4869 'SayHint 'n' lines stripped.'
4870
4871; ---------------------------------------------------------------------------
4872defc CenterMark, Center
4873 call NextCmdAltersText()
4874 call pCenter_Mark()
4875
4876; ---------------------------------------------------------------------------
4877defc BackSpace
4878 universal stream_mode
4879
4880 fMarkDeleted = ReplaceMark()
4881 if fMarkDeleted then
4882 return
4883 endif
4884
4885 call NextCmdAltersText()
4886 if .col = 1 & .line > 1 & stream_mode then
4887 up
4888 l = length( textline( .line))
4889 join
4890 .col = l + 1
4891 else
4892 old_level = .levelofattributesupport
4893 if old_level & not (old_level bitand 2) then
4894 .levelofattributesupport = .levelofattributesupport + 2
4895
4896 -- If the following block is processed after rubout, but with col
4897 -- instead of col - 1, a bookmark at col is deleted, also at col after
4898 -- rubout, which was previously col + 1. Therefore:
4899 -- Delete the bookmark at .col - 1 before rubout.
4900 if .col <= 1 & stream_mode then
4901 line = .line - 1
4902 col = length( textline( line)) + 1
4903 else
4904 line = .line
4905 col = .col
4906 endif
4907 DelBookmarkAtPos( line, col - 1)
4908
4909 -- Go over all attributes at current pos.
4910 -- Required for rubout to delete the char at col - 1.
4911 -- rubout won't go over an attribute.
4912 .cursoroffset = -300
4913
4914 endif
4915
4916 -- Begin workaround for cursor just behind or at begin of a mark
4917 -- For char mark: Move mark left if cursor is on mark begin or end
4918 old_col = .col
4919 old_line = .line
4920 fCorrectMarkBegin = 0
4921 fCorrectMarkEnd = 0
4922 getfileid fid
4923 MkType = marktype()
4924 do once = 1 to 1
4925 if MkType <> 'CHAR' then
4926 leave
4927 endif
4928 getmark first_line, last_line, first_col, last_col, mkfid
4929 if fid <> mkfid then
4930 leave
4931 endif
4932 if (old_col > 1) & (first_line = old_line) & (first_line = last_line) & (first_col = old_col) then
4933 -- Cursor is on mark begin and first_line = last_line
4934 fCorrectMarkBegin = 1
4935 fCorrectMarkEnd = 1
4936 elseif (old_col > 1) & (first_line = old_line) & (first_col = old_col) then
4937 -- Cursor is on mark begin
4938 fCorrectMarkBegin = 1
4939 elseif (old_col > 0) & (last_line = old_line) & (last_col = old_col - 1) then
4940 -- Cursor is 1 col behind mark end
4941 fCorrectMarkEnd = 1
4942 endif
4943 --dprintf( first_line', 'last_line', 'first_col', 'last_col', Marktype = 'MkType ||
4944 -- ', fCorrectMarkEnd/Begin = 'fCorrectMarkEnd fCorrectMarkBegin)
4945 enddo
4946 -- End workaround for cursor just behind or at begin of a mark
4947
4948 rubout
4949
4950 -- Begin workaround for cursor just behind or at begin of a mark
4951 --MkType = wordpos( MkType, 'LINE CHAR BLOCK CHARG BLOCKG') - 1
4952 if fCorrectMarkBegin then
4953 first_col = first_col - 1 -- move first_col left
4954 endif
4955 if fCorrectMarkEnd then
4956 last_col = last_col - 1 -- move last_col left
4957 endif
4958 if fCorrectMarkBegin | fCorrectMarkEnd then
4959 pSet_Mark( first_line, last_line, first_col, last_col, MkType, fid)
4960 endif
4961 -- End workaround for cursor just behind or at begin of a mark
4962
4963 .levelofattributesupport = old_level
4964 endif
4965 'MatchFindOnMove'
4966
4967; ---------------------------------------------------------------------------
4968; Enhanced to accept a line number as arg, like the deleteline statement.
4969defc DeleteLine
4970 Line = arg( 1)
4971 pSave_Pos( SavedPos)
4972 if Line <> '' then
4973 .lineg = Line
4974 endif
4975
4976 call NextCmdAltersText()
4977 call DelAttrInLine()
4978
4979 deleteline
4980
4981 if Line <> '' then
4982 pRestore_Pos( SavedPos)
4983 endif
4984
4985; ---------------------------------------------------------------------------
4986; Delete from cursor until beginning of next word, UNDOable
4987defc DeleteUntilNextword
4988 call NextCmdAltersText()
4989 getline LineStr
4990 BegCur = .col
4991 LenLine = length( LineStr)
4992 if LenLine >= BegCur then
4993 for i = BegCur to LenLine -- delete remainder of word
4994 if substr( LineStr, i, 1) <> ' ' then
4995 DelBookmarkAtPos()
4996 -- Go over all attributes at current pos.
4997 -- Required for deletechar to delete the char at col.
4998 -- deletechar won't go over an attribute.
4999 .cursoroffset = 0
5000 deletechar
5001 else
5002 leave
5003 endif
5004 endfor
5005 for j = i to LenLine -- delete delimiters following word
5006 if substr( LineStr, j, 1) == ' ' then
5007 DelBookmarkAtPos()
5008 -- Go over all attributes at current pos.
5009 -- Required for deletechar to delete the char at col.
5010 -- deletechar won't go over an attribute.
5011 .cursoroffset = 0
5012 deletechar
5013 else
5014 leave
5015 endif
5016 endfor
5017 endif
5018
5019; ---------------------------------------------------------------------------
5020defc DeleteUntilEndLine
5021 call NextCmdAltersText()
5022 l = length( textline( .line))
5023 DelBookmarkInRegion( .line, .col, .line, l)
5024 erase_end_line -- Ctrl-Del is the PM way.
5025
5026; ---------------------------------------------------------------------------
5027defc EndFile
5028 universal stream_mode
5029 if stream_mode then
5030 bottom
5031 endline
5032 else
5033 if .line = .last and .line then
5034 endline
5035 endif
5036 bottom
5037 endif
5038 'MatchFindOnMove'
5039
5040; ---------------------------------------------------------------------------
5041; If arg( 1) specified and > 0: Set cursor to pos of pointer.
5042defc MarkWord
5043 if arg( 1) then
5044 'MH_GoToLastClick'
5045 unmark
5046 endif
5047 call pMark_Word()
5048
5049; ---------------------------------------------------------------------------
5050; If arg( 1) specified and > 0: Set cursor to pos of pointer.
5051defc MarkSentence
5052 if arg( 1) then
5053 'MH_GoToLastClick'
5054 unmark
5055 endif
5056 call mark_sentence()
5057
5058; ---------------------------------------------------------------------------
5059; If arg( 1) specified and > 0: Set cursor to pos of pointer.
5060defc MarkParagraph
5061 if arg( 1) then
5062 'MH_GoToLastClick'
5063 unmark
5064 endif
5065 call mark_paragraph()
5066
5067; ---------------------------------------------------------------------------
5068defc ExtendSentence
5069 call mark_through_next_sentence()
5070
5071; ---------------------------------------------------------------------------
5072defc ExtendParagraph
5073 call mark_through_next_paragraph()
5074
5075; ---------------------------------------------------------------------------
5076; If arg( 1) specified and > 0: Set cursor to pos of pointer.
5077defc MarkToken
5078 if arg( 1) then
5079 'MH_GoToLastClick'
5080 endif
5081
5082 if Find_Token( startcol, endcol) then
5083 KeyPath = '\NEPMD\User\Mark\WordMarkType'
5084 WordMarkType = QueryConfigKey( KeyPath)
5085 if WordMarkType = 'B' then
5086 MkType = 'BLOCK'
5087 else
5088 MkType = 'CHAR'
5089 endif
5090 getfileid fid
5091 call pSet_Mark( .line, .line, startcol, endcol, MkType, fid)
5092 -- Copy mark to shared text buffer
5093 'Copy2SharBuff'
5094 endif
5095
5096; ---------------------------------------------------------------------------
5097defc UppercaseWord
5098 call NextCmdAltersText()
5099 call pSave_Pos( savepos)
5100 call pSave_Mark( savemark)
5101 call pMark_Word()
5102 call pUpperCase()
5103 call pRestore_Mark( savemark)
5104
5105; ---------------------------------------------------------------------------
5106defc LowercaseWord
5107 call NextCmdAltersText()
5108 call pSave_Pos( savepos)
5109 call pSave_Mark( savemark)
5110 call pMark_Word()
5111 call pLowerCase()
5112 call pRestore_Mark( savemark)
5113 call pRestore_Pos( savepos)
5114
5115; ---------------------------------------------------------------------------
5116defc UppercaseMark
5117 call NextCmdAltersText()
5118 call pUpperCase()
5119
5120; ---------------------------------------------------------------------------
5121defc LowercaseMark
5122 call NextCmdAltersText()
5123 call pLowerCase()
5124
5125; ---------------------------------------------------------------------------
5126define
5127compile if not defined( UPPERCHARS)
5128 UPPERCHARS = 'ABCDEFGHIJKLMNOPQRSTUVWXYZŽ™š'
5129compile endif
5130compile if not defined( LOWERCHARS)
5131 LOWERCHARS = 'abcdefghijklmnopqrstuvwxyz„”'
5132compile endif
5133
5134; ---------------------------------------------------------------------------
5135; Toggles case of word under cursor: lower -> Mixed -> UPPER -> lower
5136defc CaseWord
5137 call pSave_Pos( savepos)
5138
5139 -- find_token won't take '.' and '_' as word boundaries
5140 rcx = Find_Token( startcol, endcol)
5141
5142 if rcx <> 1 & .col > 1 then
5143 -- Inspect tokens left from cursor
5144 .col = .col - 1
5145 rcx = Find_Token( startcol, endcol)
5146 endif
5147 if rcx <> 1 then
5148 call pRestore_Pos( savepos)
5149 return
5150 endif
5151
5152 getline LineStr, .line
5153 LeftLineStr = substr( LineStr, 1, Max( 0, startcol - 1))
5154 Wrd = substr( LineStr, startcol, Max( 0, endcol - startcol + 1))
5155 RightLineStr = substr( LineStr, endcol + 1)
5156
5157 if verify( Wrd, LOWERCHARS, 'M') = 0 then -- no lowercase -> lowercase
5158 -- XXXX -> xxxx
5159 NewWrd = translate( Wrd, LOWERCHARS, UPPERCHARS)
5160
5161 elseif verify( Wrd, UPPERCHARS, 'M') = 0 & -- no uppercase and
5162 verify( substr( Wrd, 1, 1), LOWERCHARS, 'M') then -- first char lowercase -> Capitalize
5163 -- xxxx -> Xxxx
5164 NewWrd = translate( leftstr( Wrd, 1), UPPERCHARS, LOWERCHARS) -- first letter
5165 if length( Wrd) > 1 then
5166 NewWrd = NewWrd''translate( substr( Wrd, 2), LOWERCHARS, UPPERCHARS) -- append rest
5167 endif
5168
5169 else -- mixed case -> UPPERCASE
5170 -- xxXx -> XXXX
5171 NewWrd = translate( Wrd, UPPERCHARS, LOWERCHARS)
5172 endif
5173
5174 -- Replace line only if anything has changed to not increase .modify otherwise
5175 if NewWrd <> Wrd then
5176 call NextCmdAltersText()
5177 --replaceline LeftLineStr''NewWrd''RightLineStr
5178 .col = startcol
5179 rcx = SearchReplaceLine( Wrd, NewWrd, 1)
5180 endif
5181
5182 call pRestore_Pos( savepos)
5183
5184; ---------------------------------------------------------------------------
5185; Toggles case of char under cursor. Moves right.
5186defc CaseChar
5187 getline LineStr, .line
5188 Char = substr( LineStr, .col, 1)
5189
5190 NewChar = Char
5191 if verify( Char, LOWERCHARS, 'M') = 0 then -- no lowercase -> lowercase
5192 -- X -> x
5193 NewChar = translate( Char, LOWERCHARS, UPPERCHARS)
5194 elseif verify( Char, UPPERCHARS, 'M') = 0 then -- no uppercase -> uppercase
5195 -- x -> X
5196 NewChar = translate( Char, UPPERCHARS, LOWERCHARS)
5197 endif
5198
5199 -- Replace line only if anything has changed to not increase .modify otherwise
5200 if NewChar <> Char then
5201 call NextCmdAltersText()
5202 rcx = SearchReplaceLine( Char, NewChar, 1)
5203 endif
5204 'NextChar'
5205
5206; ---------------------------------------------------------------------------
5207defc BeginWord
5208 call pBegin_Word()
5209
5210 'MatchFindOnMove'
5211
5212; ---------------------------------------------------------------------------
5213defc EndWord
5214 call pEnd_Word()
5215
5216 'MatchFindOnMove'
5217
5218; ---------------------------------------------------------------------------
5219defc BeginFile
5220 universal stream_mode
5221
5222 if stream_mode then
5223 top
5224 beginline
5225 else
5226 if .line = 1 then
5227 beginline
5228 endif
5229 top
5230 endif
5231
5232 'MatchFindOnMove'
5233
5234; ---------------------------------------------------------------------------
5235defc DuplicateLine
5236 call NextCmdAltersText()
5237 getline line
5238 insertline line, .line + 1
5239
5240; ---------------------------------------------------------------------------
5241defc CommandDlgLine
5242 if .line then
5243 getline line
5244 'CommandLine 'line
5245 endif
5246
5247; ---------------------------------------------------------------------------
5248defc PrevWord
5249 universal stream_mode
5250
5251 if stream_mode &
5252 (.line > 1) & (.col = Max( 1, verify( textline( .line), ' '))) then
5253 up
5254 endline
5255 endif
5256 backtab_word
5257
5258 'MatchFindOnMove'
5259
5260; ---------------------------------------------------------------------------
5261defc NextWord
5262 universal stream_mode
5263
5264 if stream_mode &
5265 (((not .line) | (lastpos( ' ', textline( .line)) < .col)) & (.line < .last)) then
5266 down
5267 call pFirst_NonBlank()
5268 else
5269 tabword
5270 endif
5271
5272 'MatchFindOnMove'
5273
5274; ---------------------------------------------------------------------------
5275defc MarkPrevWord
5276 universal stream_mode
5277
5278 startline = .line
5279 startcol = .col
5280 if .line then
5281 if stream_mode &
5282 (.line > 1) & (.col = Max( 1, verify( textline( .line), ' '))) then
5283 up
5284 endline
5285 endif
5286 backtabword
5287 call Extend_Mark( startline, startcol, 0)
5288 endif
5289
5290; ---------------------------------------------------------------------------
5291defc MarkNextWord
5292 universal stream_mode
5293
5294 startline = .line
5295 startcol = .col
5296 if .line then
5297 if stream_mode &
5298 (((not .line) | (lastpos( ' ', textline( .line)) < .col)) & (.line < .last)) then
5299 down
5300 call pFirst_NonBlank()
5301 else
5302 tabword
5303 endif
5304 call Extend_Mark( startline, startcol, 1)
5305 endif
5306
5307; ---------------------------------------------------------------------------
5308defc BeginScreen
5309 if .line then
5310 .cursory = 1
5311 else
5312 .line = 1
5313 endif
5314
5315; ---------------------------------------------------------------------------
5316defc EndScreen
5317 if .line then
5318 .cursory = .windowheight
5319 else
5320 .line = 1
5321 endif
5322
5323; ---------------------------------------------------------------------------
5324defc MarkBeginScreen
5325 startline = .line
5326 startcol = .col
5327 if .line then
5328 .cursory = 1
5329 endif
5330 if .line then
5331 call Extend_Mark( startline, startcol, 0)
5332 else
5333 .line = 1
5334 endif
5335
5336defc MarkEndScreen
5337 startline = .line
5338 startcol = .col
5339 if .line then
5340 .cursory = .windowheight
5341 endif
5342 if .line then
5343 call Extend_Mark( startline, startcol, 1)
5344 else
5345 .line = 1
5346 endif
5347
5348; ---------------------------------------------------------------------------
5349; Record and playback key and menu commands
5350; The array var 'recordkeys' holds the list of \0-separated Key\1Cmd pairs.
5351; It is set by SaveKeyCmd, which is called by OtherKeys, ExecKeyCmd and
5352; ExecAccelKey. See UNDO.E:"defproc SaveKeyCmd".
5353
5354; ---------------------------------------------------------------------------
5355defproc RecKeysNew
5356 universal recfid
5357
5358 UserDir = Get_Env( 'NEPMD_USERDIR')
5359 RecFile = UserDir'\bin\last.rec'
5360 getfileid startfid
5361 getfileid recfid, RecFile
5362 if validatefileid( recfid) then
5363 call pSave_Mark( SavedMark)
5364 activatefile recfid
5365 call pSet_Mark( 1, .last, 1, length( textline( .last)), 'CHAR' , recfid)
5366 deletemark
5367 if .last > 0 then
5368 .line = .last
5369 deleteline
5370 endif
5371 --'xcom save' -- Better keep old file until recording is saved
5372 .modify = 0
5373 call pRestore_Mark( SavedMark)
5374 else
5375 'xcom E /n 'RecFile
5376 getfileid recfid
5377 .visible = 0
5378 .autosave = 0
5379 endif
5380 if .last > 0 then
5381 .line = .last
5382 deleteline
5383 endif
5384 .modify = 0
5385 activatefile startfid
5386
5387; ---------------------------------------------------------------------------
5388defproc RecKeysEnd
5389 UserDir = Get_Env( 'NEPMD_USERDIR')
5390 RecFile = UserDir'\bin\last.rec'
5391 getfileid startfid
5392 getfileid recfid, RecFile
5393 if validatefileid( recfid) then
5394 activatefile recfid
5395 'xcom Save'
5396 activatefile startfid
5397 endif
5398
5399; ---------------------------------------------------------------------------
5400defproc RecKeysCancel
5401 UserDir = Get_Env( 'NEPMD_USERDIR')
5402 RecFile = UserDir'\bin\last.rec'
5403 getfileid startfid
5404 getfileid recfid, RecFile
5405 if validatefileid( recfid) then
5406 activatefile recfid
5407 .modify = 0
5408 'xcom Quit'
5409 activatefile startfid
5410 recfid = 0
5411 endif
5412
5413; ---------------------------------------------------------------------------
5414defc RecKeysSaveAs
5415 UserDir = Get_Env( 'NEPMD_USERDIR')
5416 RecFile = UserDir'\bin\last.rec'
5417 getfileid recfid, RecFile
5418 -- Revert to make it visible and to process defload and defselect
5419 if validatefileid( recfid) then
5420 activatefile recfid
5421 'xcom Quit'
5422 endif
5423 'xcom E /d' RecFile
5424 -- Open Save-as dialog
5425 'PostMe PostMe SaveAs_Dlg' -- 2x PostMe required
5426
5427; ---------------------------------------------------------------------------
5428defproc RecKeysGetFile
5429 universal recfid
5430
5431 if validatefileid( recfid) then
5432 RecFile = recfid.filename
5433 else
5434 UserDir = Get_Env( 'NEPMD_USERDIR')
5435 RecFile = UserDir'\bin\last.rec'
5436 endif
5437 return RecFile
5438
5439; ---------------------------------------------------------------------------
5440defc RecKeysSelectFile
5441 RecFile = RecKeysGetFile()
5442 Title = 'Select a record macro file for playback'
5443 Cmd = 'RecKeysSetFile'
5444 FileMask = RecFile
5445 'FileDlg' Title','Cmd','FileMask
5446
5447; ---------------------------------------------------------------------------
5448defc RecKeysSetFile
5449 universal recfid
5450 universal recordingstate
5451
5452 RecFile = arg( 1)
5453 Text = '"'RecFile'" set as record macro file for playback.'
5454 getfileid startfid
5455 getfileid fid, RecFile
5456 if fid = '' then
5457 if Exist( RecFile) then
5458 'xcom E' RecFile
5459 .visible = 0
5460 getfileid recfid
5461 activatefile startfid
5462 'SayError 'Text
5463 recordingstate = 'P'
5464 endif
5465 else
5466 recfid = fid
5467 'SayError 'Text
5468 recordingstate = 'P'
5469 endif
5470
5471; ---------------------------------------------------------------------------
5472defc RecKeysSelectEditFile
5473 RecFile = RecKeysGetFile()
5474 Title = 'Select a record macro file to edit'
5475 Cmd = 'RecKeysEditFile'
5476 FileMask = RecFile
5477 'FileDlg' Title','Cmd','FileMask
5478
5479; ---------------------------------------------------------------------------
5480defc RecKeysEditFile
5481 RecFile = arg( 1)
5482 getfileid fid, RecFile
5483 -- Revert to make it visible and to process defload and defselect
5484 if fid then
5485 activatefile fid
5486 'xcom Quit'
5487 endif
5488 'Edit' RecFile
5489
5490; ---------------------------------------------------------------------------
5491defproc RecKeysAppendCurKey
5492 universal curkey
5493 universal recfid
5494
5495 insertline curkey, recfid.last + 1, recfid
5496 recfid.modify = 0
5497
5498; ---------------------------------------------------------------------------
5499defproc RecKeysGetNumKeys
5500 universal recfid
5501
5502 if validatefileid( recfid) then
5503 return recfid.last
5504 else
5505 return 0
5506 endif
5507
5508; ---------------------------------------------------------------------------
5509defproc RecKeysGetKey( line)
5510 universal recfid
5511
5512 getline LineStr, line, recfid
5513 return LineStr
5514
5515; ---------------------------------------------------------------------------
5516defproc AddRecordKeys
5517 universal recordingstate
5518 universal curkey
5519
5520 parse value( curkey) with KeyString \1 Cmd
5521 Cmd = strip( Cmd)
5522
5523 -- If key recording is active, add curkey to recordkeys array var
5524 if wordpos( upcase( Cmd), 'RECORDKEYS PLAYBACKKEYS') = 0 then
5525 if recordingstate = 'R' then
5526 call RecKeysAppendCurKey()
5527 endif
5528 endif
5529
5530; ---------------------------------------------------------------------------
5531defc RecordKeys
5532 universal recordingstate
5533
5534 RecordKeysKeyString = strip( MenuAccelString( 'RecordKeys'), 'L', \9)
5535 PlaybackKeysKeyString = strip( MenuAccelString( 'PlaybackKeys'), 'L', \9)
5536
5537 if recordingstate = 'R' then
5538 recordingstate = 'P'
5539 --'SayHint' REMEMBERED__MSG
5540 call RecKeysEnd()
5541 'SayHint Remembered! Press 'PlaybackKeysKeyString' to execute.'
5542 else
5543 recordingstate = 'R'
5544 call RecKeysNew()
5545 --'SayHint' CTRL_R__MSG
5546 'SayHint Remembering keys. 'RecordKeysKeyString' to finish, 'PlaybackKeysKeyString' to finish and try, Esc to cancel.'
5547 endif
5548
5549; ---------------------------------------------------------------------------
5550defc CancelRecordKeys
5551 universal recordingstate
5552
5553 recordingstate = ''
5554 call RecKeysCancel()
5555 'SayHint Key recording canceled.'
5556
5557; ---------------------------------------------------------------------------
5558defc PlaybackKeys
5559 universal recordingstate
5560 universal recfid
5561
5562 NumEntries = RecKeysGetNumKeys()
5563 PlaybackKeysKeyString = strip( MenuAccelString( 'PlaybackKeys'), 'L', \9)
5564 if recordingstate = 'R' then
5565 recordingstate = 'P'
5566 call RecKeysEnd()
5567 --'SayHint' REMEMBERED__MSG
5568 'SayHint Remembered! Press 'PlaybackKeysKeyString' to execute.'
5569 endif
5570 if recordingstate = 'P' & validatefileid( recfid) then
5571 call NextCmdAltersText()
5572 'DisableUndoRec'
5573 do line = 1 to NumEntries
5574 KeyDef = RecKeysGetKey( line)
5575 parse value( KeyDef) with Key \1 Cmd
5576 -- Execute either accel or standard (other) key
5577 if Cmd <> '' then
5578 -- Execute Cmd if defined
5579 Cmd
5580 elseif IsSingleKey( Key) then
5581 -- A standard char
5582 call Process_Key( Key)
5583 endif
5584 enddo
5585 'EnableUndoRec'
5586 else
5587 'RecKeysSelectFile'
5588 endif
5589
5590; ---------------------------------------------------------------------------
5591defc TypeTab
5592 call Process_Key( \9)
5593
5594; ---------------------------------------------------------------------------
5595defc DeleteChar
5596 universal stream_mode
5597
5598 fMarkDeleted = ReplaceMark()
5599 if fMarkDeleted then
5600 return
5601 endif
5602
5603 call NextCmdAltersText()
5604 l = 0
5605 if .line then
5606 l = length( textline( .line))
5607 endif
5608 if .line & .col > l & stream_mode then
5609 join -- Append next line to current
5610 .col = l + 1
5611 else
5612 old_level = .levelofattributesupport
5613 if old_level & not (old_level bitand 2) then
5614 .levelofattributesupport = .levelofattributesupport + 2
5615 endif
5616 DelBookmarkAtPos()
5617 -- Go over all attributes at current pos.
5618 -- Required for deletechar to delete the char at col.
5619 -- deletechar won't go over an attribute.
5620 .cursoroffset = 0
5621 -- deletechar won't go over the text end and delete the line end char.
5622 -- That is the correct behavior in line mode.
5623 deletechar
5624 .levelofattributesupport = old_level
5625 endif
5626
5627 'MatchFindOnMove'
5628
5629; ---------------------------------------------------------------------------
5630defc ScrollLockV
5631 NewValue = strip( arg( 1))
5632 if NewValue <> '' & wordpos( NewValue, '0 1') then
5633 KeyPath = '\NEPMD\User\CursorPos\ScrollLockV'
5634 fScrollLockV = QueryConfigKey( KeyPath)
5635 if NewValue <> fScrollLockV then
5636 WriteConfigKey( KeyPath, NewValue)
5637 endif
5638 endif
5639
5640; ---------------------------------------------------------------------------
5641defc ScrollLockH
5642 NewValue = strip( arg( 1))
5643 if NewValue <> '' & wordpos( NewValue, '0 1') then
5644 KeyPath = '\NEPMD\User\CursorPos\ScrollLockH'
5645 fScrollLockH = QueryConfigKey( KeyPath)
5646 if NewValue <> fScrollLockH then
5647 WriteConfigKey( KeyPath, NewValue)
5648 endif
5649 endif
5650
5651; ---------------------------------------------------------------------------
5652defc Nextline, Down
5653 NumLines = arg( 1)
5654
5655 NextCmdChangesLinePos()
5656 call UnmarkOnAnyKey()
5657 'VSyncIfKeepCursor'
5658
5659 fScrollLockV = 0
5660 if Scroll_Lock() then
5661 KeyPath = '\NEPMD\User\CursorPos\ScrollLockV'
5662 fScrollLockV = QueryConfigKey( KeyPath)
5663 endif
5664 if fScrollLockV then
5665 ScrollUpDownKey( 1, NumLines)
5666 else
5667 call UpDownKey( 1, NumLines)
5668 endif
5669
5670
5671 'MatchFindOnMove'
5672
5673; ---------------------------------------------------------------------------
5674defc PrevLine, Up
5675 NumLines = arg( 1)
5676
5677 NextCmdChangesLinePos()
5678 call UnmarkOnAnyKey()
5679 'VSyncIfKeepCursor'
5680
5681 fScrollLockV = 0
5682 if Scroll_Lock() then
5683 KeyPath = '\NEPMD\User\CursorPos\ScrollLockV'
5684 fScrollLockV = QueryConfigKey( KeyPath)
5685 endif
5686 if fScrollLockV then
5687 ScrollUpDownKey( 0, NumLines)
5688 else
5689 call UpDownKey( 0, NumLines)
5690 endif
5691
5692 if .line = 0 then
5693 -- Not for insert below
5694 KeyPath = '\NEPMD\User\Mark\LineInsert'
5695 LineInsert = QueryConfigKey( KeyPath)
5696 if LineInsert = 'A' then
5697 .lineg = 1
5698 endif
5699 endif
5700
5701 'MatchFindOnMove'
5702
5703; ---------------------------------------------------------------------------
5704defc ScrollDown
5705 NumLines = arg( 1)
5706
5707 NextCmdChangesLinePos()
5708 call UnmarkOnAnyKey()
5709 'VSyncIfKeepCursor'
5710
5711 fScrollLockV = 0
5712 if Scroll_Lock() then
5713 KeyPath = '\NEPMD\User\CursorPos\ScrollLockV'
5714 fScrollLockV = QueryConfigKey( KeyPath)
5715 endif
5716 if not fScrollLockV then
5717 ScrollUpDownKey( 1, NumLines)
5718 else
5719 call UpDownKey( 1, NumLines)
5720 endif
5721
5722 'MatchFindOnMove'
5723
5724; ---------------------------------------------------------------------------
5725defc ScrollUp
5726 NumLines = arg( 1)
5727
5728 NextCmdChangesLinePos()
5729 call UnmarkOnAnyKey()
5730 'VSyncIfKeepCursor'
5731
5732 fScrollLockV = 0
5733 if Scroll_Lock() then
5734 KeyPath = '\NEPMD\User\CursorPos\ScrollLockV'
5735 fScrollLockV = QueryConfigKey( KeyPath)
5736 endif
5737 if not fScrollLockV then
5738 ScrollUpDownKey( 0, NumLines)
5739 else
5740 call UpDownKey( 0, NumLines)
5741 endif
5742
5743 if .line = 0 then
5744 -- Not for insert below
5745 KeyPath = '\NEPMD\User\Mark\LineInsert'
5746 LineInsert = QueryConfigKey( KeyPath)
5747 if LineInsert = 'A' then
5748 .lineg = 1
5749 endif
5750 endif
5751
5752 'MatchFindOnMove'
5753
5754; ---------------------------------------------------------------------------
5755defc MarkDown
5756 NextCmdChangesLinePos()
5757 startline = .line
5758 startcol = .col
5759 call UpDownKey( 1)
5760 if startline then -- required if cursor is in line 0
5761 call Extend_Mark( startline, startcol, 1)
5762 endif
5763
5764; ---------------------------------------------------------------------------
5765defc BeginLine -- Home
5766 call UnmarkOnAnyKey()
5767 'VSyncIfKeepCursor'
5768
5769 KeyPath = '\NEPMD\User\SpecialKeys\HomeToggles'
5770 on = (QueryConfigKey( KeyPath) = 1)
5771 if on then
5772 -- Go to begin of text.
5773 -- If in area before or at begin of text, go to column 1.
5774 startline = .line
5775 startcol = .col
5776 call pFirst_NonBlank()
5777 if .line = startline and .col = startcol then
5778 beginline
5779 endif
5780 else
5781 -- standard Home
5782 beginline
5783 endif
5784
5785 'MatchFindOnMove'
5786
5787; ---------------------------------------------------------------------------
5788defc MarkBeginLine -- Sh+Home
5789 KeyPath = '\NEPMD\User\SpecialKeys\HomeToggles'
5790 on = (QueryConfigKey( KeyPath) = 1)
5791 if on then
5792 -- Go to begin of text.
5793 -- If in area before or at begin of text, go to column 1.
5794 startline = .line
5795 startcol = .col
5796 call pFirst_NonBlank()
5797 if .line = startline and .col = startcol then
5798 beginline
5799 endif
5800 if .line then
5801 call Extend_Mark( startline, startcol, 0)
5802 endif
5803 else
5804 -- standard Sh+Home
5805 startline = .line
5806 startcol = .col
5807 beginline
5808 if .line then
5809 call Extend_Mark( startline, startcol, 0)
5810 endif
5811 endif
5812
5813; ---------------------------------------------------------------------------
5814defc EndLine -- End
5815 universal endkeystartpos
5816
5817 call UnmarkOnAnyKey()
5818 'VSyncIfKeepCursor'
5819
5820 KeyPath = '\NEPMD\User\SpecialKeys\EndToggles'
5821 on = (QueryConfigKey( KeyPath) = 1)
5822 if on then
5823 -- If started from after end of text, save that as startcol.
5824 -- Go to end of text. If on end of text, go to startcol.
5825 parse value( endkeystartpos) with savedline savedcol
5826 startline = .line
5827 startcol = .col
5828 if .line then
5829 endline
5830 --call pEnd_Line() -- like endline, but ignore trailing blanks
5831 if savedline <> startline or startcol > .col then
5832 endkeystartpos = startline startcol
5833 else
5834 if startcol = .col and savedcol > .col then
5835 .col = savedcol
5836 endif
5837 endif
5838 endif
5839 else
5840 -- standard End
5841 if .line then
5842 endline
5843 endif
5844 --call pEnd_Line() -- like endline, but ignore trailing blanks
5845 endif
5846
5847 'MatchFindOnMove'
5848
5849; ---------------------------------------------------------------------------
5850defc MarkEndLine -- Sh+End
5851 universal endkeystartpos
5852
5853 KeyPath = '\NEPMD\User\SpecialKeys\EndToggles'
5854 on = (QueryConfigKey( KeyPath) = 1)
5855 if on then
5856 parse value( endkeystartpos) with savedline savedcol
5857 startline = .line
5858 startcol = .col
5859 if .line then
5860 endline
5861 --call pEnd_Line() -- like endline, but ignore trailing blanks
5862 if savedline <> startline or startcol > .col then
5863 endkeystartpos = startline startcol
5864 else
5865 if startcol = .col and savedcol > .col then
5866 .col = savedcol
5867 endif
5868 endif
5869 call Extend_Mark( startline, startcol, 1)
5870 endif
5871 else
5872 startline = .line
5873 startcol = .col
5874 --call pEnd_Line() -- like endline, but ignore trailing blanks
5875 if .line then
5876 endline
5877 call Extend_Mark( startline, startcol, 1)
5878 endif
5879 endif
5880
5881; ---------------------------------------------------------------------------
5882; Syntax: ProcessEscape [<cmd>]
5883; <cmd> is usually set to CommandLine
5884; This can be specified in STDKEYS.E.
5885defc ProcessEscape
5886 universal alt_R_active
5887 universal recordingstate
5888 universal mousemarkinginfo
5889
5890 Cmd = strip( arg( 1))
5891 parse value mousemarkinginfo with BeginDragLine BeginDragCol HighlightSwitchedOff Mt
5892
5893 sayerror 0
5894
5895 -- Set focus to client
5896 -- EPM bug:
5897 -- On dismissing a popup menu, the focus is often not set back to the edit
5898 -- window. Click into it first. Focus switching was also addded to
5899 -- ShowCursor (Ctrl+.) and ProcessEscape (Esc).
5900 'SetFocusToEditClient'
5901
5902 if recordingstate = 'R' then
5903 'CancelRecordKeys'
5904
5905 elseif alt_R_active <> '' then
5906 'SetMessageLine '\0
5907 'ToggleFrame 2 'alt_R_active -- restore status of messageline
5908 alt_R_active = ''
5909
5910 elseif mousemarkinginfo <> '' then
5911 -- Just cancel the mark action (internally defined) and don't open
5912 -- commandline. The unmarking will happen just at releasing MB 2,
5913 -- not immediately. To unmark the text immediately, another PM window
5914 -- has to be shown, like the commandline window.
5915 'MH_CancelMark'
5916
5917 -- Workaround for catching the last char of a line as last char of a mark
5918 call MouseMarkEnableHighlight()
5919
5920 else
5921 'HighlightCursor'
5922 Cmd
5923 endif
5924
5925; ---------------------------------------------------------------------------
5926defc SaveOrSaveAs
5927 fTempFile = (leftstr( .filename, 1) = '.')
5928 -- Let 'Save' open the Save-as dialog for unmodified virtual files to
5929 -- query fTempFile and PrevFilename of 'Save' correctly
5930 if .modify | fTempFile then
5931 'Save'
5932 else
5933 'SayError No changes. Press Enter to Save anyway.'
5934 'SaveAs_Dlg 0' -- better show file selector
5935 -- new optional arg, 0 => no EXIST_OVERLAY__MSG
5936 endif
5937
5938; ---------------------------------------------------------------------------
5939defc SmartSave
5940 if .modify then
5941 'Save'
5942 else
5943 'SayError No changes.'
5944 endif
5945
5946; ---------------------------------------------------------------------------
5947defc FileOrQuit
5948 if .modify then
5949 'File'
5950 else
5951 'Quit'
5952 endif
5953
5954; ---------------------------------------------------------------------------
5955defc EditFileDlg
5956 universal ring_enabled
5957 if not ring_enabled then
5958 'SayError 'NO_RING__MSG
5959 return
5960 endif
5961 'OpenDlg EDIT'
5962
5963; ---------------------------------------------------------------------------
5964defc Prevfile
5965 -- Workaround: This avoids unwanted window scrolling of the previous file.
5966 'VSyncCursor'
5967 prevfile
5968
5969; ---------------------------------------------------------------------------
5970defc NextFile
5971 -- Workaround: This avoids unwanted window scrolling of the previous file.
5972 'VSyncCursor'
5973 nextfile
5974
5975; ---------------------------------------------------------------------------
5976defc UndoLine
5977 call NextCmdAltersText()
5978 undo
5979
5980; ---------------------------------------------------------------------------
5981defc InsertToggle
5982 inserttoggle
5983 call Fixup_Cursor()
5984
5985; ---------------------------------------------------------------------------
5986defc PrevChar, Left
5987 NumCols = arg( 1)
5988
5989 call UnmarkOnAnyKey()
5990 'VSyncIfKeepCursor'
5991
5992 fScrollLockH = 0
5993 if Scroll_Lock() then
5994 KeyPath = '\NEPMD\User\CursorPos\ScrollLockH'
5995 fScrollLockH = QueryConfigKey( KeyPath)
5996 endif
5997 if fScrollLockH then
5998 'ScrollLeft' NumCols
5999 else
6000 'MoveCursorLeft' NumCols
6001 endif
6002
6003 'MatchFindOnMove'
6004
6005; ---------------------------------------------------------------------------
6006; Moves left without unmark.
6007defc MoveCursorLeft
6008 NumCols = arg( 1)
6009 if NumCols = '' then
6010 NumCols = 1
6011 elseif not IsNum( NumCols) then
6012 NumCols = 1
6013 endif
6014
6015 'VSyncIfKeepCursor'
6016
6017 do n = 1 to NumCols
6018 if .line > 1 & .col = 1 then
6019 up
6020 endline
6021 else
6022 left
6023 endif
6024 enddo
6025
6026; ---------------------------------------------------------------------------
6027defc MarkPrevChar, MarkLeft
6028 startline = .line
6029 startcol = .col
6030 if .line > 1 & .col = 1 then
6031 up
6032 endline
6033 else
6034 left
6035 endif
6036 call Extend_Mark( startline, startcol, 0)
6037
6038; ---------------------------------------------------------------------------
6039defc PrevPage, PageUp
6040 NextCmdChangesLinePos()
6041 call UnmarkOnAnyKey()
6042 'VSyncIfKeepCursor'
6043
6044 pageup
6045
6046 'MatchFindOnMove'
6047
6048; ---------------------------------------------------------------------------
6049defc NextPage, PageDown
6050 NextCmdChangesLinePos()
6051 call UnmarkOnAnyKey()
6052 'VSyncIfKeepCursor'
6053
6054 pagedown
6055
6056 'MatchFindOnMove'
6057
6058; ---------------------------------------------------------------------------
6059defc MarkPageUp
6060 NextCmdChangesLinePos()
6061 startline = .line
6062 startcol = .col
6063 pageup
6064 if .line then
6065 call Extend_Mark( startline, startcol, 0)
6066 endif
6067 if .line = 0 then
6068 -- Not for insert below
6069 KeyPath = '\NEPMD\User\Mark\LineInsert'
6070 LineInsert = QueryConfigKey( KeyPath)
6071 if LineInsert = 'A' then
6072 .line = 1
6073 endif
6074 endif
6075
6076; ---------------------------------------------------------------------------
6077defc MarkPageDown
6078 NextCmdChangesLinePos()
6079 startline = .line
6080 startcol = .col
6081 pagedown
6082 if .line then -- required if cursor is in line 0
6083 call Extend_Mark( startline, startcol, 1)
6084 endif
6085
6086; ---------------------------------------------------------------------------
6087defc NextChar, Right
6088 NumCols = arg( 1)
6089
6090 call UnmarkOnAnyKey()
6091 'VSyncIfKeepCursor'
6092
6093 fScrollLockH = 0
6094 if Scroll_Lock() then
6095 KeyPath = '\NEPMD\User\CursorPos\ScrollLockH'
6096 fScrollLockH = QueryConfigKey( KeyPath)
6097 endif
6098 if fScrollLockH then
6099 'ScrollRight' NumCols
6100 else
6101 'MoveCursorRight' NumCols
6102 endif
6103
6104 'MatchFindOnMove'
6105
6106; ---------------------------------------------------------------------------
6107; Moves right without unmark. Used for buffer.
6108defc MoveCursorRight
6109 universal cursoreverywhere
6110
6111 NumCols = arg( 1)
6112 if NumCols = '' then
6113 NumCols = 1
6114 elseif not IsNum( NumCols) then
6115 NumCols = 1
6116 endif
6117
6118 'VSyncIfKeepCursor'
6119
6120 if .line then
6121 l = length( textline( .line))
6122 else
6123 l = .col
6124 endif
6125 if (.line < .last) & (.col > l) & not cursoreverywhere then
6126 down
6127 beginline
6128 elseif (.line = .last) & (.col > l) & not cursoreverywhere then
6129 -- nop
6130 else
6131 right
6132 endif
6133
6134; ---------------------------------------------------------------------------
6135defc MarkNextChar, MarkRight
6136 startline = .line
6137 startcol = .col
6138 if .line then
6139 l = length( textline( .line))
6140 else
6141 l = .col
6142 endif
6143 if .line < .last & .col > l then
6144 down
6145 beginline
6146 elseif .line <> .last | .col <= l then
6147 right
6148 endif
6149 call Extend_Mark( startline, startcol, 1)
6150
6151/*
6152; ---------------------------------------------------------------------------
6153defc BeginFile
6154 .line = 1
6155 beginline
6156
6157; ---------------------------------------------------------------------------
6158defc EndFile
6159 .line = .last
6160 endline
6161*/
6162
6163; ---------------------------------------------------------------------------
6164defc MarkBeginFile
6165 NextCmdChangesLinePos()
6166 startline = .line
6167 startcol = .col
6168 .line = 1
6169 beginline
6170 if startline then -- required if cursor was on line 0
6171 call Extend_Mark( startline, startcol, 0)
6172 end
6173
6174; ---------------------------------------------------------------------------
6175defc MarkEndFile
6176 NextCmdChangesLinePos()
6177 startline = .line
6178 startcol = .col
6179 .line = .last
6180 if .line then -- required if cursor was on line 0
6181 endline
6182 call Extend_Mark( startline, startcol, 1)
6183 endif
6184
6185; ---------------------------------------------------------------------------
6186defc ScrollLeft
6187 NumCols = arg( 1)
6188 if NumCols = '' then
6189 NumCols = 1
6190 elseif not IsNum( NumCols) then
6191 NumCols = 1
6192 endif
6193
6194 call UnmarkOnAnyKey()
6195 'VSyncIfKeepCursor'
6196
6197 do n = 1 to NumCols
6198 oldcursorx = .cursorx
6199 if .col - .cursorx then
6200 .col = .col - .cursorx
6201 .cursorx = oldcursorx
6202 elseif .cursorx > 1 then
6203 left
6204 endif
6205 enddo
6206
6207 'MatchFindOnMove'
6208
6209; ---------------------------------------------------------------------------
6210defc ScrollRight
6211 NumCols = arg( 1)
6212 if NumCols = '' then
6213 NumCols = 1
6214 elseif not IsNum( NumCols) then
6215 NumCols = 1
6216 endif
6217
6218 call UnmarkOnAnyKey()
6219 'VSyncIfKeepCursor'
6220
6221 do n = 1 to NumCols
6222 oldcursorx = .cursorx
6223 a = .col + .windowwidth - .cursorx + 1
6224 if a <= MAXCOL then
6225 .col = a
6226 .cursorx = oldcursorx
6227 elseif .col < MAXCOL then
6228 right
6229 endif
6230 enddo
6231
6232 'MatchFindOnMove'
6233
6234; ---------------------------------------------------------------------------
6235defc CenterLine
6236 call UnmarkOnAnyKey()
6237 oldline = .line
6238 .cursory = .windowheight % 2
6239 -- .cursory makes the cursor unvisible after scrolling
6240 -- and if cursor wasn't on screen before.
6241 oldline
6242
6243; ---------------------------------------------------------------------------
6244; Todo: Move marked lines
6245; Menu item: Flags:
6246; Backtab [moves text] Text
6247; [moves text over whitespace] Text Whitespace
6248; [moves text in insert mode] TextIns
6249; [moves text in insert mode over whitespace] TextIns Whitespace
6250; [moves cursor] Cursor
6251defc BackTab
6252 universal matchtab_on
6253 universal curkey
6254
6255 Options = arg( 1)
6256 if Options = '' then
6257 parse value curkey with KeyString \1 .
6258 KeyPath = '\NEPMD\User\SpecialKeys\'KeyString
6259 Options = QueryConfigKey( KeyPath)
6260 endif
6261 Options = translate( upcase( Options), ' ', ',') -- uppercase, commas to spaces
6262 fText = (wordpos( 'TEXT', Options) > 0)
6263 fTextIns = (wordpos( 'TEXTINS', Options) > 0)
6264 fCursor = (wordpos( 'CURSOR', Options) > 0)
6265 fWhitespace = (wordpos( 'WHITESPACE', Options) > 0)
6266 -- Default values
6267 if not fText & not fTextIns & not fCursor then
6268 fCursor = 1
6269 endif
6270
6271 TabWidth = word( .tabs, 1)
6272
6273 call UnmarkOnAnyKey()
6274 do once = 1 to 1
6275
6276 LineStr = textline( .line)
6277 OldLineStr = LineStr
6278 -- Handle tabs: expand them to spaces before.
6279 TabWidth = word( .tabs, 1)
6280 if pos( \9, LineStr) then
6281 rcx = TabExpandLine( .line, TabWidth)
6282 endif
6283
6284 oldcol = .col -- Store .col after tab expansion
6285 oldline = .line
6286 oldcursory = .cursory
6287
6288 -- Handle MatchTab: go to word boundaries of lines above
6289 Line = .line
6290 do i = 1 to 100
6291 if not matchtab_on then
6292 leave
6293 endif
6294 if .line < 2 then
6295 leave
6296 endif
6297
6298 -- Go one line up
6299 Line = Line - 1
6300 LineStr = textline( Line)
6301
6302 -- Ignore empty lines
6303 if StripBlanks( LineStr) = '' then
6304 iterate
6305 endif
6306
6307 -- Handle tabs: expand them to spaces before
6308 fTabExpanded = 0
6309 if pos( \9, LineStr) then
6310 rcx = TabExpandLine( Line, TabWidth)
6311 fTabExpanded = 1
6312 endif
6313
6314 .lineg = Line
6315
6316 -- Go to previous word boundary
6317 backtabword
6318
6319 -- Restore line with tabs
6320 if fTabExpanded then
6321 call pReplaceLine( LineStr, Line)
6322 endif
6323
6324 -- Check more lines if col is not < oldcol
6325 if .col >= oldcol then
6326 .col = oldcol
6327 iterate
6328 -- Check more lines if col 1 is reached
6329 elseif .col = 1 then
6330 .col = oldcol
6331 iterate
6332 else
6333 leave
6334 endif
6335 enddo
6336
6337 -- Restore scroll line and cursor line
6338 .cursory = oldcursory
6339 .line = oldline
6340
6341 if .col = oldcol then
6342 backtab
6343 endif
6344 numspc = oldcol - .col
6345
6346 if fWhitespace then
6347 -- Delete only chars in whitespace area
6348 SubText = substr( OldLineStr, .col, numspc)
6349 if strip( SubText) = '' then
6350 fDelete = 1
6351 else
6352 fDelete = 0
6353 endif
6354 else
6355 -- Delete every char
6356 fDelete = 1
6357 endif
6358
6359 if fDelete & (fText | (fTextIns & insertstate())) then
6360 -- Remove spaces instead of just moving the cursor
6361 if numspc > 0 then
6362 .col = oldcol
6363 do n = 1 to numspc
6364 'BackSpace'
6365 enddo
6366 endif
6367 endif
6368
6369 enddo
6370
6371; ---------------------------------------------------------------------------
6372; Todo: Move marked lines
6373; Menu item: Flags:
6374; Tab [moves text with spaces] Text Sapces
6375; [moves text with tab] Text Tab
6376; [moves text in insert mode with spaces] TextIns Spaces
6377; [moves text in insert mode with tab] TextIns Tab
6378; [moves cursor] Cursor
6379defc Tab
6380 universal stream_mode
6381 universal matchtab_on
6382 universal ondbcs
6383 universal curkey
6384
6385 Options = arg( 1)
6386 if Options = '' then
6387 parse value curkey with KeyString \1 .
6388 KeyPath = '\NEPMD\User\SpecialKeys\'KeyString
6389 Options = QueryConfigKey( KeyPath)
6390 endif
6391 Options = translate( upcase( Options), ' ', ',') -- uppercase, commas to spaces
6392 Options = ChangeStr( 'TABS', Options, 'TAB') -- eventually correct typo
6393 fText = (wordpos( 'TEXT', Options) > 0)
6394 fTextIns = (wordpos( 'TEXTINS', Options) > 0)
6395 fCursor = (wordpos( 'CURSOR', Options) > 0)
6396 fSpaces = (wordpos( 'SPACES', Options) > 0)
6397 fTab = (wordpos( 'TAB', Options) > 0)
6398 -- Default values
6399 if not fText & not fTextIns & not fCursor then
6400 fText = 1
6401 endif
6402 if not fCursor & not fSpaces & not fTab then
6403 fSpaces = 1
6404 endif
6405 if fCursor then
6406 fSpaces = 0
6407 fTab = 0
6408 endif
6409
6410 TabWidth = word( .tabs, 1)
6411
6412 do once = 1 to 1
6413 if fTab & (fText | (fTextIns & insertstate())) then
6414 call Process_Key( \9)
6415 leave
6416 endif
6417
6418 call UnmarkOnAnyKey()
6419
6420 oldcol = .col
6421 oldline = .line
6422 oldcursory = .cursory
6423 expandedcol = .col
6424
6425 do i = 1 to 100
6426 if not matchtab_on then
6427 leave
6428 endif
6429 if .line < 2 then
6430 leave
6431 endif
6432
6433 -- Go one line up
6434 .lineg = .line - 1
6435 LineStr = textline( .line)
6436
6437 -- Ignore empty lines
6438 if StripBlanks( LineStr) = '' then
6439 iterate
6440 endif
6441
6442 -- Handle tabs: expand them to spaces before
6443 fTabExpanded = 0
6444 if pos( \9, LineStr) then
6445 rcx = TabExpandLine( .line, TabWidth)
6446 fTabExpanded = 1
6447 endif
6448
6449 -- Go to next word boundary or to line end
6450 .col = oldcol
6451 tabword
6452 expandedcol = .col
6453
6454 -- Restore line with tabs
6455 if fTabExpanded then
6456 call pReplaceLine( LineStr, .line)
6457 endif
6458
6459 -- Check more lines if col is not > oldcol
6460 if expandedcol <= oldcol then
6461 expandedcol = oldcol
6462 iterate
6463 else
6464 leave
6465 endif
6466 enddo
6467
6468 -- Restore scroll line and cursor line
6469 .cursory = oldcursory
6470 .line = oldline
6471
6472 -- Go to tabstop col after expansion
6473 .col = expandedcol
6474
6475 if .col = oldcol then
6476 tab
6477 endif
6478
6479 if fText | (fTextIns & insertstate()) then
6480 -- Insert spaces instead of just moving the cursor
6481 numspc = .col - oldcol
6482 -- Handle DBCS
6483 do once2 = 1 to 1
6484 if not ondbcs then -- If we're on DBCS,
6485 leave
6486 endif
6487 if matchtab_on and .line > 1 then -- and didn't do a matchtab,
6488 leave
6489 endif
6490 if words( .tabs) > 1 then
6491 if not wordpos( .col, .tabs) then -- check if on a tab col.
6492 do i = 1 to words( .tabs) -- If we got shifted due to being inside a DBC,
6493 if word( .tabs, i) > oldcol then -- find the col we *should* be in, and
6494 numspc = word( .tabs, i) - oldcol -- set numspc according to that.
6495 leave
6496 endif
6497 enddo
6498 endif
6499 elseif (.col // .tabs) <> 1 then
6500 numspc = .tabs - (oldcol + .tabs - 1) // .tabs
6501 endif
6502 enddo -- once2
6503 -- Insert spaces
6504 if numspc > 0 then
6505 .col = oldcol
6506 call Process_Keys( copies( ' ', numspc))
6507 endif
6508 endif
6509
6510 enddo -- once
6511
6512; ---------------------------------------------------------------------------
6513defc BackTabWord
6514 backtabword
6515
6516; ---------------------------------------------------------------------------
6517defc TabWord
6518 tabword
6519
6520; ---------------------------------------------------------------------------
6521defc MarkUp
6522 NextCmdChangesLinePos()
6523 startline = .line
6524 startcol = .col
6525 call UpDownKey( 0)
6526 if .line then
6527 call Extend_Mark( startline, startcol, 0)
6528 endif
6529 if .line = 0 then
6530 -- Not for insert below
6531 KeyPath = '\NEPMD\User\Mark\LineInsert'
6532 LineInsert = QueryConfigKey( KeyPath)
6533 if LineInsert = 'A' then
6534 .lineg = 1
6535 endif
6536 endif
6537
6538; ---------------------------------------------------------------------------
6539defc DefaultPaste
6540 call NextCmdAltersText()
6541 KeyPath = '\NEPMD\User\Mark\DefaultPaste'
6542 next = substr( upcase( QueryConfigKey( KeyPath)), 1, 1)
6543 if next = 'L' then
6544 style = 'L'
6545 elseif next = 'B' then
6546 style = 'B'
6547 else
6548 style = 'C'
6549 endif
6550 call ReplaceMark()
6551 'Paste' style
6552
6553; ---------------------------------------------------------------------------
6554defc AlternatePaste
6555 call NextCmdAltersText()
6556 KeyPath = '\NEPMD\User\Mark\DefaultPaste'
6557 next = substr( upcase( QueryConfigKey( KeyPath)), 1, 1)
6558 if next = 'L' then
6559 altstyle = 'C'
6560 elseif next = 'B' then
6561 altstyle = 'C'
6562 else
6563 altstyle = 'L'
6564 endif
6565 call ReplaceMark()
6566 'Paste' altstyle
6567
6568; ---------------------------------------------------------------------------
6569; Insert the char from the line above at cursor position.
6570; May get executed repeatedly to copy an entire expression without
6571; cluttering the undo list at every single execution.
6572; From Luc van Bogaert.
6573defc InsertCharAbove
6574 if .line > 1 then
6575 -- suppress autosave and undo (for during repeated use)
6576 saved_autosave = .autosave
6577 .autosave = 0
6578 call NextCmdAltersText()
6579
6580 -- force overwrite mode
6581 i_s = insertstate()
6582 if i_s then
6583 inserttoggle -- Turn off insert mode
6584 endif
6585
6586 line = textline( .line - 1) -- line above
6587 char = substr( line, .col, 1)
6588 keyin char
6589
6590 if i_s then
6591 inserttoggle
6592 endif
6593
6594 .autosave = saved_autosave
6595 endif
6596
6597; ---------------------------------------------------------------------------
6598; Insert the char from the line below at cursor position.
6599; May get executed repeatedly to copy an entire expression without
6600; cluttering the undo list at every single execution.
6601; From Luc van Bogaert.
6602defc InsertCharBelow
6603 if .line < .last then
6604 -- suppress autosave and undo (for during repeated use)
6605 saved_autosave = .autosave
6606 .autosave = 0
6607 call NextCmdAltersText()
6608
6609 -- force overwrite mode
6610 i_s = insertstate()
6611 if i_s then
6612 inserttoggle -- Turn off insert mode
6613 endif
6614
6615 line = textline( .line + 1) -- line below
6616 char = substr( line, .col, 1)
6617 keyin char
6618
6619 if i_s then
6620 inserttoggle
6621 endif
6622
6623 .autosave = saved_autosave
6624 endif
6625
6626; ---------------------------------------------------------------------------
6627; Add a new line before the current, move to it, keep col.
6628defc NewLineBefore
6629 call NextCmdAltersText()
6630 insertline ''
6631 up
6632
6633; ---------------------------------------------------------------------------
6634; Add a new line after the current, move to it, keep col.
6635defc NewLineAfter
6636 call NextCmdAltersText()
6637 insertline '', .line + 1
6638 down
6639
6640; ---------------------------------------------------------------------------
6641; Define a_1, because alt_1 is only defined since ALT_1.E is redefined.
6642defc A_1
6643 'Alt_1'
6644
Note: See TracBrowser for help on using the repository browser.