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

Last change on this file since 2566 was 2566, checked in by Andreas Schnellbacher, 12 years ago
  • Property svn:keywords set to Date Revision Author HeadURL Id
File size: 103.6 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 2566 2012-12-30 20:37:11Z 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 being externally compiled...
23 define INCLUDING_FILE = 'KEYS.E'
24
25 include 'stdconst.e'
26
27const
28 tryinclude 'MYCNF.E'
29 compile if not defined(SITE_CONFIG)
30 const SITE_CONFIG = 'SITECNF.E'
31 compile endif
32 compile if SITE_CONFIG
33 tryinclude SITE_CONFIG
34 compile endif
35
36const
37 compile if not defined(NLS_LANGUAGE)
38 NLS_LANGUAGE = 'ENGLISH'
39 compile endif
40 include NLS_LANGUAGE'.e'
41
42 EA_comment 'This defines definitions for keysets.'
43
44; In case someone executes 'keys' by mistake, the module would be unlinked.
45; So link it again:
46defmain
47 sayerror 'Executing defmain of' INCLUDING_FILE
48 'postme link keys'
49 -- The STOP statement won't avoid unlinking here
50
51compile endif -- not defined(SMALL)
52
53const
54-- Normally, when you shift a mark left or right, text to the right of the
55-- marked area moves with it. Bob Langer supplied code that lets us shift
56-- only what's inside the mark. The default is the old behavior.
57compile if not defined(SHIFT_BLOCK_ONLY)
58 SHIFT_BLOCK_ONLY = 0
59compile endif
60;-- Respect the Scroll lock key? If set to 1, Shift+F1 - Shift+F4 must not be
61;-- redefined. (The cursor keys execute those keys directly, in order to
62;-- avoid duplicating code.) Note that setting this flag turns off the internal
63;-- cursor key handling, so if WANT_CUA_MARKING = 'SWITCH',
64;-- WANT_STREAM_EDITING = 'SWITCH', and RESPECT_SCROLL_LOCK = 1, cursor movement
65;-- might be unacceptably slow.
66compile if not defined(RESPECT_SCROLL_LOCK)
67 RESPECT_SCROLL_LOCK = 1
68compile endif
69-- Ver.3.09: Set this to 1 if you want the FILE key to quit rather than
70-- save the file if the file was not modified. Has the side effect that
71-- the Name command sets .modify to 1.
72compile if not defined(SMARTFILE)
73 SMARTFILE = 1
74compile endif
75-- For Toolkit developers - set to 0 if you don't want the user to be able
76-- to go to line 0. Affects MH_gotoposition in MOUSE.E and Def Up in STDKEYS.E.
77-- Must be set to 1 in order to enable a copy line action to the top. (Copy line
78-- copies a line after the current line.)
79compile if not defined(TOP_OF_FILE_VALID)
80 -- Can be '0', '1', or 'STREAM' (dependant on STREAM_MODE)
81 TOP_OF_FILE_VALID = 1
82compile endif
83-- Determines if DBCS support should be included in the macros. Note
84-- that EPM includes internal DBCS support; other versions of E do not.
85compile if not defined(WANT_DBCS_SUPPORT)
86 WANT_DBCS_SUPPORT = 1
87compile endif
88-- Allow pressing tab in insert mode to insert spaces to next tab stop in
89-- line mode as well as in stream mode.
90compile if not defined(WANT_TAB_INSERTION_TO_SPACE)
91 -- for line mode only
92 WANT_TAB_INSERTION_TO_SPACE = 0
93compile endif
94compile if not defined(WORD_MARK_TYPE)
95 -- Bug using 'BLOCK':
96 -- If a block is copied to the clipboard, a CRLF is appended.
97 -- Sh+Ins will insert this CRLF instead of ignoring it.
98 --WORD_MARK_TYPE = 'BLOCK' -- changed by aschn
99 WORD_MARK_TYPE = 'CHAR'
100compile endif
101; ---------------------------------------------------------------------------
102definit
103 universal blockreflowflag
104
105 blockreflowflag = 0
106compile if defined(ACTIONS_ACCEL__L) -- For CUSTEPM support
107 call AddAVar( 'usedmenuaccelerators', 'A')
108compile endif
109compile if defined(TEX_BAR__MSG) -- For TFE or EPMTeX support
110 call AddAVar( 'usedmenuaccelerators', 'T')
111compile endif
112compile if defined(ECO_MENU__MSG) -- For ECO support
113 call AddAVar( 'usedmenuaccelerators', 'I')
114compile endif
115
116 -- These keys must be defined as ETK keys, not as accelerator keys.
117 -- Otherwise typing single accent keys like ^ï` and entering a char via
118 -- its key code with Alt and the keypad numers won't work.
119 -- This array var value must be specified in lowercase and with the
120 -- underscore as prefix separator: c_, a_ or s_ (not + or -)
121 call AddAVar( 'etkkeys', 'space a_1 a_2 a_3 a_4 a_5 a_6 a_7 a_8 a_9 a_0')
122
123; ---------------------------------------------------------------------------
124; Apparently edit_keys must be defined in EPM.EX as first ETK keyset.
125; Therefore "defkeys edit_keys new clear" was moved to STDCNF.E to be
126; included early.
127;
128; The standard ETK keyset "edit_keys" is mainly a dummy keyset, compared to
129; the original EPM keyset definition. It defines all keys as otherkeys,
130; except a_0 ... a_9, which are not executable as accel keys without unwanted
131; results.
132;
133; Otherkeys processes all keys for which no accel key def exists. That are
134; mainly single char keys. Process_Key works like Keyin, but handles
135; overwriting of the marked area in CUA marking mode.
136;
137; Bug in EPM's ETK keyset handling:
138; .keyset = '<new_keyset>' works only, if <new_keyset> was defined in
139; the same .EX file, from where the keyset should be changed.
140; Therefore (as a workaround) switch temporarily to the externally
141; defined keyset in order to make it known for 'SetKeys':
142;
143; definit -- required for a separately compiled package
144; saved_keys = .keyset
145; .keyset = '<new_keyset>'
146; .keyset = saved_keys
147;
148; Note: An .EX file, that defines a keyset, can't be unlinked, when this
149; keyset is in use.
150
151/***
152; This defines the standard keyset. It's important to use the option 'clear'.
153; Otherwise otherkeys won't process the standard letters, numbers and chars.
154defkeys edit_keys new clear
155
156; For testing:
157;def '„'
158; dprintf( 'lastkey() = 'lastkey()', ch = 'ch)
159; call SaveKeyCmd( lastkey())
160; call Process_Keys( 'ae')
161
162; Alt+0 ... Alt+9 keys:
163; These standard key defs are not executed as accel keys in order to keep
164; entering a char via Alt+numpad key working.
165; Because accel keys don't create a WM_CHAR message, they can't be handled
166; by lastkey or getkeystate.
167; To assign code to these keys, they have to be additionally defined via the
168; DefKey proc (which is used for defining accel keys). DefKey handles them
169; specially: It sets just an array var, that is queried and executed by
170; ExecKeyCmd.
171def a_1 'ExecKeyCmd a_1'
172def a_2 'ExecKeyCmd a_2'
173def a_3 'ExecKeyCmd a_3'
174def a_4 'ExecKeyCmd a_4'
175def a_5 'ExecKeyCmd a_5'
176def a_6 'ExecKeyCmd a_6'
177def a_7 'ExecKeyCmd a_7'
178def a_8 'ExecKeyCmd a_8'
179def a_9 'ExecKeyCmd a_9'
180def a_0 'ExecKeyCmd a_0'
181
182; Space key:
183; In order to type the single accent key '^' which is created by
184; <hat_key>+<space>, space must not be defined as accel key. Therefore
185; Space is defined with ExecKeyCmd. That means that it executes the
186; command that is stored by DefKey( Space, cmd) as an array var.
187def space 'ExecKeyCmd space'
188
189def otherkeys
190 'otherkeys'
191***/
192
193; ---------------------------------------------------------------------------
194; Executes only executekey lastkey() and debugging. Can be used by every
195; newly defined keyset.
196; This should process all standard letters (lowercase and uppercase), numbers
197; and chars with the length = 1. All combinations with Ctrl, Alt, Shift are
198; handled by accelerator key definitions to allow for more definable
199; combinations and to ease the definition of undo and key recording.
200defc otherkeys
201 k = lastkey()
202 if length( k) = 1 then
203 call SaveKeyCmd( k)
204 endif
205 --executekey k
206 call Process_Key( k)
207
208; ---------------------------------------------------------------------------
209; Standard key defs don't work for numpad keys, only for keypad keys.
210; Therefore numpad keys don't have to be filtered out here.
211; Numpad keys can be redefined via accel keys, but then entering chars by
212; entering its keycode via Alt+numpad keys won't work anymore.
213defc ExecKeyCmd
214 -- The array var is internally set by the DefKey proc if Alt+num keys
215 -- were defined via DefKey.
216 Key = arg(1)
217 Cmd = GetAVar( 'keydef.'Key)
218 call SaveKeyCmd( Key''\1''Cmd)
219
220 if Cmd <> '' then
221 Cmd
222 else
223 k = lastkey()
224 call Process_Key( k)
225 endif
226
227; ---------------------------------------------------------------------------
228; An accelerator key issues a WM_COMMAND message, which is processed by the
229; ProcessCommand command defined in menu.e.
230; Some other defs where accelerator keys are filtered are:
231; def otherkeys, defproc process_key, defc ProcessOtherKeys
232; queryaccelstring returns the command connected with the specified menu item
233; or accelerator key def.
234
235; ---------------------------------------------------------------------------
236; Add or redefine an entry to the active named accelerator key table.
237;
238; Syntax: DefKey( KeyString, Cmd[, 'L'])
239;
240; KeyString prefixes are separated by '_', '+' or '-'. The following
241; prefixes are defined:
242; 'c_' Ctrl
243; 's_' Shift
244; 'a_' Alt
245; In this definition the order of the prefixes doesn't matter, while
246; on execution, the KeyString prefixes are used in the above order.
247; Cmd must be an E command string, not E code.
248; 'L' is the option for defining the key as a lonekey
249; (a lonekey is executed once on releasing the key)
250;
251; Examples:
252; DefKey( 'c_s_Q', 'sayerror Ctrl+Shift+Q pressed')
253; DefKey( 'c+s+q', 'sayerror Ctrl+Shift+Q pressed') (equivalent)
254; DefKey( 'C-S-q', 'sayerror Ctrl+Shift+Q pressed') (equivalent)
255; DefKey( 'altgraf', 'sayerror AltGraf key pressed', 'L')
256; For defining non-ASCII keys that don't match the upcase or lowcase
257; procedure processing, the key has to be defined in the correct
258; case:
259; DefKey( '„', 'sayerror Lowercase „ (a-umlaut) pressed')
260; DefKey( 's_Ž', 'sayerror Uppercase „ (a-umlaut) pressed')
261;
262; For standard accel table defs, the first def wins. This command changes it,
263; so that an accel table can be extended as expected: An already existing
264; accel table entry is overridden by a new one. That makes the last def win
265; and avoids multiple defs for a key.
266;
267defproc DefKey( KeyString, Cmd)
268 universal activeaccel
269 universal lastkeyaccelid
270 universal cua_menu_accel
271 Flags = 0
272
273 -- Parse lonekey option
274 fPadKey = 0
275 Options = upcase( arg(3))
276 if Options <> '' then
277 if pos( Options, 'L') > 0 then
278 Flags = Flags + AF_LONEKEY
279 endif
280 endif
281
282 String = upcase( KeyString)
283 call GetAFFlags( Flags, String, KeyString) -- removes modifier prefixes from String
284
285 -- Handle deactivated 'block Alt+letter keys from jumping to menu bar'
286 -- Note: These keys and F10 can't be recorded, they are handled by PM.
287 -- There exists no ETK procs to activate the menu.
288 if length( String) = 1 then
289 if cua_menu_accel then
290 if Flags = AF_ALT & wordpos( String, upcase( GetAVar('usedmenuaccelerators'))) then
291 return
292 endif
293 endif
294 endif
295
296 -- Remove previous key def in array vars, if any
297 PrevCmd = GetAVar('keydef.'KeyString)
298 DelAVar( 'keycmd.'PrevCmd, KeyString)
299
300 -- Save key def in array to allow for searching for KeyString and Cmd
301 SetAVar( 'keydef.'KeyString, Cmd)
302 AddAVar( 'keycmd.'Cmd, KeyString) -- may have multiple key defs
303
304 -- Handle key defs that have to be defined as ETK keys instead of PM
305 -- accelerator keys.
306 -- In order to type the single accent key '^' which is created by
307 -- <hat_key>+<space>, space must not be defined as accel key. Therefore
308 -- Space is defined with ExecKeyCmd. That means that it executes the
309 -- command that is stored by DefKey( Space, cmd) as an array var.
310 -- Ignore Alt+numpad number keys as accel keys here. Just save key in
311 -- array to query it by ExecKeyCmd.
312 -- That makes the Alt+numpad number keys work for entering a char by its
313 -- key code.
314 EtkKeys = GetAVar( 'etkkeys')
315 if wordpos( KeyString, EtkKeys) then
316 -- Save key def in a keyset-specific array
317 SetAVar( 'keydef.'activeaccel'.'KeyString, Cmd)
318 return
319 endif
320
321 if length( String) = 1 then
322 Flags = Flags + AF_CHAR
323 if Flags bitand AF_SHIFT then
324 Key = asc( upcase( String))
325 else
326 Key = asc( lowcase( String))
327 endif
328 else
329 VK = GetVKConst( String)
330 if VK > 0 then
331 Key = VK
332 Flags = Flags + AF_VIRTUALKEY
333 else
334 sayerror 'Error: Unknown key string 'KeyString' specified.'
335 --dprintf( 'KeyString = 'KeyString', Cmd = 'Cmd', Flags = 'Flags', Key = 'Key', last id = 'lastkeyaccelid)
336 return
337 endif
338 endif
339
340 AccelId = GetAVar( 'keyid.'KeyString)
341 if AccelId = '' then
342 lastkeyaccelid = lastkeyaccelid + 1
343 if lastkeyaccelid = 8101 then -- 8101 is hardcoded as 'configdlg SYS'
344 lastkeyaccelid = lastkeyaccelid + 1
345 endif
346 AccelId = lastkeyaccelid
347 endif
348 buildacceltable activeaccel, KeyString''\1''Cmd, Flags, Key, AccelId
349
350 -- Save key def in array to allow for searching for KeyString and Cmd
351 SetAVar( 'keyid.'KeyString, AccelId)
352
353 --if KeyString = 'alt' then
354 -- dprintf( 'KeyString = 'KeyString', Cmd = 'Cmd', Flags = 'Flags', Key = 'Key', id = 'lastkeyaccelid)
355 --endif
356 --if KeyString = 'c_s' then
357 -- dprintf( 'KeyString = 'KeyString', Cmd = 'Cmd', Flags = 'Flags', Key = 'Key', this id = 'AccelId', last id = 'lastkeyaccelid)
358 --endif
359
360/*
361 -- For non-letter chars: define also the shifted variant automatically
362 -- to make the defs more keyboard-independible.
363 if Flags bitand AF_CHAR and not Flags bitand AF_SHIFT then
364 if upcase( Key) = lowcase( Key) then
365 Flags = Flags + AF_SHIFT
366 lastkeyaccelid = lastkeyaccelid + 1
367 buildacceltable activeaccel, KeyString''\1''Cmd, Flags, Key, AccelId
368 endif
369 endif
370*/
371
372 return
373
374; Define a cmd to call the proc in profile.erx or for testing
375defc DefKey
376 parse arg KeyString Cmd
377 if upcase( lastword( Cmd)) = 'L' then
378 Options = 'L'
379 Cmd = subword( Cmd, 1, words( Cmd) - 1)
380 else
381 Options = ''
382 endif
383 call DefKey( KeyString, Cmd, Options)
384
385; ---------------------------------------------------------------------------
386; Syntax: UnDefKey( KeyString)
387defproc UnDefKey( KeyString)
388 universal activeaccel
389
390 AccelId = GetAVar( 'keyid.'KeyString)
391 if AccelId <> '' then
392 -- Define Ctrl+Alt (= nothing) for this id
393 -- Don't change the array var to allow for redining this id again
394 buildacceltable activeaccel, '', AF_CONTROL+AF_VIRTUALKEY, VK_ALT, AccelId
395 else
396 -- No error message if key was not defined before
397 endif
398
399 return
400
401; Define a cmd to call the proc in profile.erx or for testing
402defc UnDefKey
403 parse arg KeyString
404 call UnDefKey( KeyString)
405
406; ---------------------------------------------------------------------------
407defproc GetAFFlags( var Flags, var String, var KeyString)
408 -- Get prefix
409 fC_Prefix = 0
410 fA_Prefix = 0
411 fS_Prefix = 0
412 fdone = 0
413 do while (fdone = 0 & length( String) > 2)
414 p = pos( leftstr( String, 1), 'CAS')
415 if p & pos( substr( String, 2, 1), '_-+') then
416 String = substr( String, 3)
417 if p = 1 then
418 fC_Prefix = 1
419 elseif p = 2 then
420 fA_Prefix = 1
421 elseif p = 3 then
422 fS_Prefix = 1
423 endif
424 else
425 fdone = 1
426 endif
427 enddo
428 KeyString = ''
429 if fC_Prefix = 1 then
430 Flags = Flags + AF_CONTROL
431 KeyString = KeyString'c_'
432 endif
433 if fA_Prefix = 1 then
434 Flags = Flags + AF_ALT
435 KeyString = KeyString'a_'
436 endif
437 if fS_Prefix = 1 then
438 Flags = Flags + AF_SHIFT
439 KeyString = KeyString's_'
440 endif
441 if length( String) > 1 then
442 KeyString = KeyString''GetVKName( String)
443 elseif length( String) > 0 then
444 KeyString = KeyString''lowcase( String)
445 endif
446
447; ---------------------------------------------------------------------------
448defproc GetVKConst( String)
449 VK = 0
450 String = upcase( String)
451 if String = 'BREAK' then VK = VK_BREAK
452 elseif String = 'BACKSPACE' then VK = VK_BACKSPACE
453 elseif String = 'BKSPC' then VK = VK_BACKSPACE
454 elseif String = 'TAB' then VK = VK_TAB
455 elseif String = 'BACKTAB' then VK = VK_BACKTAB
456 elseif String = 'NEWLINE' then VK = VK_NEWLINE -- This is the regular Enter key
457 elseif String = 'SHIFT' then VK = VK_SHIFT
458 elseif String = 'CTRL' then VK = VK_CTRL
459 elseif String = 'ALT' then VK = VK_ALT
460 elseif String = 'ALTGRAF' then VK = VK_ALTGRAF
461 elseif String = 'ALTGR' then VK = VK_ALTGRAF
462 elseif String = 'PAUSE' then VK = VK_PAUSE
463 elseif String = 'CAPSLOCK' then VK = VK_CAPSLOCK
464 elseif String = 'ESC' then VK = VK_ESC
465 elseif String = 'SPACE' then VK = VK_SPACE
466 elseif String = 'PAGEUP' then VK = VK_PAGEUP
467 elseif String = 'PGUP' then VK = VK_PAGEUP
468 elseif String = 'PAGEDOWN' then VK = VK_PAGEDOWN
469 elseif String = 'PGDOWN' then VK = VK_PAGEDOWN
470 elseif String = 'PGDN' then VK = VK_PAGEDOWN
471 elseif String = 'END' then VK = VK_END
472 elseif String = 'HOME' then VK = VK_HOME
473 elseif String = 'LEFT' then VK = VK_LEFT
474 elseif String = 'UP' then VK = VK_UP
475 elseif String = 'RIGHT' then VK = VK_RIGHT
476 elseif String = 'DOWN' then VK = VK_DOWN
477 elseif String = 'DN' then VK = VK_DOWN
478 elseif String = 'PRINTSCRN' then VK = VK_PRINTSCRN
479 elseif String = 'INSERT' then VK = VK_INSERT
480 elseif String = 'INS' then VK = VK_INSERT
481 elseif String = 'DELETE' then VK = VK_DELETE
482 elseif String = 'DEL' then VK = VK_DELETE
483 elseif String = 'SCRLLOCK' then VK = VK_SCRLLOCK
484 elseif String = 'NUMLOCK' then VK = VK_NUMLOCK
485 elseif String = 'ENTER' then VK = VK_ENTER -- This is the numeric keypad Enter key
486 elseif String = 'PADENTER' then VK = VK_ENTER -- This is the numeric keypad Enter key
487 elseif String = 'SYSRQ' then VK = VK_SYSRQ
488 elseif String = 'F1' then VK = VK_F1
489 elseif String = 'F2' then VK = VK_F2
490 elseif String = 'F3' then VK = VK_F3
491 elseif String = 'F4' then VK = VK_F4
492 elseif String = 'F5' then VK = VK_F5
493 elseif String = 'F6' then VK = VK_F6
494 elseif String = 'F7' then VK = VK_F7
495 elseif String = 'F8' then VK = VK_F8
496 elseif String = 'F9' then VK = VK_F9
497 elseif String = 'F10' then VK = VK_F10
498 elseif String = 'F11' then VK = VK_F11
499 elseif String = 'F12' then VK = VK_F12
500 endif
501 return VK
502
503; ---------------------------------------------------------------------------
504defproc GetVKName( String)
505 VK = ''
506 String = upcase( String)
507 if String = 'BREAK' then VK = 'break'
508 elseif String = 'BACKSPACE' then VK = 'backspace'
509 elseif String = 'BKSPC' then VK = 'backspace'
510 elseif String = 'TAB' then VK = 'tab'
511 elseif String = 'BACKTAB' then VK = 'backtab'
512 elseif String = 'NEWLINE' then VK = 'newline' -- This is the regular Enter key
513 elseif String = 'SHIFT' then VK = 'shift'
514 elseif String = 'CTRL' then VK = 'ctrl'
515 elseif String = 'ALT' then VK = 'alt'
516 elseif String = 'ALTGRAF' then VK = 'altgraf'
517 elseif String = 'ALTGR' then VK = 'altgraf'
518 elseif String = 'PAUSE' then VK = 'pause'
519 elseif String = 'CAPSLOCK' then VK = 'capslock'
520 elseif String = 'ESC' then VK = 'esc'
521 elseif String = 'SPACE' then VK = 'space'
522 elseif String = 'PAGEUP' then VK = 'pageup'
523 elseif String = 'PGUP' then VK = 'pageup'
524 elseif String = 'PAGEDOWN' then VK = 'pagedown'
525 elseif String = 'PGDOWN' then VK = 'pagedown'
526 elseif String = 'PGDN' then VK = 'pagedown'
527 elseif String = 'END' then VK = 'end'
528 elseif String = 'HOME' then VK = 'home'
529 elseif String = 'LEFT' then VK = 'left'
530 elseif String = 'UP' then VK = 'up'
531 elseif String = 'RIGHT' then VK = 'right'
532 elseif String = 'DOWN' then VK = 'down'
533 elseif String = 'DN' then VK = 'down'
534 elseif String = 'PRINTSCRN' then VK = 'printscrn'
535 elseif String = 'INSERT' then VK = 'insert'
536 elseif String = 'INS' then VK = 'insert'
537 elseif String = 'DELETE' then VK = 'delete'
538 elseif String = 'DEL' then VK = 'delete'
539 elseif String = 'SCRLLOCK' then VK = 'scrllock'
540 elseif String = 'NUMLOCK' then VK = 'numlock'
541 elseif String = 'ENTER' then VK = 'enter' -- This is the numeric keypad Enter key
542 elseif String = 'PADENTER' then VK = 'enter' -- This is the numeric keypad Enter key
543 elseif String = 'SYSRQ' then VK = 'sysrq'
544 elseif String = 'F1' then VK = 'f1'
545 elseif String = 'F2' then VK = 'f2'
546 elseif String = 'F3' then VK = 'f3'
547 elseif String = 'F4' then VK = 'f4'
548 elseif String = 'F5' then VK = 'f5'
549 elseif String = 'F6' then VK = 'f6'
550 elseif String = 'F7' then VK = 'f7'
551 elseif String = 'F8' then VK = 'f8'
552 elseif String = 'F9' then VK = 'f9'
553 elseif String = 'F10' then VK = 'f10'
554 elseif String = 'F11' then VK = 'f11'
555 elseif String = 'F12' then VK = 'f12'
556 endif
557 return VK
558
559; ---------------------------------------------------------------------------
560defproc GetVKMenuName( String)
561 VK = ''
562 String = upcase( String)
563 if String = 'BREAK' then VK = 'Brk'
564 elseif String = 'BACKSPACE' then VK = BACKSPACE_KEY__MSG
565 elseif String = 'BKSPC' then VK = BACKSPACE_KEY__MSG
566 elseif String = 'TAB' then VK = 'Tab'
567 elseif String = 'BACKTAB' then VK = 'BackTab'
568 elseif String = 'NEWLINE' then VK = ENTER_KEY__MSG -- This is the regular Enter key
569 elseif String = 'SHIFT' then VK = SHIFT_KEY__MSG
570 elseif String = 'CTRL' then VK = CTRL_KEY__MSG
571 elseif String = 'ALT' then VK = ALT_KEY__MSG
572 elseif String = 'ALTGRAF' then VK = 'AltGraf'
573 elseif String = 'ALTGR' then VK = 'AltGraf'
574 elseif String = 'PAUSE' then VK = 'Pause'
575 elseif String = 'CAPSLOCK' then VK = 'Capslock'
576 elseif String = 'ESC' then VK = ESCAPE_KEY__MSG
577 elseif String = 'SPACE' then VK = 'Space'
578 elseif String = 'PAGEUP' then VK = 'PgUp'
579 elseif String = 'PGUP' then VK = 'PgUp'
580 elseif String = 'PAGEDOWN' then VK = 'PgDown'
581 elseif String = 'PGDOWN' then VK = 'PgDown'
582 elseif String = 'PGDN' then VK = 'PgDown'
583 elseif String = 'END' then VK = 'End'
584 elseif String = 'HOME' then VK = 'Home'
585 elseif String = 'LEFT' then VK = 'Left'
586 elseif String = 'UP' then VK = UP_KEY__MSG
587 elseif String = 'RIGHT' then VK = 'Right'
588 elseif String = 'DOWN' then VK = DOWN_KEY__MSG
589 elseif String = 'DN' then VK = DOWN_KEY__MSG
590 elseif String = 'PRINTSCRN' then VK = 'PrtScrn'
591 elseif String = 'INSERT' then VK = INSERT_KEY__MSG
592 elseif String = 'INS' then VK = INSERT_KEY__MSG
593 elseif String = 'DELETE' then VK = DELETE_KEY__MSG
594 elseif String = 'DEL' then VK = DELETE_KEY__MSG
595 elseif String = 'SCRLLOCK' then VK = 'ScrlLock'
596 elseif String = 'NUMLOCK' then VK = 'NumLock'
597 elseif String = 'ENTER' then VK = PADENTER_KEY__MSG -- This is the numeric keypad Enter key
598 elseif String = 'PADENTER' then VK = PADENTER_KEY__MSG -- This is the numeric keypad Enter key
599 elseif String = 'SYSRQ' then VK = 'SysRq'
600 elseif String = 'F1' then VK = 'F1'
601 elseif String = 'F2' then VK = 'F2'
602 elseif String = 'F3' then VK = 'F3'
603 elseif String = 'F4' then VK = 'F4'
604 elseif String = 'F5' then VK = 'F5'
605 elseif String = 'F6' then VK = 'F6'
606 elseif String = 'F7' then VK = 'F7'
607 elseif String = 'F8' then VK = 'F8'
608 elseif String = 'F9' then VK = 'F9'
609 elseif String = 'F10' then VK = 'F10'
610 elseif String = 'F11' then VK = 'F11'
611 elseif String = 'F12' then VK = 'F12'
612 endif
613 return VK
614
615; ---------------------------------------------------------------------------
616; Get key def as appendix for a menu item text, with a prepended tab char,
617; if any text
618defproc MenuAccelString
619 Cmd = arg(1)
620 AccelString = ''
621 -- Todo: allow for specifying consecutive Cmds: Cmd1,Cmd2 or Cmd1, Cmd2
622 if Cmd <> '' then
623 -- Query array var, defined by DefKey
624 KeyString = strip( GetAVar( 'keycmd.'Cmd))
625 if KeyString <> '' then
626 -- A Cmd may have multiple key defs, each appended by a space
627 do w = 1 to words( KeyString)
628 Rest = word( KeyString, w)
629 ThisString = ''
630 if pos( 'c_', Rest) = 1 then
631 ThisString = ThisString''CTRL_KEY__MSG'+'
632 Rest = substr( Rest, 3)
633 endif
634 if pos( 'a_', Rest) = 1 then
635 ThisString = ThisString''ALT_KEY__MSG'+'
636 Rest = substr( Rest, 3)
637 endif
638 if pos( 's_', Rest) = 1 then
639 ThisString = ThisString''SHIFT_KEY__MSG'+'
640 Rest = substr( Rest, 3)
641 endif
642 if Rest <> '' then
643 VKString = GetVKMenuName( Rest)
644 if VKString <> '' then
645 ThisString = ThisString''VKString
646 else
647 ThisString = ThisString''upcase( Rest)
648 endif
649 endif
650 if AccelString <> '' then
651 AccelString = AccelString' | 'ThisString
652 else
653 AccelString = ThisString
654 endif
655 enddo
656 endif
657 endif
658 if AccelString <> '' then
659 AccelString = \9''AccelString
660 endif
661 return AccelString
662
663; For testing:
664defc MenuAccelString
665 Cmd = strip( arg(1))
666 sayerror 'Menu item text appendix for "'Cmd'" is: |'MenuAccelString( Cmd)'|'
667
668; ---------------------------------------------------------------------------
669; Called by ProcessCommand in MENU.E
670defproc ExecAccelKey
671 parse value( arg(1)) with KeyString \1 Cmd
672 call SaveKeyCmd( arg(1))
673 Cmd
674 return
675
676; ---------------------------------------------------------------------------
677; Undo states were saved only here, on execution of a command, just before
678; text is altered by it. Repeated commands are ignored. Commands that don't
679; call NextCmdAltersText() won't create an undo state. That leads to
680; following behavior: Every word creates a new undo state. Leading spaces or
681; leading empty lines were added to the undo state of the following word.
682defproc NextCmdAltersText
683 universal curkey
684 universal prevkey
685 parse value curkey with KeyString \1 Cmd
686 --dprintf( 'KeyString = 'KeyString)
687
688 -- Omit new undo record for repeated keys or repeated commands
689 if curkey = prevkey then
690 -- nop
691
692/*
693 -- Omit new undo record for an unmodified file
694 -- (This is not useful if, after a redo, a state is reached where
695 -- .modify is 0.)
696 elseif not .modify then
697 -- nop
698*/
699
700/*
701 -- Activate this if space should not create a new undo state
702 elseif (KeyString = 'space' |
703 rightstr( KeyString, 6) = '_space') then
704 -- nop
705*/
706
707/*
708 -- The following option is experimental and most likely leads to too
709 -- few recorded states, e.g. when formatting or clipboard macros were
710 -- used:
711 -- Activate this if only return or enter should create a new undo state
712 elseif not (rightstr( KeyString, 7) = 'newline' |
713 rightstr( KeyString, 5) = 'enter') then
714 -- nop
715*/
716
717 -- Create a new undo record, if the current state is not already checkpointed
718 else
719 call NewUndoRec()
720 endif
721
722 return
723
724; ---------------------------------------------------------------------------
725; SaveKeyCmd is called by OtherKeys, ExecKeyCmd, ProcessCommand and
726; ExecAccelKey. It is used for ETK keys and for executing commands of accel
727; keys and menu items. It sets prevkey and curkey. In recording state, it
728; appends curkey to the recordkeys array var.
729defproc SaveKeyCmd
730 universal curkey
731 universal prevkey
732
733 if arg(1) = '' then
734 return
735 endif
736
737 prevkey = curkey
738 curkey = arg(1)
739 --dprintf( 'curkey = 'curkey)
740
741 call AddRecordKeys()
742
743 return
744
745; ---------------------------------------------------------------------------
746; Keyset array vars:
747;
748; 'keysets' list of defined keysets
749; 'keyset.'name list of used keyset cmds for keyset name
750; 'keysetcmd.'cmdname list of keysets that use cmdname
751; (this var allows for changing keysets for all
752; loaded files, not just for newly loaded files)
753;
754; Examples with cuakeys active: Examples without cuakeys active:
755; 'keysets' = 'std shell' 'keysets' = 'std shell'
756; 'keyset.std' = 'std cua' 'keyset.std' = 'std'
757; 'keysetcmd.std' = 'std shell' 'keysetcmd.std' = 'std shell'
758; 'keyset.shell' = 'std cua shell' 'keyset.shell' = 'std shell'
759; 'keysetcmd.shell' = 'shell' 'keysetcmd.shell' = 'shell'
760;
761; ---------------------------------------------------------------------------
762; Define a named accel table. It has to be activated with SetKeyset.
763;
764; Syntax: DefKeyset [<name>] [<keyset_cmd_1> <keyset_cmd_2> ...]
765; DefKeyset [<name>] [<name_3>value] <keyset_cmd_4> ...]
766;
767; Instead of a keyset cmd, a keyset name can be specified (with 'value'
768; appended). Then the specified keyset will be extended.
769defc DefAccel, DefKeyset
770 universal activeaccel
771 universal lastkeyaccelid
772 universal nepmd_hini
773 -- Default accel table name = 'std' (standard EPM uses 'defaccel')
774 StdName = 'std'
775
776 -- Init accel table defs
777 StartAccelId = 10000 -- max. = 65534 (65535 is hardcoded as Halt cmd)
778 if lastkeyaccelid < StartAccelId then
779 lastkeyaccelid = StartAccelId
780 activeaccel = StdName
781 -- Bug in ETK: first def is ignored, therefore add a dummy def here
782 -- This must be a valid def, otherwise the menu is not loaded at startup:
783 buildacceltable StdName, 'sayerror Ignored!', AF_VIRTUALKEY, VK_ALT, lastkeyaccelid
784 endif
785
786 parse arg Name List
787
788 Name = strip( Name)
789 if Name = '' | lowcase( Name) = 'edit' | lowcase( Name) = 'default' then
790 Name = StdName
791 endif
792 Name = lowcase( Name)
793
794 List = strip( List)
795 List = lowcase( List)
796 if List = '' then
797 -- Use default keyset defs
798 if Name = StdName then
799 List = StdName -- use defc stdkeys
800 else
801 List = StdName'value' Name -- extend stdkeys with defc Namekeys
802 endif
803 endif
804
805 SavedAccel = activeaccel
806 Keyset = Name
807 activeaccel = Keyset
808
809 -- The BlockAlt key subset needn't to be added to the 'keysets' array var
810 'BlockAltKeys'
811
812 -- Parse keyset definition list and get resolved list of KeysetCmds
813 -- Keyset command defs have 'Keys' appended. In the following, the
814 -- term 'keyset cmd' means the command without 'Keys'. The same applies
815 -- for the array vars, were the string without 'Keys' is used, too.
816 KeysetCmds = ''
817 do w = 1 to words( List)
818 ThisKeyset = word( List, w)
819 -- Allow for specifying a keyset name instead of a list of keyset defs
820 -- (e.g. 'stdvalue' instead of 'std cua')
821 if rightstr( ThisKeyset, 5) = 'value' and length( ThisKeyset) > 5 then
822 SubName = leftstr( ThisKeyset, length( ThisKeyset) - 5)
823 SubList = GetAVar( 'keyset.'SubName)
824 do s = 1 to words( SubList)
825 ThisSubKeyset = word( SubList, s)
826 -- Check if keyset cmd (with 'Keys' appended) exists
827 if isadefc( ThisSubKeyset'Keys') then
828 KeysetCmds = KeysetCmds ThisSubKeyset
829 endif
830 enddo
831 -- Check if keyset cmd (with 'Keys' appended) exists
832 elseif isadefc( ThisKeyset'Keys') then
833 KeysetCmds = KeysetCmds ThisKeyset
834 endif
835 enddo
836 KeysetCmds = strip( KeysetCmds)
837 -- Remove doubled entries, keep last of doubled ones
838 Next = ''
839 Rest = KeysetCmds
840 do forever
841 if Rest = '' then
842 leave
843 endif
844 parse value Rest with ThisKeyset Rest
845 ThisKeyset = strip( ThisKeyset)
846 Rest = strip( Rest)
847 if not wordpos( ThisKeyset, Rest) then
848 Next = Next ThisKeyset
849 endif
850 enddo
851 KeysetCmds = strip( Next)
852
853 if KeysetCmds <> '' then
854 -- Change array vars for this keyset name
855 PrevKeysetCmds = GetAVar( 'keyset.'Name)
856 if PrevKeysetCmds <> KeysetCmds then
857 -- For all keyset commands
858 do k = 1 to words( PrevKeysetCmds)
859 ThisKeyset = word( PrevKeysetCmds, k)
860 -- Remove keyset name from array var for this keyset cmd
861 DelAVar( 'keysetcmd.'ThisKeyset, Name)
862 enddo
863 endif
864
865 -- Set array vars for this keyset name
866 AddAVar( 'keysets', Name)
867 SetAVar( 'keyset.'Name, KeysetCmds)
868
869 --dprintf( 'DefKeySet called for: 'Name' = 'KeysetCmds)
870
871 -- For all keyset commands
872 do k = 1 to words( KeysetCmds)
873 ThisKeyset = word( KeysetCmds, k)
874 -- Add keyset name to array var for this keyset cmd
875 AddAVar( 'keysetcmd.'ThisKeyset, Name)
876 -- Execute keyset cmd (with 'Keys' appended)
877 ThisKeyset'Keys'
878 enddo
879 endif
880
881 activeaccel = SavedAccel
882
883; ---------------------------------------------------------------------------
884; Block Alt and/or AltGr from switching to the menu
885; PM defines the key F10 to jump to the menu, like Alt and AltGraf.
886; It can be used instead, if it's not redefined.
887; To block these PM def, Alt and AltGraf have to be defined with the
888; AF_LONEKEY flag.
889defc BlockAltKeys
890 universal nepmd_hini
891
892 -- Block Alt and/or AltGr from switching to the menu
893 -- PM defines the key F10 to jump to the menu, like Alt and AltGraf.
894 -- It can be used instead, if it's not redefined.
895 -- To block these PM def, Alt and AltGraf have to be defined with the
896 -- AF_LONEKEY flag.
897 -- Redefine every used accel keyset
898 KeyPath = '\NEPMD\User\Keys\AccelKeys\BlockLeftAltKey'
899 fBlocked1 = NepmdQueryConfigValue( nepmd_hini, KeyPath)
900 KeyPath = '\NEPMD\User\Keys\AccelKeys\BlockRightAltKey'
901 fBlocked2 = NepmdQueryConfigValue( nepmd_hini, KeyPath)
902
903 if fBlocked1 = 1 then
904 DefKey( 'alt', '', 'L')
905 else
906 UnDefKey( 'alt')
907 endif
908
909 if fBlocked2 = 1 then
910 DefKey( 'altgraf', '', 'L')
911 else
912 UnDefKey( 'altgraf')
913 endif
914
915; ---------------------------------------------------------------------------
916; Redefine every used accel keyset. This can be used by the menu commands
917; toggle_block_left_alt_key and toggle_block_right_alt_key to activate the
918; changed behavior for all loaded keysets.
919defc RefreshBlockAlt
920 universal nepmd_hini
921 universal activeaccel
922
923 KeyPath = '\NEPMD\User\Keys\AccelKeys\BlockLeftAltKey'
924 fBlocked1 = NepmdQueryConfigValue( nepmd_hini, KeyPath)
925 KeyPath = '\NEPMD\User\Keys\AccelKeys\BlockRightAltKey'
926 fBlocked2 = NepmdQueryConfigValue( nepmd_hini, KeyPath)
927
928 SavedAccel = activeaccel
929 KeySets = strip( GetAVar( 'keysets'))
930
931 do w = 1 to words( KeySets)
932 KeySet = word( KeySets, w)
933 activeaccel = KeySet
934
935 if fBlocked1 = 1 then
936 DefKey( 'alt', '', 'L')
937 else
938 UnDefKey( 'alt')
939 endif
940
941 if fBlocked2 = 1 then
942 DefKey( 'altgraf', '', 'L')
943 else
944 UnDefKey( 'altgraf')
945 endif
946
947 enddo
948 activeaccel = SavedAccel
949
950 activateacceltable activeaccel
951
952; ---------------------------------------------------------------------------
953defc LoadAccel
954 parse arg args
955 'SetKeyset' args -- defined in MODEXEC.E
956
957; ---------------------------------------------------------------------------
958; SetKeyset: defined in MODEEXEC.E, contains mode-specific part, calls:
959; SetKeyset2: switches keyset.
960defc SetKeyset2
961 universal activeaccel
962 parse arg Name KeyDefs
963 Name = lowcase( strip( Name))
964 -- Default accel table name = 'std' (standard EPM uses 'defaccel')
965 if Name = '' | Name = 'default' then
966 Name = 'std'
967 endif
968 KeyDefs = lowcase( strip( KeyDefs))
969
970 -- Maybe define keyset, if not already done
971 DefinedKeysets = GetAVar( 'keysets')
972 fKeysetChanged = 0
973 PrevKeyDefs = strip( GetAVar( 'keyset.'Name))
974 if KeyDefs = '' then
975 if PrevKeyDefs = '' then
976 NextKeyDefs = Name
977 else
978 NextKeyDefs = PrevKeyDefs
979 endif
980 else
981 NextKeyDefs = KeyDefs
982 endif
983
984 --dprintf( 'SetKeyset2: DefinedKeysets = "'DefinedKeysets'", PrevKeyDefs = "'PrevKeyDefs'", NextKeyDefs = "'NextKeyDefs'"')
985 if wordpos( Name, DefinedKeysets) = 0 then
986 fKeysetChanged = 1
987 elseif NextKeyDefs <> PrevKeyDefs then
988 fKeysetChanged = 1
989 endif
990 if fKeysetChanged = 1 then
991 --dprintf( 'SetKeyset2: "DefKeyset' Name KeyDefs'" called')
992 'DefKeyset' Name KeyDefs
993 endif
994
995 if fKeysetChanged | activeaccel <> Name then
996 fRefreshMenu = 1
997 else
998 fRefreshMenu = 0
999 endif
1000
1001 --dprintf( 'Keyset = 'Name', KeyDefs = 'KeyDefs', Previous: activeaccel = 'activeaccel' = 'GetAVar( 'keyset.'activeaccel)', .filename = '.filename)
1002 --dprintf( 'SetKeyset2: Name = 'Name', activeaccel = 'activeaccel', fKeysetChanged = 'fKeysetChanged', PrevKeyDefs = 'PrevKeyDefs', NextKeyDefs = 'NextKeyDefs)
1003
1004 -- Activate keyset: accelerator keys
1005 activeaccel = Name
1006 activateacceltable activeaccel
1007
1008 -- Activate keyset: keyset-specific array defs (for ExecKeyCmd)
1009 EtkKeys = GetAVar( 'etkkeys')
1010 do w = 1 to words( EtkKeys)
1011 KeyString = word( EtkKeys, w)
1012 EtkKeyDef = GetAVar( 'keydef.'Name'.'KeyString)
1013 SetAVar( 'keydef.'KeyString, EtkKeyDef)
1014 enddo
1015
1016 if fRefreshMenu then
1017
1018 if not fKeysetChanged then -- not required if DefKeyset was called above
1019 -- Get list of required *Keys cmds to redefine keyset
1020 KeysetCmds = GetAVar( 'keyset.'Name, KeysetCmds)
1021
1022 -- Redefine menu accel strings
1023 do k = 1 to words( KeysetCmds)
1024 ThisKeyset = word( KeysetCmds, k)
1025 -- Execute keyset cmd (with 'Keys' appended)
1026 ThisKeyset'Keys'
1027 enddo
1028
1029 --dprintf( ' Refresh called for: 'Name' = 'KeysetCmds)
1030 endif
1031
1032 -- Rebuild menu
1033 if isadefc( 'RefreshMenu') then
1034 'RefreshMenu'
1035 endif
1036
1037 endif
1038
1039; ---------------------------------------------------------------------------
1040defc ReloadKeyset
1041 universal activeaccel
1042
1043 'DelKeyset'
1044
1045 KeyDefs = strip( GetAVar( 'keyset.'activeaccel))
1046 -- Reset list of defined keysets to make SetKeyset2 execute DefKeyset
1047 call SetAVar( 'keysets', '')
1048 -- Redef key defs
1049 'SetKeyset2' activeaccel KeyDefs
1050
1051 'LinkKeyDefs'
1052
1053; ---------------------------------------------------------------------------
1054defc DeleteAccel, DelKeyset
1055 universal activeaccel
1056 if arg(1) = '' then
1057 Name = activeaccel
1058 else
1059 Name = arg(1)
1060 endif
1061 Name = lowcase( Name)
1062 deleteaccel Name
1063
1064 -- Change array vars for this keyset name
1065 DelAVar( 'keysets', Name)
1066 KeysetCmds = GetAVar( 'keyset.'Name)
1067 -- For all keyset commands
1068 do k = 1 to words( KeysetCmds)
1069 ThisKeyset = word( KeysetCmds, k)
1070 -- Remove keyset name from array var for this keyset cmd
1071 DelAVar( 'keysetcmd.'ThisKeyset, Name)
1072 enddo
1073 DropAVar( 'keyset.'Name)
1074
1075; ---------------------------------------------------------------------------
1076; executekey can only execute single keys. For strings containing multiple
1077; keys, keyin can be used.
1078defc DoKey
1079 --sayerror 'dokey: k = 'arg(1)
1080 executekey Resolve_Key(arg(1))
1081
1082; ---------------------------------------------------------------------------
1083defc ExecuteKey
1084 executekey arg(1)
1085
1086; ---------------------------------------------------------------------------
1087defc Keyin
1088 if arg(1) = '' then
1089 keyin ' '
1090 else
1091 keyin arg(1)
1092 endif
1093
1094; ---------------------------------------------------------------------------
1095; In E3 and EOS2, we can use a_X to enter the value of any key. In EPM,
1096; we can't, so the following routine is used by KEY and LOOPKEY to convert
1097; from an ASCII key name to the internal value. It handles shift or alt +
1098; any letter, or a function key (optionally, with any shift prefix). LAM
1099
1100; suffix for virtual keys
1101; hex dec
1102; 02 2 without prefix
1103; 0a 10 Sh
1104; 12 18 Ctrl
1105; 22 34 Alt
1106;
1107; suffix for letters
1108; hex dec
1109; 10 16 Ctrl
1110; 20 32 Alt
1111;
1112defproc Resolve_Key( k)
1113 kl = lowcase( k)
1114 suffix = \2 -- For unshifted function keys
1115 if length( k) >= 3 & pos( substr( k, 2, 1), '_-+') then
1116 if length( k) > 3 then
1117 if substr( kl, 3, 1) = 'f' then -- Shifted function key
1118 suffix = substr( \10\34\18, pos( leftstr( kl, 1), 'sac'), 1) -- Set suffix,
1119 kl = substr( kl, 3) -- strip shift prefix, and more later...
1120 elseif wordpos( substr( kl, 3), 'left up right down') then
1121 suffix = substr( \10\34\18, pos( leftstr( kl, 1), 'sac'), 1) -- Set suffix,
1122 kl = substr( kl, 3) -- strip shift prefix, and more later...
1123 else -- Something we don't handle...
1124 sayerror 'Resolve_key:' sayerrortext(-328)
1125 rc = -328
1126 endif
1127 else -- alt+letter or ctrl+letter
1128 k = substr( kl, 3, 1) || substr(' ', pos( leftstr( kl, 1), 'ac'), 1)
1129 endif
1130 endif
1131 if leftstr( kl, 1) = 'f' & isnum( substr( kl, 2)) then
1132 k = chr( substr( kl, 2) + 31) || suffix
1133 elseif wordpos( kl, 'left up right down') then
1134 k = chr( wordpos( kl, 'left up right down') + 20) || suffix
1135 endif
1136 return k
1137
1138; ---------------------------------------------------------------------------
1139; This ignores modifier key combinations. Therefore it can be used for single
1140; chars only.
1141defproc Process_Key( char)
1142 universal cua_marking_switch
1143
1144 if length( char) = 1 & char <> \0 then
1145
1146 call Process_Keys( char)
1147
1148 endif
1149
1150; ---------------------------------------------------------------------------
1151; This types one or multiple chars. It handles replacing a marked area while
1152; CUA marking is active.
1153defproc Process_Keys( chars)
1154 universal cua_marking_switch
1155
1156 fInsert = insert_state()
1157 fMarked = 0
1158 fInsertToggled = 0
1159 if cua_marking_switch then
1160 fMarked = (process_mark_like_cua() = 1)
1161 if not fInsert & fMarked then
1162 -- Turn on insert mode because the key should replace
1163 -- the mark, not the character after the mark.
1164 insert_toggle
1165 fInsertToggled = 1
1166 endif
1167 endif
1168
1169 keyin chars
1170
1171 if fInsertToggled then
1172 insert_toggle
1173 endif
1174
1175; ---------------------------------------------------------------------------
1176; An easier to remember synonym for Process_Keys.
1177defproc TypeChars( chars)
1178 call Process_Keys( chars)
1179
1180; ---------------------------------------------------------------------------
1181; Defined as command for use in key definition files.
1182defc TypeChars
1183 call Process_Keys( arg(1))
1184
1185; ---------------------------------------------------------------------------
1186; This takes ascii values of one or multiple chars. Multiple chars can be
1187; separated by '\'. An leading '\' is optional.
1188; Example: TypeAscChars \0\170 gives a null char followed by a not char.
1189defc TypeAscChars
1190 Rest = strip( arg(1))
1191 Chars = ''
1192 do while Rest <> ''
1193 if leftstr( Rest, 1) <> '\' then
1194 Rest = '\'Rest
1195 endif
1196 parse value Rest with '\'Num'\'Rest
1197 Num = strip( Num)
1198 Rest = strip( Rest)
1199
1200 if IsNum( Num) and Num < 256 then
1201 Chars = Chars''chr( Num)
1202 else
1203 -- Maybe give an error msg here or ignore this one
1204 Chars = Chars''Num
1205 endif
1206 enddo
1207 call Process_Keys( Chars)
1208
1209; ---------------------------------------------------------------------------
1210; Ensure that default entry is present in NEPMD.INI
1211definit
1212 universal nepmd_hini
1213 DefaultNameList = lowcase( 'cuakeys') -- only basenames
1214
1215 KeyPath = '\NEPMD\User\Keys\AddKeyDefs\List'
1216 KeyDefs = NepmdQueryConfigValue( nepmd_hini, KeyPath)
1217
1218 NewKeyDefs = ''
1219 do w = 1 to words( DefaultNameList)
1220 ThisName = word( DefaultNameList, w)
1221 if not wordpos( ThisName, Keydefs) then
1222 NewKeyDefs = NewKeyDefs ThisName
1223 endif
1224 enddo
1225 NewKeyDefs = strip( NewKeyDefs)
1226
1227 if NewKeyDefs <> '' then
1228 NepmdWriteConfigValue( nepmd_hini, KeyPath, KeyDefs NewKeyDefs)
1229 endif
1230
1231; ---------------------------------------------------------------------------
1232defc LinkKeyDefs
1233 universal nepmd_hini
1234 None = '-none-'
1235 fLinked = 0
1236
1237 KeyPath = '\NEPMD\User\Keys\AddKeyDefs\Selected'
1238 Current = NepmdQueryConfigValue( nepmd_hini, KeyPath)
1239 --dprintf( 'LinkKeyDefs: previous = 'GetAVar( 'keyset.'activeaccel)', current = 'Current)
1240 if Current <> None & Current <> '' then
1241 'Link quiet 'Current
1242 do i = 1 to 1
1243 -- On success
1244 if rc >= 0 then
1245 fLinked = 1
1246 else
1247 -- Search .E file and maybe recompile it
1248 'Relink' Current'.e'
1249 if rc >= 0 then
1250 fLinked = 1
1251 else
1252 -- Remove from NEPMD.INI on link error
1253 rcx = NepmdWriteConfigValue( nepmd_hini, KeyPath, None)
1254 sayerror 'Additional key defs file "'Current'.ex" could not be found.'
1255 endif
1256 endif
1257 if fLinked then
1258 -- Extend std keyset
1259 parse value lowcase( Current) with Name'keys' -- strip 'keys'
1260 'SetKeyset std stdvalue' Name
1261 endif
1262 enddo
1263 endif
1264
1265definit
1266 'AtInit LinkKeyDefs'
1267
1268; ---------------------------------------------------------------------------
1269defproc GetKeyDef
1270 universal nepmd_hini
1271 None = '-none-'
1272 KeyPath = '\NEPMD\User\Keys\AddKeyDefs\Selected'
1273 Current = NepmdQueryConfigValue( nepmd_hini, KeyPath)
1274 if Current = '' then
1275 Current = None
1276 endif
1277 return Current
1278
1279; ---------------------------------------------------------------------------
1280; Open a listbox to select aditional key defs. The additional defs must be
1281; placed in a separate E file, without using the defkeys statement. When
1282; simply linking such a file, all special keysets for already loaded files
1283; would be lost and the keyset EDIT_KEYS is set for all loaded files.
1284; Therefore EPM will be restarted to make the changes take effect as
1285; expected. For unlinking a key def file, no restart is required.
1286defc SelectKeyDefs
1287 universal nepmd_hini
1288 None = '-none-'
1289
1290 parse arg Action Basename
1291 Action = upcase( Action)
1292 lp = lastpos( '\', strip( Basename))
1293 Basename = substr( Basename, lp + 1)
1294 Basename = lowcase( Basename)
1295 if Basename = '' then
1296 elseif rightstr( Basename, 2) = '.e' then
1297 Basename = leftstr( Basename, length( Basename) - 2)
1298 elseif rightstr( Basename, 3) = '.ex' then
1299 Basename = leftstr( Basename, length( Basename) - 3)
1300 endif
1301
1302 -- Read available files from NEPMD.INI
1303 KeyPath1 = '\NEPMD\User\Keys\AddKeyDefs\List'
1304 KeyPath2 = '\NEPMD\User\Keys\AddKeyDefs\Selected'
1305 KeyDefs = NepmdQueryConfigValue( nepmd_hini, KeyPath1) -- space-separated list
1306 Current = NepmdQueryConfigValue( nepmd_hini, KeyPath2)
1307 if Current = '' then
1308 Current = None
1309 endif
1310
1311 if Action = 'ADD' & Basename <> '' then
1312
1313 if not wordpos( Basename, KeyDefs) then
1314 KeyDefs = strip( KeyDefs Basename)
1315 rcx = NepmdWriteConfigValue( nepmd_hini, KeyPath1, KeyDefs)
1316 endif
1317
1318 Path = Get_Env('EPMEXPATH')
1319 ListFiles = ''
1320 BaseNames = ReadMacroLstFiles( Path, ListFiles)
1321
1322 if not pos( ';'Basename';', ';'BaseNames) then
1323 Title = 'Adding additional key definitions'
1324 Text = 'For the additional key definition macro "'Basename'" no'
1325 Text = Text || ' entry in a LST file was found. In order to make'
1326 Text = Text || ' the RecompileNew macro aware of that file, it'
1327 Text = Text || ' should be added to "myexfiles.lst".'\n\n
1328 Text = Text || 'Should the entry be added automatically?'
1329 Style = MB_YESNO+MB_QUERY+MB_DEFBUTTON1+MB_MOVEABLE
1330 ret = winmessagebox( Title,
1331 Text,
1332 Style)
1333 if ret = 6 then -- Yes
1334 call AddToMacroLstFile( Basename)
1335 if rc <> 0 then
1336 sayerror 'Error: AddToMacroLstFile( 'Basename') returned rc = 'rc
1337 return
1338 endif
1339 elseif ret = 7 then -- No
1340 endif
1341 endif
1342
1343 Title = 'Adding additional key definitions'
1344 Text = 'Before the macro file "'Basename'" can be loaded,'
1345 Text = Text || ' it has to be compiled.'\n\n
1346 Text = Text || 'Should RecompileNew be called now?'
1347 Style = MB_YESNO+MB_QUERY+MB_DEFBUTTON1+MB_MOVEABLE
1348 Style = MB_YESNO+MB_WARNING+MB_DEFBUTTON1+MB_MOVEABLE
1349 ret = winmessagebox( Title,
1350 Text,
1351 Style)
1352 if ret = 6 then -- Yes
1353 -- Execute RecompileNew and open this dialog again
1354 'RecompileNew'
1355 'postme SelectKeyDefs'
1356 return
1357 elseif ret = 7 then -- No
1358 endif
1359 endif
1360
1361 -- Open listbox
1362 Rest = KeyDefs
1363 Sep = '/'
1364 Entries = Sep''None
1365 do w = 1 to words( Rest)
1366 Next = word( Rest, w)
1367 Entries = Entries''Sep''Next
1368 enddo
1369
1370 DefaultItem = 1
1371 if Current <> '' then
1372 wp = wordpos( Current, KeyDefs)
1373 if wp > 0 then
1374 DefaultItem = wp + 1
1375 endif
1376 endif
1377 DefaultButton = 1
1378 HelpId = 0
1379 Title = 'Select additional key definitions'copies( ' ', 20)
1380 --Text = 'These defs override or extend the standard keyset.'
1381 --Text = 'Current key def additions for the standard keyset: 'Current
1382 Text = 'Current key def additions: 'Current
1383
1384 refresh
1385 Result = listbox( Title,
1386 Entries,
1387 '/~Set/~Add.../~Edit/~Remove/Cancel', -- buttons
1388 0, 0, --5, 5, -- top, left,
1389 min( words( KeyDefs), 15), 50, -- height, width
1390 gethwnd(APP_HANDLE) || atoi(DefaultItem) ||
1391 atoi(DefaultButton) || atoi(HelpId) ||
1392 Text\0 )
1393 refresh
1394
1395 -- Check result
1396 button = asc( leftstr( Result, 1))
1397 EOS = pos( \0, Result, 2) -- CHR(0) signifies End Of String
1398 Selected = substr( Result, 2, EOS - 2)
1399 if button = 1 then -- Set
1400 -- Unlink current
1401 if Current <> None then
1402 if linked( Current) > 0 then
1403 'unlink 'Current
1404 endif
1405 endif
1406 if Selected = None then
1407 Msg = 'No keyset additions file active.'
1408 'SetKeyset std std'
1409 'postme RefreshMenu'
1410 rcx = NepmdWriteConfigValue( nepmd_hini, KeyPath2, None)
1411 sayerror Msg
1412 else
1413 -- Check if .E file exists
1414 findfile EFile, Selected'.e', 'EPMPATH'
1415 if rc then
1416 -- Check if .EX file exists
1417 findfile EFile, Selected'.ex', 'EPMPATH'
1418 if rc then
1419 sayerror 'Key definition file 'upcase( Selected)'.E or 'upcase( Selected)'.EX not found.'
1420 return 2
1421 endif
1422 endif
1423 -- Write selected value to NEPMD.INI
1424 rcx = NepmdWriteConfigValue( nepmd_hini, KeyPath2, Selected)
1425 Msg = 'Keyset additions file 'upcase( Selected)'.EX activated.'
1426 'LinkKeyDefs'
1427 'postme RefreshMenu'
1428 sayerror Msg
1429 endif
1430 elseif button = 2 then -- Add
1431 -- Open fileselector to select an e or ex filename
1432 -- Call this Cmd again, but with args to repaint the list
1433 'FileDlg Select a file with additional key definitions, SelectKeyDefs ADD, 'Get_Env('NEPMD_USERDIR')'\macros\*.e'
1434 return 0
1435 elseif button = 3 & Selected <> None then -- Edit
1436 -- Load file
1437 'ep 'Selected'.e'
1438 return rc
1439 elseif button = 4 & Selected <> None then -- Remove
1440 if linked( Selected) > 0 then
1441 'unlink 'Selected
1442 endif
1443 'SetKeyset std std'
1444 'postme RefreshMenu'
1445 rcx = NepmdWriteConfigValue( nepmd_hini, KeyPath2, None)
1446 wp = wordpos( Selected, KeyDefs)
1447 if wp > 0 then
1448 NewKeyDefs = DelWord( KeyDefs, wp, 1)
1449 rcx = NepmdWriteConfigValue( nepmd_hini, KeyPath1, NewKeyDefs)
1450 endif
1451 -- Call this Cmd again
1452 'SelectKeyDefs'
1453 else -- Cancel
1454 endif
1455
1456
1457; ---------------------------------------------------------------------------
1458; Definitions used for key commands
1459; ---------------------------------------------------------------------------
1460
1461; ---------------------------------------------------------------------------
1462; This command allows to define 2 commands, separated by a bar char. The
1463; first command applies in stream mode and the second in line mode.
1464defc StreamLine
1465 universal stream_mode
1466 parse arg cmd1'|'cmd2
1467 cmd1 = strip( cmd1)
1468 cmd2 = strip( cmd2)
1469 if stream_mode then
1470 cmd1
1471 else
1472 cmd2
1473 endif
1474
1475; ---------------------------------------------------------------------------
1476defproc process_mark_like_cua()
1477 if marktype() then
1478 getmark firstline, lastline, firstcol, lastcol, markfileid
1479 getfileid fileid
1480 if fileid <> markfileid then
1481 sayerror MARKED_OTHER__MSG
1482 unmark
1483 elseif not check_mark_on_screen() then
1484 sayerror MARKED_OFFSCREEN__MSG
1485 unmark
1486 else
1487 'Copy2DMBuff' -- see clipbrd.e for details
1488 firstline
1489 .col = firstcol
1490 call NextCmdAltersText()
1491 call pdelete_mark()
1492 'ClearSharBuff' -- remove Content in EPM shared text buffer
1493 return 1
1494 endif
1495 endif
1496
1497; ---------------------------------------------------------------------------
1498defproc shifted
1499 universal curkey
1500
1501 -- Works for WM_CHAR messages:
1502 ks = getkeystate(VK_SHIFT)
1503 fshifted1 = (ks <> 3 & ks <> 4)
1504
1505 -- Works for accelerator keys:
1506 parse value (curkey) with CurKeyName \1 .
1507 fshifted2 = (pos( 's_', CurKeyName) > 0)
1508
1509 return (fshifted1 | fshifted2)
1510
1511; ---------------------------------------------------------------------------
1512defproc updownkey( down_flag)
1513 universal save_cursor_column
1514 universal cursoreverywhere
1515 universal prevkey
1516 parse value (prevkey) with PrevKeyName \1 .
1517 fupdown = (wordpos( PrevKeyName, 'up down s_up s_down') > 0)
1518 if not cursoreverywhere then
1519 if not fupdown then
1520 save_cursor_column = .col
1521 endif
1522 endif
1523
1524 if down_flag then
1525 down
1526 else
1527 up
1528 endif
1529
1530 if .line & not cursoreverywhere then
1531 l = length( textline(.line))
1532 if fupdown & l >= save_cursor_column then
1533 .col = save_cursor_column
1534 elseif fupdown | l < .col then
1535 end_line
1536 endif
1537 endif
1538
1539; ---------------------------------------------------------------------------
1540define CHARG_MARK = 'CHARG'
1541
1542defproc extend_mark( startline, startcol, forward)
1543 universal cua_marking_switch
1544 universal nepmd_hini
1545 universal cursoreverywhere
1546 universal curkey
1547
1548 KeyPath = '\NEPMD\User\Mark\ShiftMarkExtends'
1549 fAlwaysExtend = (NepmdQueryConfigValue( nepmd_hini, KeyPath) = 1)
1550 getfileid curfileid
1551 getmarkg firstline, lastline, firstcol, lastcol, markfileid
1552 parse value (curkey) with CurKeyName \1 .
1553 fs_up = (CurKeyName = 's_up')
1554 fs_down = (CurKeyName = 's_down')
1555
1556 funmark = 1
1557 if markfileid <> curfileid then
1558 funmark = 1
1559 elseif cua_marking_switch then
1560 -- keep mark and extend it (any unshifted key caused unmark before)
1561 funmark = 0
1562 elseif fAlwaysExtend then
1563 -- keep mark and extend it
1564 funmark = 0
1565
1566 -- The following was added for the feature "Shift-Mark extends at mark
1567 -- boundaries only" (== "Shift-mark extends always" = deactivated):
1568 elseif not cursoreverywhere then
1569 if startline = firstline & startcol = firstcol then
1570 funmark = 0
1571 elseif startline = lastline & startcol = lastcol then
1572 funmark = 0
1573 endif
1574 elseif cursoreverywhere then
1575 l = length( textline( startline))
1576 if startline = firstline & startcol = firstcol then
1577 funmark = 0
1578 elseif startline = firstline & startcol > firstcol & startcol > l + 1 then
1579 funmark = 0
1580 elseif startline = firstline + 1 & firstcol = 0 then
1581 -- apparently never reached
1582 funmark = 0
1583 elseif startline = lastline & startcol = lastcol then
1584 funmark = 0
1585 elseif startline = lastline & startcol > lastcol & startcol > l + 1 then
1586 funmark = 0
1587 elseif startline = lastline - 1 & lastcol = 0 then
1588 funmark = 0
1589 endif
1590 endif
1591
1592 if funmark then
1593 unmark
1594 endif
1595
1596 if not marktype() then
1597 call pset_mark( startline, .line, startcol, .col, CHARG_MARK, curfileid)
1598 return
1599 endif
1600
1601 if (fs_up & .line = firstline - 1) | (fs_down & .line = firstline + 1) then
1602 if length(textline(firstline)) < .col then
1603 firstcol = .col
1604 endif
1605 endif
1606
1607 if startline > firstline | ((startline = firstline) & (startcol > firstcol)) then -- at end of mark
1608 if not forward then
1609 if firstline = .line & firstcol = .col then
1610 unmark
1611 return
1612 endif
1613 endif
1614 call pset_mark( firstline, .line, firstcol, .col, CHARG_MARK, curfileid)
1615 else -- at beginning of mark
1616 if forward then
1617 if lastline = .line & lastcol = .col - 1 then
1618 unmark
1619 return
1620 endif
1621 endif
1622 call pset_mark( lastline, .line, lastcol, .col, CHARG_MARK, curfileid)
1623 endif
1624
1625; ---------------------------------------------------------------------------
1626; c_home, c_end, c_left & c_right do different things if the shift key is depressed.
1627; The logic is extracted here mainly due to the complexity of the COMPILE IF's
1628defproc begin_shift( var startline, var startcol, var shift_flag)
1629; unused
1630/*
1631 universal cua_marking_switch
1632 universal curkey
1633 shift_flag = shifted()
1634 if shift_flag or not cua_marking_switch then
1635 startline = .line; startcol = .col
1636 else
1637 unmark
1638 endif
1639*/
1640
1641; ---------------------------------------------------------------------------
1642defproc end_shift( startline, startcol, shift_flag, forward_flag)
1643; unused
1644/*
1645; Make this work regardless of which marking mode is active:
1646compile if 0 -- WANT_CUA_MARKING = 'SWITCH'
1647 universal cua_marking_switch
1648 if shift_flag & cua_marking_switch then
1649compile else
1650 if shift_flag then
1651compile endif
1652 call extend_mark( startline, startcol, forward_flag)
1653 endif
1654*/
1655
1656; ---------------------------------------------------------------------------
1657defproc UnmarkIfCua
1658 universal cua_marking_switch
1659 if cua_marking_switch then
1660 unmark
1661 endif
1662 return
1663
1664; ---------------------------------------------------------------------------
1665; Example: def space 'ExpandFirst Space'
1666defc ExpandFirst
1667 call ExpandFirstSecond( 0, arg(1))
1668
1669; ---------------------------------------------------------------------------
1670; Example: def c_newline 'ExpandSecond StdEnter'
1671defc ExpandSecond
1672 call ExpandFirstSecond( 1, arg(1))
1673
1674; ---------------------------------------------------------------------------
1675; Process syntax expansion, if defined and if success, otherwise execute
1676; StdDef.
1677defproc ExpandFirstSecond( fSecond, StdDef)
1678 universal expand_on
1679 fExpanded = 0
1680 getfileid fid
1681 ExpandMode = GetAVar( 'expand.'fid)
1682 if expand_on & ExpandMode <> '' & wordpos( upcase( ExpandMode), '0 OFF') = 0 then
1683 if fSecond then
1684 ExpandCmd = ExpandMode'SecondExpansion'
1685 else
1686 ExpandCmd = ExpandMode'FirstExpansion'
1687 endif
1688 if isadefc( ExpandCmd) then
1689 ExpandCmd
1690 fExpanded = (rc = 0)
1691 endif
1692 endif
1693 if not fExpanded then
1694 StdDef
1695 endif
1696 return
1697
1698; ---------------------------------------------------------------------------
1699defc ForceExpansion
1700 universal expand_on
1701 getfileid fid
1702 ExpandMode = GetAVar( 'expand.'fid)
1703 if expand_on & ExpandMode <> '' & wordpos( upcase( ExpandMode), '0 OFF') = 0 then
1704 rc = -1
1705 if isadefc( ExpandMode'FirstExpansion') then
1706 ExpandMode'FirstExpansion'
1707 endif
1708 if rc <> 0 then
1709 if isadefc( ExpandMode'SecondExpansion') then
1710 ExpandMode'SecondExpansion'
1711 endif
1712 endif
1713 endif
1714
1715; ---------------------------------------------------------------------------
1716defc Space
1717 call NextCmdAltersText()
1718 call Process_Key( ' ')
1719
1720; ---------------------------------------------------------------------------
1721defproc MatchCharsEnabled
1722 universal nepmd_hini
1723 KeyPath = '\NEPMD\User\MatchChars'
1724 on = NepmdQueryConfigValue( nepmd_hini, KeyPath)
1725 return (on = 1)
1726
1727; ---------------------------------------------------------------------------
1728;def '{'
1729defc OpeningBrace
1730 universal match_chars
1731 call Process_Key( '{')
1732 if MatchCharsEnabled() then
1733 wp = wordpos( '{', match_chars)
1734 if wp then
1735 match = word( match_chars, wp + 1)
1736 keyin match
1737 do l = 1 to length( match)
1738 left
1739 enddo
1740 endif
1741 endif
1742
1743;def '('
1744defc OpeningParen
1745 universal match_chars
1746 call Process_Key( '(')
1747 if MatchCharsEnabled() then
1748 wp = wordpos( '(', match_chars)
1749 if wp then
1750 match = word( match_chars, wp + 1)
1751 keyin match
1752 do l = 1 to length( match)
1753 left
1754 enddo
1755 endif
1756 endif
1757
1758;def '['
1759defc OpeningBracket
1760 universal match_chars
1761 call Process_Key( '[')
1762 if MatchCharsEnabled() then
1763 wp = wordpos( '[', match_chars)
1764 if wp then
1765 match = word( match_chars, wp + 1)
1766 keyin match
1767 do l = 1 to length( match)
1768 left
1769 enddo
1770 endif
1771 endif
1772
1773;def '<'
1774defc OpeningAngle
1775 universal match_chars
1776 call Process_Key( '<')
1777 if MatchCharsEnabled() then
1778 wp = wordpos( '<', match_chars)
1779 if wp then
1780 match = word( match_chars, wp + 1)
1781 keyin match
1782 do l = 1 to length( match)
1783 left
1784 enddo
1785 endif
1786 endif
1787
1788; ---------------------------------------------------------------------------
1789;def '}'
1790defc ClosingBrace
1791 universal closing_brace_auto_indent
1792 if closing_brace_auto_indent then
1793 -- check if line is blank, before typing }
1794 LineIsBlank = (verify( textline(.line), ' '\t) = 0)
1795 if LineIsBlank then
1796 l = 0
1797 PrevIndent = 0
1798 do l = 1 to 100 -- upper limit
1799 getline line0, .line - l -- line0 = line before }
1800 p0 = max( 1, verify( line0, ' '\t)) -- p0 = pos of first non-blank in line 0
1801 if length(line0) > p0 - 1 then -- if not a blank line
1802 PrevIndent = p0 - 1
1803 -- check if last non-empty line is a {
1804 if rightstr( strip( line0), 1) = '{' then
1805 NewIndent = PrevIndent
1806 else
1807 NewIndent = PrevIndent - GetCIndent()
1808 endif
1809 leave
1810 endif
1811 enddo
1812 .col = max( 1, NewIndent + 1) -- unindent
1813 endif
1814 endif
1815 -- type } and highlight matching {
1816 'balance }'
1817
1818; ---------------------------------------------------------------------------
1819
1820defc AdjustMark
1821 call NextCmdAltersText()
1822 call pcommon_adjust_overlay('A')
1823
1824defc OverlayMark
1825 call NextCmdAltersText()
1826 if marktype() then
1827 call pcommon_adjust_overlay('O')
1828 else -- if no mark, look to in Shared Text buffer
1829 'GetSharBuff O' -- see clipbrd.e for details
1830 endif
1831
1832defc CopyMark
1833 call NextCmdAltersText()
1834 if marktype() then
1835 call pcopy_mark()
1836 else -- if no mark, look to in Shared Text buffer
1837 'GetSharBuff' -- see clipbrd.e for details
1838 endif
1839
1840defc MoveMark
1841 universal nepmd_hini
1842 call NextCmdAltersText()
1843 call pmove_mark()
1844 KeyPath = '\NEPMD\User\Mark\UnmarkAfterMove'
1845 UnmarkAfterMove = NepmdQueryConfigValue( nepmd_hini, KeyPath)
1846 if UnmarkAfterMove = 1 then
1847 unmark
1848 'ClearSharBuff' -- remove Content in EPM shared text buffer */
1849 endif
1850
1851defc DeleteMark
1852 call NextCmdAltersText()
1853 'Copy2DMBuff' -- see clipbrd.e for details
1854 call pdelete_mark()
1855 'ClearSharBuff' -- remove Content in EPM shared text buffer
1856
1857defc unmark
1858 unmark
1859 'ClearSharBuff' -- remove Content in EPM shared text buffer
1860
1861defc BeginMark
1862 call pbegin_mark()
1863
1864defc EndMark
1865 call pend_mark()
1866 if substr( marktype(), 1, 1) <> 'L' then
1867 right
1868 endif
1869
1870defc FillMark -- accepts key from macro
1871 key = arg(1)
1872 call NextCmdAltersText()
1873 call checkmark()
1874 call pfill_mark( key)
1875
1876defc TypeFrameChars
1877 call NextCmdAltersText()
1878 call Process_Keys( 'º Ì É È Ê Í Ë Œ » ¹ Î ³ Ã Ú À Á Ä Â Ù ¿ Ž Å Û ² ± °')
1879
1880defc ShiftLeft -- Can't use the old A_F7 in EPM. PM uses it as an accelerator key.
1881 mt = marktype()
1882 if not mt then
1883 return
1884 endif
1885 getmark firstline, lastline, firstcol, lastcol, fid
1886 getfileid curfid
1887 if curfid <> fid then
1888 unmark
1889 sayerror MARKED_OTHER__MSG
1890 return
1891 endif
1892 call NextCmdAltersText()
1893 if mt = 'CHAR' then
1894 -- Change to line mark
1895 if lastCol = 0 then
1896 lastLine = lastLine - 1
1897 endif
1898 firstcol = 1
1899 lastcol = MAXCOL
1900 unmark
1901 call pset_mark( firstline, lastline, firstcol, lastcol, 'LINE', fid)
1902 endif
1903 shift_left
1904compile if SHIFT_BLOCK_ONLY
1905 if marktype() = 'BLOCK' then -- code by Bob Langer
1906 getmark fl, ll, fc, lc, fid
1907 call pset_mark( fl, ll, lc, MAXCOL, 'BLOCK', fid)
1908 shift_right
1909 call pset_mark( fl, ll, fc, lc, 'BLOCK', fid)
1910 endif
1911compile endif
1912
1913defc ShiftRight -- Can't use the old A_F8 in EPM. PM uses it as an accelerator key.
1914 mt = marktype()
1915 if not mt then
1916 return
1917 endif
1918 getmark firstline, lastline, firstcol, lastcol, fid
1919 getfileid curfid
1920 if curfid <> fid then
1921 unmark
1922 sayerror MARKED_OTHER__MSG
1923 return
1924 endif
1925 call NextCmdAltersText()
1926 if mt = 'CHAR' then
1927 -- Change to line mark
1928 if lastCol = 0 then
1929 lastLine = lastLine - 1
1930 endif
1931 firstcol = 1
1932 lastcol = MAXCOL
1933 unmark
1934 call pset_mark( firstline, lastline, firstcol, lastcol, 'LINE', fid)
1935 endif
1936compile if SHIFT_BLOCK_ONLY
1937 if marktype() = 'BLOCK' then -- code by Bob Langer
1938 getmark fl, ll, fc, lc, fid
1939 call pset_mark( fl, ll, lc, MAXCOL, 'BLOCK', fid)
1940 shift_left
1941 call pset_mark( fl, ll, fc, lc, 'BLOCK', fid)
1942 endif
1943compile endif
1944 shift_right
1945
1946/* We can't use a_f10 for previous file any more, PM uses that key. */
1947/* I like F11 and F12 to go back and forth. */
1948defc prevfile -- a_F10 is usual E default; F11 for enh. kbd, c_P for EPM.
1949 prevfile
1950
1951defc JoinLines
1952 call NextCmdAltersText()
1953 call joinlines()
1954
1955defc MarkBlock
1956 getmark firstline, lastline, firstcol, lastcol, markfileid
1957 getfileid fileid
1958 if fileid <> markfileid then
1959 unmark
1960 endif
1961 if wordpos( marktype(), 'LINE CHAR') then
1962 --call pset_mark( firstline, lastline, firstcol, lastcol, BLOCKGMARK, fileid)
1963 unmark
1964 endif
1965 markblock
1966 'Copy2SharBuff' -- copy mark to shared text buffer
1967
1968defc MarkLine
1969 getmark firstline, lastline, firstcol, lastcol, markfileid
1970 getfileid fileid
1971 if fileid <> markfileid then
1972 unmark
1973 endif
1974 if wordpos( marktype(), 'BLOCK CHAR') then
1975 --call pset_mark( firstline, lastline, firstcol, lastcol, LINEMARK, fileid)
1976 unmark
1977 endif
1978 mark_line
1979 'Copy2SharBuff' -- copy mark to shared text buffer
1980
1981defc MarkChar
1982 getmark firstline, lastline, firstcol, lastcol, markfileid
1983 getfileid fileid
1984 if fileid <> markfileid then
1985 unmark
1986 endif
1987 if wordpos( marktype(), 'BLOCK LINE') then
1988 --call pset_mark( firstline, lastline, firstcol, lastcol, CHARGMARK, fileid)
1989 unmark
1990 endif
1991 mark_char
1992 'Copy2SharBuff' -- Copy mark to shared text buffer
1993
1994defc HighlightCursor
1995 circleit 5, .line, .col - 1, .col + 1, 16777220
1996
1997defc TypeFileName -- Type the full name of the current file
1998 call NextCmdAltersText()
1999 call Process_Keys( .filename)
2000
2001defc TypeDateTime -- Type the current date and time
2002 call NextCmdAltersText()
2003 call Process_Keys( DateTime())
2004
2005defc select_all, SelectAll
2006 getfileid fid
2007 call pset_mark( 1, .last, 1, length( textline( .last)), 'CHAR' , fid)
2008 'Copy2SharBuff' -- Copy mark to shared text buffer
2009
2010defc ReflowAll2ReflowMargins
2011 universal reflowmargins
2012 'ReflowAll' reflowmargins
2013
2014; Syntax: reflow_all [<margins>]
2015defc reflow_all, ReflowAll
2016 call NextCmdAltersText()
2017 saved_margins = .margins
2018 if arg(1) <> '' then
2019 .margins = arg(1)
2020 endif
2021 call psave_mark( savemark)
2022 call psave_pos( savepos)
2023 display -1
2024 fstopit = 0
2025 top
2026 do forever
2027 getline line
2028 do while line = '' | -- Skip over blank lines or
2029 (lastpos( ':', line) = 1 & pos( '.', line) = length( line)) | -- lines containing only a GML tag or
2030 substr( line, 1, 1) = '.' -- SCRIPT commands
2031 if .line = .last then
2032 fstopit = 1
2033 leave
2034 endif
2035 down
2036 getline line
2037 enddo
2038 if fstopit then
2039 leave
2040 endif
2041 startline = .line
2042 unmark
2043 mark_line
2044 call pfind_blank_line()
2045 if .line <> startline then
2046 up
2047 else
2048 bottom
2049 endif
2050 mark_line
2051 reflow
2052 getmark firstline, lastline
2053 if lastline = .last then
2054 leave
2055 endif
2056 lastline + 1
2057 enddo
2058 display 1
2059 call prestore_mark( savemark)
2060 call prestore_pos( savepos)
2061 if arg(1) <> '' then
2062 .margins = saved_margins
2063 endif
2064
2065; Changed: split ReflowPar into ReflowMark and ReflowPar.
2066
2067defc ReflowMark2ReflowMargins
2068 universal reflowmargins
2069 'ReflowMark' reflowmargins
2070
2071; Syntax: ReflowMark [<margins>]
2072defc ReflowMark
2073
2074 mt = strip( substr( marktype(), 1, 1))
2075 if mt = '' then
2076 sayerror NO_MARK__MSG
2077 stop
2078 endif
2079
2080 getmark firstline, lastline, firstcol, lastcol, fid
2081 getfileid curfid
2082 if curfid <> fid then
2083 unmark
2084 sayerror MARKED_OTHER__MSG
2085 stop
2086 endif
2087
2088 if not check_mark_on_screen() then
2089 sayerror MARK_OFF_SCREEN__MSG
2090 stop
2091 endif
2092
2093 saved_margins = .margins
2094 if arg(1) <> '' then
2095 .margins = arg(1)
2096 endif
2097 call NextCmdAltersText()
2098 display -1
2099
2100 if mt = 'C' then
2101 -- Change to line mark
2102 if lastCol = 0 then
2103 lastLine = lastLine - 1
2104 endif
2105 firstcol = 1
2106 lastcol = MAXCOL
2107 unmark
2108 call pset_mark( firstline, lastline, firstcol, lastcol, 'LINE', fid)
2109 mt = 'L'
2110 endif
2111
2112 if mt = 'B' then
2113 'box r'
2114 elseif mt = 'L' then
2115 reflow
2116 endif
2117
2118 display 1
2119 if arg(1) <> '' then
2120 .margins = saved_margins
2121 endif
2122
2123defc ReflowPar2ReflowMargins
2124 universal reflowmargins
2125 'ReflowPar' reflowmargins
2126
2127; Syntax: ReflowPar [<margins>]
2128; Ignores mark. To reflow a marked area, use ReflowMark.
2129defc ReflowPar
2130 saved_margins = .margins
2131 if arg(1) <> '' then
2132 .margins = arg(1)
2133 endif
2134 call NextCmdAltersText()
2135 display -1
2136
2137 call text_reflow()
2138
2139 display 1
2140 if arg(1) <> '' then
2141 .margins = saved_margins
2142 endif
2143
2144; Standard text reflow, moved from Alt+P definition in STDKEYS.E.
2145; Only called from Alt+P if no mark exists; users wishing to call
2146; this from their own code must save & restore the mark themselves
2147; if that's desired.
2148defproc text_reflow
2149 universal nepmd_hini
2150 call NextCmdAltersText()
2151 KeyPath = '\NEPMD\User\Reflow\Next'
2152 ReflowNext = NepmdQueryConfigValue( nepmd_hini, KeyPath)
2153 if .line then
2154 getline line
2155 if line <> '' then -- If currently on a blank line, don't reflow.
2156 oldcursory = .cursory
2157 oldcursorx = .cursorx
2158 oldline = .line
2159 oldcol = .col
2160 unmark
2161 mark_line
2162 call pfind_blank_line()
2163 -- Ver 3.11: slightly revised test works better with GML sensitivity.
2164 if .line <> oldline then
2165 up
2166 else
2167 bottom
2168 endif
2169 mark_line
2170 reflow
2171 if ReflowNext then -- position on next paragraph (like PE)
2172 call pfind_blank_line()
2173 for i = .line + 1 to .last
2174 getline line, i
2175 if line <> '' then
2176 .lineg = i
2177 .col = 1
2178 .cursory = oldcursory
2179 .line = i
2180 leave
2181 endif
2182 endfor
2183 else
2184 -- or like old E
2185 getmark firstline, lastline
2186 firstline
2187 .cursory = oldcursory
2188 .cursorx = oldcursorx
2189 oldline
2190 .col = oldcol
2191 endif
2192 unmark
2193 endif
2194 endif
2195
2196definit -- Variable is null if alt_R is not active.
2197 universal alt_R_active -- For E3/EOS2, it's 1 if alt_R is active.
2198 alt_R_active = '' -- For EPM, it's set to querycontrol(messageline).
2199
2200defc ReflowBlock
2201 universal alt_R_active,tempofid
2202 universal alt_R_space
2203
2204 call NextCmdAltersText()
2205 if alt_R_active <> '' then
2206 call pblock_reflow( 1, alt_R_space, tempofid) -- Complete the reflow.
2207 'setmessageline '\0
2208 'toggleframe 2 'alt_R_active -- Restore status of messageline.
2209 alt_R_active = ''
2210 return
2211 endif
2212 if pblock_reflow( 0, alt_R_space, tempofid) then
2213 sayerror PBLOCK_ERROR__MSG /* HurleyJ */
2214 return
2215 endif
2216; if marktype() <> 'BLOCK' then
2217 unmark
2218; endif
2219 alt_R_active = queryframecontrol(2) -- Remember if messageline on or off
2220 'toggleframe 2 1' -- Force it on
2221 'setmessageline' BLOCK_REFLOW__MSG
2222
2223defc Split
2224 call NextCmdAltersText()
2225 split
2226
2227defc SplitLines
2228 call NextCmdAltersText()
2229 call splitlines()
2230
2231defc CenterMark
2232 call NextCmdAltersText()
2233 call pcenter_mark()
2234
2235defc BackSpace
2236 universal stream_mode
2237 universal cua_marking_switch
2238 universal curkey
2239 universal prevkey
2240 if cua_marking_switch then
2241 if process_mark_like_cua() then -- deletes mark
2242 return
2243 endif
2244 endif
2245 call NextCmdAltersText()
2246 if .col = 1 & .line > 1 & stream_mode then
2247 up
2248 l = length( textline(.line))
2249 join
2250 .col = l + 1
2251 else
2252 old_level = .levelofattributesupport
2253 if old_level & not (old_level bitand 2) then
2254 .levelofattributesupport = .levelofattributesupport + 2
2255 .cursoroffset = -300
2256 endif
2257 -- begin workaround for cursor just behind or at begin of a mark
2258 -- For char mark: Move mark left if cursor is on mark begin or end
2259 old_col = .col
2260 old_line = .line
2261 CorrectMarkBegin = 0
2262 CorrectMarkEnd = 0
2263 mt = marktype()
2264 if mt = 'CHAR' then
2265 getmark first_line, last_line, first_col, last_col, fid
2266 if ((old_col > 1) & (first_line = old_line) & (first_line = last_line) & (first_col = old_col)) then
2267 -- Cursor is on mark begin and first_line = last_line
2268 CorrectMarkBegin = 1
2269 CorrectMarkEnd = 1
2270 elseif ((old_col > 1) & (first_line = old_line) & (first_col = old_col)) then
2271 -- Cursor is on mark begin
2272 CorrectMarkBegin = 1
2273 elseif ((old_col > 0) & (last_line = old_line) & (last_col = old_col - 1)) then
2274 -- Cursor is 1 col behind mark end
2275 CorrectMarkEnd = 1
2276 endif
2277 --sayerror first_line', 'last_line', 'first_col', 'last_col', Marktype = 'mt ||
2278 -- ', CorrectMarkEnd/Begin = 'CorrectMarkEnd CorrectMarkBegin
2279 endif
2280 -- end workaround for cursor just behind or at begin of a mark
2281 rubout
2282 -- begin workaround for cursor just behind or at begin of a mark
2283 --mt = wordpos(mt,'LINE CHAR BLOCK CHARG BLOCKG')-1
2284 if CorrectMarkBegin then
2285 first_col = first_col - 1 -- move first_col left
2286 endif
2287 if CorrectMarkEnd then
2288 last_col = last_col - 1 -- move last_col left
2289 endif
2290 if CorrectMarkBegin | CorrectMarkEnd then
2291 pset_mark( first_line, last_line, first_col, last_col, mt, fid)
2292 endif
2293 -- end workaround for cursor just behind or at begin of a mark
2294 .levelofattributesupport = old_level
2295 endif
2296
2297defc DeleteLine
2298 call NextCmdAltersText()
2299 if .levelofattributesupport then
2300 if (.line == .last and .line <> 1) then -- this is the last line
2301 destinationLine = .line - 1 -- and there is a previous line to store attributes on
2302 getline prevline, DestinationLine
2303 DestinationCol = length(prevline) + 1 -- start search parameters
2304 -- destination of attributes
2305 findoffset = -300 -- start at the begin of the attr list
2306 findline = .line -- of the first char on this line
2307 findcolumn = 1
2308
2309 do forever -- search until no more attr's (since this is last line)
2310 findclass = 0 -- 0 is anyclass
2311 Attribute_action FIND_NEXT_ATTR_SUBOP, findclass, findoffset, findcolumn, findline
2312 if not findclass or (findline <> .line) then -- No attribute, or not on this line
2313 leave
2314 endif
2315 query_attribute theclass, thevalue, thepush, findoffset, findcolumn, findline -- push or pop?
2316 if not thePush then -- ..if its a pop attr and ..
2317 matchClass = theClass
2318 MatchOffset = FindOffset
2319 MatchLine = FindLine
2320 MatchColumn = FindColumn -- ..and if its match is not on this line or at the destination
2321 Attribute_Action FIND_MATCH_ATTR_SUBOP, MatchClass, MatchOffset, Matchcolumn, MatchLine
2322 if ((Matchline == DestinationLine) and (Matchcolumn == destinationcol)) then
2323 -- then there is a cancellation of attributes
2324 Attribute_action Delete_ATTR_SUBOP, theclass, Findoffset, Findcolumn, Findline
2325 Attribute_action Delete_ATTR_SUBOP, Matchclass, Matchoffset, Matchcolumn, Matchline
2326 elseif (MatchLine <> .line) then
2327 -- .. then move attribute to destination (before attributes which have been scanned so its OK.)
2328 -- insert attr at the end of the attr list (offset=0)
2329 Insert_Attribute theclass, thevalue, 0, 0, DestinationCol, DestinationLine
2330 Attribute_action Delete_ATTR_SUBOP, theclass, Findoffset, Findcolumn, Findline
2331 endif -- end if attr is on line or at destination
2332 endif -- end if found attr is a pop
2333 enddo -- end search for attr's
2334 elseif .line < .last then -- put the attributes after the line since there may not
2335 -- be a line before this line (as when .line==1)
2336 DestinationCol = 1
2337 DestinationLine = .line + 1 -- error point since this puts attr's after last line if .line=.last
2338 findoffset = 0 -- cant make it .line-1 cause then present attributes there become
2339 findline = .line -- after these attributes which is wrong
2340 findcolumn = MAXCOL
2341
2342 do forever
2343 findclass = 0
2344 Attribute_action FIND_PREV_ATTR_SUBOP, findclass, findoffset, findcolumn, findline
2345 if not findclass or (findline <> .line) then -- No attribute, or not on this line
2346 leave
2347 endif
2348 /* Move Attribute */
2349 query_attribute theclass, thevalue, thepush, findoffset, findcolumn, findline
2350 -- only move push/pop model attributes (tags are just deleted)
2351 if ((thepush == 0) or (thepush == 1)) then
2352 -- move attribute to destination, if cancellation delete both attributes
2353 FastMoveAttrToBeg( theclass, thevalue, thepush, DestinationCol, DestinationLine, findcolumn, findline, findoffset)
2354 findoffset = findoffset + 1 -- since the attr rec was deleted and all attr rec's were shifted to fill the vacancy
2355 -- and search is exclusive
2356 endif
2357 enddo
2358 endif -- endif .line=.last and .line=1
2359 endif -- .levelofattributesupport
2360 deleteline
2361
2362; Ctrl-D = word delete, thanks to Bill Brantley.
2363defc DeleteUntilNextword /* delete from cursor until beginning of next word, UNDOable */
2364 call NextCmdAltersText()
2365 getline line
2366 begcur = .col
2367 lenLine = length(line)
2368 if lenLine >= begcur then
2369 for i = begcur to lenLine /* delete remainder of word */
2370 if substr( Line, i, 1) <> ' ' then
2371 deletechar
2372 else
2373 leave
2374 endif
2375 endfor
2376 for j = i to lenLine /* delete delimiters following word */
2377 if substr( Line, j, 1) == ' ' then
2378 deletechar
2379 else
2380 leave
2381 endif
2382 endfor
2383 endif
2384
2385defc DeleteUntilEndLine
2386 call NextCmdAltersText()
2387 erase_end_line -- Ctrl-Del is the PM way.
2388
2389defc EndFile
2390 universal stream_mode
2391; call begin_shift( startline, startcol, shift_flag)
2392 if stream_mode then
2393 bottom
2394 endline
2395 else
2396 if .line = .last and .line then
2397 endline
2398 endif
2399 bottom
2400 endif
2401; call end_shift( startline, startcol, shift_flag, 1)
2402
2403; ---------------------------------------------------------------------------
2404defc MarkWord
2405 -- If arg(1) specified and > 0: Set cursor to pos of pointer.
2406 if arg(1) then
2407 'MH_gotoposition'
2408 unmark
2409 endif
2410 call pmark_word()
2411
2412; ---------------------------------------------------------------------------
2413defc MarkSentence
2414 -- If arg(1) specified and > 0: Set cursor to pos of pointer.
2415 if arg(1) then
2416 'MH_gotoposition'
2417 unmark
2418 endif
2419 call mark_sentence()
2420
2421; ---------------------------------------------------------------------------
2422defc MarkParagraph
2423 -- If arg(1) specified and > 0: Set cursor to pos of pointer.
2424 if arg(1) then
2425 'MH_gotoposition'
2426 unmark
2427 endif
2428 call mark_paragraph()
2429
2430; ---------------------------------------------------------------------------
2431defc ExtendSentence
2432 call mark_through_next_sentence()
2433
2434; ---------------------------------------------------------------------------
2435defc ExtendParagraph
2436 call mark_through_next_paragraph()
2437
2438; ---------------------------------------------------------------------------
2439defc MarkToken
2440 -- If arg(1) specified and > 0: Set cursor to pos of pointer.
2441 if arg(1) then
2442 'MH_gotoposition'
2443 endif
2444; if marktype() <> '' then
2445; sayerror -279 -- 'Text already marked'
2446; return
2447; endif
2448 if find_token( startcol, endcol) then
2449 getfileid fid
2450compile if WORD_MARK_TYPE = 'CHAR'
2451 call pset_mark(.line, .line, startcol, endcol, 'CHAR', fid)
2452compile else
2453 call pset_mark(.line, .line, startcol, endcol, 'BLOCK', fid)
2454compile endif
2455 'Copy2SharBuff' -- Copy mark to shared text buffer
2456 endif
2457
2458; ---------------------------------------------------------------------------
2459defc UppercaseWord
2460 call NextCmdAltersText()
2461 call psave_pos(save_pos)
2462 call psave_mark(save_mark)
2463 call pmark_word()
2464 call puppercase()
2465 call prestore_mark(save_mark)
2466
2467defc LowercaseWord
2468 call NextCmdAltersText()
2469 call psave_pos(save_pos)
2470 call psave_mark(save_mark)
2471 call pmark_word()
2472 call plowercase()
2473 call prestore_mark(save_mark)
2474 call prestore_pos(save_pos)
2475
2476defc UppercaseMark
2477 call NextCmdAltersText()
2478 call puppercase()
2479
2480defc LowercaseMark
2481 call NextCmdAltersText()
2482 call plowercase()
2483
2484defc BeginWord
2485 call pbegin_word()
2486
2487defc EndWord
2488 call pend_word()
2489
2490defc BeginFile
2491 universal stream_mode
2492 if stream_mode then
2493 top
2494 begin_line
2495 else
2496 if .line = 1 then
2497 begin_line
2498 endif
2499 top
2500 endif
2501
2502defc DuplicateLine
2503 call NextCmdAltersText()
2504 getline line
2505 insertline line,.line+1
2506
2507defc CommandDlgLine
2508 if .line then
2509 getline line
2510 'commandline 'line
2511 endif
2512
2513defc PrevWord
2514 universal stream_mode
2515
2516 if stream_mode &
2517 (.line > 1) & (.col = max( 1, verify( textline( .line), ' '))) then
2518 up
2519 end_line
2520 endif
2521 backtab_word
2522
2523defc NextWord
2524 universal stream_mode
2525
2526 getline line
2527 if stream_mode &
2528 ((not .line) | (lastpos( ' ', line) < .col) & (.line < .last)) then
2529 down
2530 call pfirst_nonblank()
2531 else
2532 tab_word
2533 endif
2534
2535defc MarkPrevWord
2536 universal stream_mode
2537
2538 startline = .line
2539 startcol = .col
2540 if .line then
2541 if stream_mode &
2542 (.line > 1) & (.col = max( 1, verify( textline( .line), ' '))) then
2543 up
2544 end_line
2545 endif
2546 backtab_word
2547 call extend_mark( startline, startcol, 0)
2548 endif
2549
2550defc MarkNextWord
2551 universal stream_mode
2552
2553 startline = .line
2554 startcol = .col
2555 if .line then
2556 getline line
2557 if stream_mode &
2558 ((not .line) | (lastpos( ' ', line) < .col) & (.line < .last)) then
2559 down
2560 call pfirst_nonblank()
2561 else
2562 tab_word
2563 endif
2564 call extend_mark( startline, startcol, 1)
2565 endif
2566
2567defc BeginScreen
2568 if .line then
2569 .cursory = 1
2570 else
2571 .line = 1
2572 endif
2573
2574defc EndScreen
2575 if .line then
2576 .cursory = .windowheight
2577 else
2578 .line = 1
2579 endif
2580
2581defc MarkBeginScreen
2582 startline = .line
2583 startcol = .col
2584 if .line then
2585 .cursory = 1
2586 endif
2587 if .line then
2588 call extend_mark( startline, startcol, 0)
2589 else
2590 .line = 1
2591 endif
2592
2593defc MarkEndScreen
2594 startline = .line
2595 startcol = .col
2596 if .line then
2597 .cursory = .windowheight
2598 endif
2599 if .line then
2600 call extend_mark( startline, startcol, 1)
2601 else
2602 .line = 1
2603 endif
2604
2605; ---------------------------------------------------------------------------
2606; Record and playback key and menu commands
2607; The array var 'recordkeys' holds the list of \0-separated Key\1Cmd pairs.
2608; It is set by SaveKeyCmd, which is called by OtherKeys, ExecKeyCmd and
2609; ExecAccelKey.
2610
2611defproc AddRecordKeys
2612 universal recordingstate
2613 universal curkey
2614 parse value( curkey) with KeyString \1 Cmd
2615 Cmd = strip( Cmd)
2616 -- If key recording is active, add curkey to recordkeys array var
2617 if wordpos( upcase( Cmd), 'RECORDKEYS PLAYBACKKEYS') = 0 then
2618 if recordingstate = 'R' then
2619 Rest = GetAVar( 'recordkeys')
2620 SetAVar( 'recordkeys', Rest''\0''curkey)
2621 endif
2622 endif
2623
2624defc RecordKeys
2625 universal recordingstate
2626 RecordKeysKeyString = strip( MenuAccelString( 'RecordKeys'), 'L', \9)
2627 PlaybackKeysKeyString = strip( MenuAccelString( 'PlaybackKeys'), 'L', \9)
2628 if recordingstate = 'R' then
2629 recordingstate = 'P'
2630 --'SayHint' REMEMBERED__MSG
2631 'SayHint Remembered! Press 'PlaybackKeysKeyString' to execute.'
2632 else
2633 recordingstate = 'R'
2634 SetAVar( 'recordkeys', '')
2635 --'SayHint' CTRL_R__MSG
2636 'SayHint Remembering keys. 'RecordKeysKeyString' to finish, 'PlaybackKeysKeyString' to finish and try, Esc to cancel.'
2637 endif
2638
2639defc CancelRecordKeys
2640 universal recordingstate
2641 recordingstate = ''
2642 'SayHint Key recording canceled.'
2643
2644defc PlaybackKeys
2645 universal recordingstate
2646 Rest = GetAVar( 'recordkeys')
2647 PlaybackKeysKeyString = strip( MenuAccelString( 'PlaybackKeys'), 'L', \9)
2648 if recordingstate = 'R' then
2649 recordingstate = 'P'
2650 --'SayHint' REMEMBERED__MSG
2651 'SayHint Remembered! Press 'PlaybackKeysKeyString' to execute.'
2652 endif
2653 if recordingstate <> 'P' or Rest = '' then
2654 return
2655 endif
2656
2657 call NextCmdAltersText()
2658 Rest = Rest''\0
2659 do while Rest <> ''
2660 parse value( Rest) with \0 KeyDef \0 Rest
2661 parse value( KeyDef) with Key \1 Cmd
2662 Rest = \0''Rest
2663 -- Execute either accel or standard (other) key
2664 if Key == \0 then
2665 -- nop
2666 elseif Cmd <> '' then
2667 -- Execute Cmd if defined
2668 ''Cmd
2669 elseif length( Key) = 1 then
2670 -- A standard char
2671 call Process_Key( Key)
2672 endif
2673 if Rest = \0 then
2674 leave
2675 endif
2676 enddo
2677
2678; ---------------------------------------------------------------------------
2679defc TypeTab
2680 call Process_Key( \9)
2681
2682defc DeleteChar
2683 universal stream_mode
2684 universal cua_marking_switch
2685 if marktype() & cua_marking_switch then
2686 if process_mark_like_cua() then -- deletes mark
2687 return
2688 endif
2689 endif
2690 call NextCmdAltersText()
2691 if .line then
2692 l = length( textline( .line))
2693 else
2694 l = .col -- make the following IF fail
2695 endif
2696 if .col > l & stream_mode then
2697 join
2698 .col = l + 1
2699 else
2700 old_level = .levelofattributesupport
2701 if old_level & not (old_level bitand 2) then
2702 .levelofattributesupport = .levelofattributesupport + 2
2703 .cursoroffset = 0
2704 endif
2705 delete_char
2706 .levelofattributesupport = old_level
2707 endif
2708
2709defc Down
2710 call UnmarkIfCua()
2711compile if RESPECT_SCROLL_LOCK
2712 if scroll_lock() then
2713; 'CenterLine'
2714 'ScrollDown'
2715 else
2716compile endif
2717 call updownkey(1)
2718compile if RESPECT_SCROLL_LOCK
2719 endif
2720compile endif
2721
2722defc MarkDown
2723 startline = .line
2724 startcol = .col
2725 call updownkey(1)
2726 if startline then -- required if cursor is in line 0
2727 call extend_mark( startline, startcol, 1)
2728 endif
2729
2730defc EndLine
2731 call UnmarkIfCua()
2732 if .line then
2733 end_line
2734 endif
2735 --call pEnd_Line() -- like end_line, but ignore trailing blanks
2736
2737defc EndLineOrAfter
2738 universal endkeystartpos
2739 call UnmarkIfCua()
2740 parse value( endkeystartpos) with savedline savedcol
2741 startline = .line
2742 startcol = .col
2743 if .line then
2744 end_line
2745 --call pEnd_Line() -- like end_line, but ignore trailing blanks
2746 if savedline <> startline or startcol > .col then
2747 endkeystartpos = startline startcol
2748 else
2749 if startcol = .col and savedcol > .col then
2750 .col = savedcol
2751 endif
2752 endif
2753 endif
2754
2755defc MarkEndLine
2756 startline = .line
2757 startcol = .col
2758 --call pEnd_Line() -- like end_line, but ignore trailing blanks
2759 if .line then
2760 end_line
2761 call extend_mark( startline, startcol, 1)
2762 endif
2763
2764defc MarkEndLineOrAfter
2765 universal endkeystartpos
2766 parse value( endkeystartpos) with savedline savedcol
2767 startline = .line
2768 startcol = .col
2769 if .line then
2770 end_line
2771 --call pEnd_Line() -- like end_line, but ignore trailing blanks
2772 if savedline <> startline or startcol > .col then
2773 endkeystartpos = startline startcol
2774 else
2775 if startcol = .col and savedcol > .col then
2776 .col = savedcol
2777 endif
2778 endif
2779 call extend_mark( startline, startcol, 1)
2780 endif
2781
2782defc ProcessEscape
2783 universal ESCAPE_KEY
2784 universal alt_R_active
2785 universal recordingstate
2786 sayerror 0
2787 if recordingstate = 'R' then
2788 'CancelRecordKeys'
2789 elseif alt_R_active <> '' then
2790 'setmessageline '\0
2791 'toggleframe 2 'alt_R_active -- restore status of messageline
2792 alt_R_active = ''
2793 elseif ESCAPE_KEY then
2794 'commandline'
2795 endif
2796
2797defc SaveOrSaveAs
2798 if .modify then
2799 'Save'
2800 else
2801; 'commandline Save '
2802 sayerror 'No changes. Press Enter to Save anyway.'
2803 'saveas_dlg 0' -- better show file selector
2804 -- new optional arg, 0 => no EXIST_OVERLAY__MSG
2805 endif
2806
2807defc SmartSave
2808 if .modify then
2809 'Save'
2810 else
2811 sayerror 'No changes.'
2812 endif
2813
2814defc FileOrQuit
2815compile if SMARTFILE
2816 if .modify then
2817 'File'
2818 else
2819 'Quit'
2820 endif
2821compile else
2822 'File'
2823compile endif
2824
2825defc EditFileDlg
2826 universal ring_enabled
2827 if not ring_enabled then
2828 sayerror NO_RING__MSG
2829 return
2830 endif
2831 'OpenDlg EDIT'
2832
2833defc UndoLine
2834 call NextCmdAltersText()
2835 undo
2836
2837defc NextFile
2838 nextfile
2839
2840defc BeginLine -- standard Home
2841 call UnmarkIfCua()
2842 begin_line
2843
2844defc BeginLineOrText -- Home
2845 call UnmarkIfCua()
2846 -- Go to begin of text.
2847 -- If in area before or at begin of text, go to column 1.
2848 startline = .line
2849 startcol = .col
2850 call pfirst_nonblank()
2851 if .line = startline and .col = startcol then
2852 begin_line
2853 endif
2854
2855defc MarkBeginLine -- standard Sh+Home
2856 startline = .line
2857 startcol = .col
2858 begin_line
2859 if .line then
2860 call extend_mark( startline, startcol, 0)
2861 endif
2862
2863defc MarkBeginLineOrText -- Sh+Home
2864 startline = .line
2865 startcol = .col
2866 -- Go to begin of text.
2867 -- If in area before or at begin of text, go to column 1.
2868 call pfirst_nonblank()
2869 if .line = startline and .col = startcol then
2870 begin_line
2871 endif
2872 if .line then
2873 call extend_mark( startline, startcol, 0)
2874 endif
2875
2876defc InsertToggle
2877 insert_toggle
2878 call fixup_cursor()
2879
2880defc PrevChar, Left
2881 universal cursoreverywhere
2882
2883 call UnmarkIfCua()
2884/*
2885-- Don't like hscroll
2886compile if RESPECT_SCROLL_LOCK
2887 if scroll_lock() then
2888 'ScrollLeft'
2889 else
2890compile endif
2891*/
2892 if .line > 1 & .col = 1 then
2893 up
2894 end_line
2895 else
2896 left
2897 endif
2898/*
2899-- Don't like hscroll
2900compile if RESPECT_SCROLL_LOCK
2901 endif
2902compile endif
2903*/
2904
2905defc MarkPrevChar, MarkLeft
2906 startline = .line
2907 startcol = .col
2908 if .line > 1 & .col = 1 then
2909 up
2910 end_line
2911 else
2912 left
2913 endif
2914 call extend_mark( startline, startcol, 0)
2915
2916defc PrevPage, PageUp
2917 call UnmarkIfCua()
2918 page_up
2919
2920defc NextPage, PageDown
2921 call UnmarkIfCua()
2922 page_down
2923
2924defc MarkPageUp
2925compile if TOP_OF_FILE_VALID = 'STREAM'
2926 universal stream_mode
2927compile endif
2928
2929 startline = .line
2930 startcol = .col
2931 page_up
2932 if .line then
2933 call extend_mark( startline, startcol, 0)
2934 endif
2935compile if TOP_OF_FILE_VALID = 'STREAM'
2936 if not .line & stream_mode then
2937 '+1'
2938 endif
2939compile elseif not TOP_OF_FILE_VALID
2940 if not .line then
2941 '+1'
2942 endif
2943compile endif
2944
2945defc MarkPageDown
2946 startline = .line
2947 startcol = .col
2948 page_down
2949 if .line then -- required if cursor is in line 0
2950 call extend_mark( startline, startcol, 1)
2951 endif
2952
2953defc NextChar, Right
2954 universal cursoreverywhere
2955
2956 call UnmarkIfCua()
2957/*
2958-- Don't like hscroll
2959compile if RESPECT_SCROLL_LOCK
2960 if scroll_lock() then
2961 'ScrollRight'
2962 else
2963compile endif
2964*/
2965 if .line then
2966 l = length( textline(.line))
2967 else
2968 l = .col
2969 endif
2970 if (.line < .last) & (.col > l) & not cursoreverywhere then
2971 down
2972 begin_line
2973 elseif (.line = .last) & (.col > l) & not cursoreverywhere then
2974 -- nop
2975 else
2976 right
2977 endif
2978/*
2979-- Don't like hscroll
2980compile if RESPECT_SCROLL_LOCK
2981 endif
2982compile endif
2983*/
2984
2985defc MarkNextChar, MarkRight
2986 startline = .line
2987 startcol = .col
2988 if .line then
2989 l = length( textline(.line))
2990 else
2991 l = .col
2992 endif
2993 if .line < .last & .col > l then
2994 down
2995 begin_line
2996 elseif .line <> .last | .col <= l then
2997 right
2998 endif
2999 call extend_mark( startline, startcol, 1)
3000
3001/*
3002defc BeginFile
3003 .line = 1
3004 begin_line
3005
3006defc EndFile
3007 .line = .last
3008 end_line
3009*/
3010
3011defc MarkBeginFile
3012 startline = .line
3013 startcol = .col
3014 .line = 1
3015 begin_line
3016 if startline then -- required if cursor was on line 0
3017 call extend_mark( startline, startcol, 0)
3018 end
3019
3020defc MarkEndFile
3021 startline = .line
3022 startcol = .col
3023 .line = .last
3024 if .line then -- required if cursor was on line 0
3025 end_line
3026 call extend_mark( startline, startcol, 1)
3027 endif
3028
3029defc ScrollLeft
3030 call UnmarkIfCua()
3031 oldcursorx = .cursorx
3032 if .col - .cursorx then
3033 .col = .col - .cursorx
3034 .cursorx = oldcursorx
3035 elseif .cursorx > 1 then
3036 left
3037 endif
3038
3039defc ScrollRight
3040 call UnmarkIfCua()
3041 oldcursorx=.cursorx
3042 a = .col + .windowwidth - .cursorx + 1
3043 if a <= MAXCOL then
3044 .col = a
3045 .cursorx = oldcursorx
3046 elseif .col < MAXCOL then
3047 right
3048 endif
3049
3050defc ScrollUp
3051 call UnmarkIfCua()
3052 oldcursory = .cursory
3053 if .line - .cursory > -1 then
3054 .cursory = 1
3055 up
3056 .cursory = oldcursory
3057 elseif .line then
3058 up
3059 endif
3060
3061defc ScrollDown
3062 call UnmarkIfCua()
3063 oldcursory = .cursory
3064 if .line - .cursory + .windowheight < .last then
3065 .cursory = .windowheight
3066 down
3067 .cursory = oldcursory
3068 elseif .line < .last then
3069 down
3070 endif
3071
3072defc CenterLine
3073 call NextCmdAltersText()
3074 call UnmarkIfCua()
3075 oldline = .line
3076 .cursory = .windowheight%2
3077 oldline
3078
3079defc BackTab
3080 universal matchtab_on
3081
3082 call UnmarkIfCua()
3083 if matchtab_on & .line > 1 then
3084 up
3085 backtab_word
3086 down
3087 else
3088 backtab
3089 endif
3090
3091defc Tab
3092 universal stream_mode
3093 universal matchtab_on
3094 universal tab_key
3095compile if WANT_DBCS_SUPPORT
3096 universal ondbcs
3097compile endif
3098
3099 call NextCmdAltersText()
3100 if tab_key then
3101 call Process_Key( \9)
3102 else -- tab_key
3103 call UnmarkIfCua()
3104 oldcol = .col
3105 if matchtab_on and .line > 1 then
3106 up
3107 tab_word
3108 if oldcol >= .col then
3109 .col = oldcol
3110 tab
3111 endif
3112 down
3113 else
3114 tab
3115 endif
3116compile if not WANT_TAB_INSERTION_TO_SPACE
3117 if insertstate() & stream_mode then
3118compile else
3119 if insertstate() then
3120compile endif
3121 numspc = .col - oldcol
3122compile if WANT_DBCS_SUPPORT
3123 if ondbcs then -- If we're on DBCS,
3124 if not (matchtab_on and .line > 1) then -- and didn't do a matchtab,
3125 if words( .tabs) > 1 then
3126 if not wordpos( .col, .tabs) then -- check if on a tab col.
3127 do i = 1 to words( .tabs) -- If we got shifted due to being inside a DBC,
3128 if word( .tabs, i) > oldcol then -- find the col we *should* be in, and
3129 numspc = word( .tabs, i) - oldcol -- set numspc according to that.
3130 leave
3131 endif
3132 enddo
3133 endif
3134 elseif (.col // .tabs) <> 1 then
3135 numspc = .tabs - (oldcol + .tabs - 1) // .tabs
3136 endif
3137 endif
3138 endif -- ondbcs
3139compile endif -- WANT_DBCS_SUPPORT
3140 if numspc > 0 then
3141 .col = oldcol
3142 call Process_Keys( substr( '', 1, numspc))
3143 endif
3144 endif -- insertstate()
3145 endif -- tab_key
3146
3147defc PrevLine, Up
3148compile if TOP_OF_FILE_VALID = 'STREAM'
3149 universal stream_mode
3150compile endif
3151
3152 call UnmarkIfCua()
3153compile if RESPECT_SCROLL_LOCK
3154 if scroll_lock() then
3155; 'CenterLine'
3156 'ScrollUp'
3157 else
3158compile endif
3159 call updownkey(0)
3160compile if RESPECT_SCROLL_LOCK
3161 endif
3162compile endif
3163compile if TOP_OF_FILE_VALID = 'STREAM'
3164 if not .line & stream_mode then
3165 '+1'
3166 endif
3167compile elseif not TOP_OF_FILE_VALID
3168 if not .line then
3169 '+1'
3170 endif
3171compile endif
3172
3173defc MarkUp
3174compile if TOP_OF_FILE_VALID = 'STREAM'
3175 universal stream_mode
3176compile endif
3177 startline = .line
3178 startcol = .col
3179 call updownkey(0)
3180 if .line then
3181 call extend_mark( startline, startcol, 0)
3182 endif
3183compile if TOP_OF_FILE_VALID = 'STREAM'
3184 if not .line & stream_mode then
3185 '+1'
3186 endif
3187compile elseif not TOP_OF_FILE_VALID
3188 if not .line then
3189 '+1'
3190 endif
3191compile endif
3192
3193defc DefaultPaste
3194 universal nepmd_hini
3195 universal cua_marking_switch
3196
3197 call NextCmdAltersText()
3198 KeyPath = '\NEPMD\User\Mark\DefaultPaste'
3199 next = substr( upcase( NepmdQueryConfigValue( nepmd_hini, KeyPath)), 1, 1)
3200 if next = 'L' then
3201 style = 'L'
3202 elseif next = 'B' then
3203 style = 'B'
3204 else
3205 style = 'C'
3206 endif
3207 if cua_marking_switch then
3208 call process_mark_like_cua() -- deletes mark
3209 endif
3210 'paste' style
3211
3212defc AlternatePaste
3213 universal nepmd_hini
3214 universal cua_marking_switch
3215
3216 call NextCmdAltersText()
3217 KeyPath = '\NEPMD\User\Mark\DefaultPaste'
3218 next = substr( upcase( NepmdQueryConfigValue( nepmd_hini, KeyPath)), 1, 1)
3219 if next = 'L' then
3220 altstyle = 'C'
3221 elseif next = 'B' then
3222 altstyle = 'C'
3223 else
3224 altstyle = 'L'
3225 endif
3226 if cua_marking_switch then
3227 call process_mark_like_cua() -- deletes mark
3228 endif
3229 'paste' altstyle
3230
3231; Insert the char from the line above at cursor position.
3232; May get executed repeatedly to copy an entire expression without
3233; cluttering the undo list at every single execution.
3234; From Luc van Bogaert.
3235defc InsertCharAbove
3236 if .line > 1 then
3237 -- suppress autosave and undo (for during repeated use)
3238 saved_autosave = .autosave
3239 .autosave = 0
3240 call NextCmdAltersText()
3241
3242 -- force overwrite mode
3243 i_s = insert_state()
3244 if i_s then
3245 insert_toggle -- Turn off insert mode
3246 endif
3247
3248 line = textline( .line - 1) -- line above
3249 char = substr( line, .col, 1)
3250 keyin char
3251
3252 if i_s then
3253 insert_toggle
3254 endif
3255
3256 .autosave = saved_autosave
3257 endif
3258
3259; Insert the char from the line below at cursor position.
3260; May get executed repeatedly to copy an entire expression without
3261; cluttering the undo list at every single execution.
3262; From Luc van Bogaert.
3263defc InsertCharBelow
3264 if .line < .last then
3265 -- suppress autosave and undo (for during repeated use)
3266 saved_autosave = .autosave
3267 .autosave = 0
3268 call NextCmdAltersText()
3269
3270 -- force overwrite mode
3271 i_s = insert_state()
3272 if i_s then
3273 insert_toggle -- Turn off insert mode
3274 endif
3275
3276 line = textline( .line + 1) -- line below
3277 char = substr( line, .col, 1)
3278 keyin char
3279
3280 if i_s then
3281 insert_toggle
3282 endif
3283
3284 .autosave = saved_autosave
3285 endif
3286
3287; Add a new line before the current, move to it, keep col.
3288defc NewLineBefore
3289 call NextCmdAltersText()
3290 insertline ''
3291 up
3292
3293; Add a new line after the current, move to it, keep col.
3294defc NewLineAfter
3295 call NextCmdAltersText()
3296 insertline '', .line + 1
3297 down
3298
3299; Define a_1, because alt_1 is only defined since ALT_1.E is redefined.
3300defc a_1
3301 'alt_1'
3302
Note: See TracBrowser for help on using the repository browser.