Keyboard macros: Difference between revisions

Content added Content deleted
(Added EchoLisp)
(→‎{{header|REXX}}: added/changed whitespace and comments, corrected some typos, changed indentations.)
Line 518: Line 518:


=={{header|REXX}}==
=={{header|REXX}}==
This REXX program only works with PC/REXX or Personal REXX under "DOS" or under "DOS" in Microsoft Windows 1, 2, 3, 95, 98, or 2000.
{{works with| PC/REXX and Personal REXX}}
This REXX program   ''only''   works with PC/REXX or Personal REXX under "DOS" or under "DOS" in Microsoft Windows 1, 2, 3, 95, 98, or 2000.
<br>It '''won't''' work for the Microsoft Windows/NT family (Windows/NT/XP/Vista/7/8).
<br>It '''won't''' work for the Microsoft Windows/NT family (Windows/NT/XP/Vista/7/8 ···).
<br><br>If under Microsoft Windows, the change is only for the current "DOS" session (i.e., that DOS window).
<br><br>If under Microsoft Windows, the change is only for the current "DOS" session (i.e., that DOS window).
<br>If under a native DOS, the change is system wide.
<br>If under a native DOS, the change is system wide.
Line 525: Line 526:
<br><br>REXX programs not included are '''$T''' which is only used when specific options are used (used when TOPS is specified),
<br><br>REXX programs not included are '''$T''' which is only used when specific options are used (used when TOPS is specified),
<br>the '''$ERR''' program which issues errors, and '''$H''' which shows '''help''' and other documentation.
<br>the '''$ERR''' program which issues errors, and '''$H''' which shows '''help''' and other documentation.
<lang rexx>/**/trace o;parse arg !;if !all(arg()) then exit;if !cms then address '';signal on halt;signal on novalue;signal on syntax
<lang rexx>♀/*REXX program can re-define most keys (including F keys) on a PC keyboard.*/
trace off
/*if not DOS, issue error. */
parse arg !
if \!dos then call er 23,', DOS[environment]'
if !all(arg()) then exit
/*if not PC/REXX, issue err*/
if \!pcrexx then call er 23,', PC/REXX[interpretor]'
if !cms then address ''
/*if Windows/NT, issue err.*/
if !nt then call er 23,!fn 'Windows/95/98/2000 REXX-program'


signal on halt
/* This program requires ANSI.SYS if any keys are set or (re-)defined.*/
signal on noValue
/* ANSI.SYS won't function correctly under Windows/NT (XP, Vista, 7, 8).*/
signal on syntax
call homedrive /*get the homedrive envvar.*/
$home=p(!var('$HOME') homedrive) /*get homedrive of \#\ dir.*/
$home=appenda($home,':') /*make the drive ──► drive:*/
$path=p(!var('$PATH') '\$') /*get path name of \# dir.*/
$path=prefixa($PATH,'\') /*make the path ──► \dir */
$path=appenda($path,'\') /*make the path ──► dir\ */
if \hascol($path) then $path=$home || $path /*prefix with $HOME ? */
@DOSKEY ='DOSKEY' /*point to the DOSKEY cmd*/
@ECHO ='ECHO' /*point to the ECHO cmd*/
@TYPE ='TYPE' /*point to the TYPE cmd*/
deffid=#path'LOGS\'!fn".LOG"
oldfid=#path'LOGS\'!fn".OLD"
tops='.BOX= .C=blue .H=darkcyan .E=1'
fops='.EF='deffid
functionkey=0
autoenter=
useauto=0
@offon='OFF ON ,'
@warns='WARNIFOFF WARNIFON ,'
sepline=copies('═',5) copies('═',73)
y=space(!!)


do forever /*process any options.*/
/*if not DOS, issue error. */
if \!dos then call er 23,', DOS[environment]'

/*if not PC/REXX, issue err*/
if \!pcrexx then call er 23,', PC/REXX[interpreter]'

/*if Windows/NT, issue err.*/
if !nt then call er 23,!fn 'Windows/95/98/2000 REXX-program'

/* This program requires ANSI.SYS if any keys are set or (re─)defined.*/
/* ANSI.SYS won't function correctly under Windows/NT (XP, Vista, 7, 8).*/

call homeDrive /*get the homeDrive envVar.*/

$home=p(!var('$HOME') homeDrive) /*get homeDrive of \$\ dir.*/
$home=appenda($home,':') /*make the drive ──► drive:*/
$path=p(!var('$PATH') '\$') /*get path name of \$ dir.*/
$path=prefixa($PATH,'\') /*make the path ──► \dir */
$path=appenda($path,'\') /*make the path ──► dir\ */

if \hasCol($path) then $path=$home || $path /*prefix with $HOME ? */

@DOSKEY = 'DOSKEY' /*point to the DOSKEY cmd*/
@ECHO = 'ECHO' /*point to the ECHO cmd*/
@TYPE = 'TYPE' /*point to the TYPE cmd*/
defFid = #path'LOGS\'!fn".LOG"
olfFid = #path'LOGS\'!fn".OLD"
tops = '.BOX= .C=blue .H=darkcyan .E=1'
fops = '.EF='defFid
functionKey= 0
autoEnter =
useAuto = 0
@offon = 'OFF ON ,'
@warns = 'WARNIFOFF WARNIFON ,'
sepLine = copies('═',5) copies('═',73)
y = space(!!)

do forever /*process any & all options*/
parse var y k1 2 1 k y
parse var y k1 2 1 k y
uk=k;upper uk
uk=k; upper uk

if uk=='[ENTER]' then do
if uk=='[ENTER]' then do
useauto=1
useAuto=1
autoenter=13
autoEnter=13
iterate
iterate
end
end

if uk=='[NOENTER]' then do
if uk=='[NOENTER]' then do
useauto=1
useAuto=1
autoenter=
autoEnter=
iterate
iterate
end
end

if k1\=='.' then leave
if k1\=='.' then leave
tops=tops k
tops=tops k
fops=fops k
fops=fops k
Line 584: Line 603:
k=="????" then do
k=="????" then do
!cls
!cls
if y=='' then y=deffid
if y=='' then y=defFid
@type y
@type y
say sepline
say sepLine
if k=="???" then call $defkey "ALLLOCKS , WARNIFON"
if k=="???" then call $defkey "ALLLOCKS , WARNIFON"

if k=="????" then do
call $t ".P=1 .C=blue" centre('DOSKEY macros',79,"─")
if k=="????" then do
@doskey '/macro'
call $t ".P=1 .C=blue" centre('DOSKEY macros',79,"─")
call $t ".C=blue" copies('─',79)
@doskey '/macro'
end
call $t ".C=blue" copies('─',79)
end
exit rc
exit rc
end
end


if k=='CLEARLOG' then do
if k=='CLEARLOG' then do
lfid=deffid
lFID=defFid

if lfid==deffid then do
call dosdel oldfid
if lFID==defFid then do
call dosrename deffid,oldfid
call dosdel olfFid
end
call dosrename defFid,olfFid
else call dosdel lfid
end
call whenstamp lfid,'log file was cleared by' !fn"."
else call dosdel lFID

_='ECHO' sepline">>"lfid
call whenstamp lFID,'log file was cleared by' !fn"."
_='ECHO' sepLine">>"lFID
_
_
'ECHO key new value>>'lfid
'ECHO key new value>>'lFID
_
_
exit
exit
Line 613: Line 635:
shiftkeys='NUMLOCK CAPSLOCK SCROLLLOCK ALLLOCKS'
shiftkeys='NUMLOCK CAPSLOCK SCROLLLOCK ALLLOCKS'


if abbrev('BLINKLOCKKEYS',k,5) then
if abbrev('BLINKLOCKKEYS',k,5) then
do
do
parse var o . k times secs _
parse var o . k times secs _
if _\=='' then call er 59
if _\=='' then call er 59
if k=='' | k=="," then k="ALLLOCKS"
if k=='' | k=="," then k="ALLLOCKS"
if wordpos(k,shiftkeys)==0 then call er 50,'shiftlock-key' origk
if wordpos(k,shiftkeys)==0 then call er 50,'shiftlock-key' origk
if times=='' | times==',' then times="ANYKEY"
if times=='' | times==',' then times="ANYKEY"
if times\=='ANYKEY' & \isint(times) then call er 53,times 'times'
if times\=='ANYKEY' & \isint(times) then call er 53,times 'times'
if secs=='' | secs==',' then secs=.1
if secs=='' | secs==',' then secs=.1
if \isnum(secs) then call er 53,times "seconds-delay-time"
if \isNum(secs) then call er 53,times "seconds-delay-time"
secs=secs/1
secs=secs/1
if secs<.1 | secs>99 then call er 81,.1 99 secs 'seconds-delay-time'
if secs<.1 | secs>99 then call er 81,.1 99 secs 'seconds-delay-time'
dids=0
dids=0


do forever
do forever

do j=1 for 3
do jo=2 to 1 by -1
do j=1 for 3

do jo=2 to 1 by -1
dakey=word(shiftkeys,j)
dakey=word(shiftkeys,j)
if k=='ALLLOCKS' | k==dakey then call "$DEFKEY" dakey word(@offon,jo)
if k=='ALLLOCKS' | k==dakey then call "$DEFKEY" dakey word(@offon,jo)
if secs\==0 then call delay secs
if secs\==0 then call delay secs
end /*j*/
end /*jo*/

end /*forever*/
end /*j*/


dids=dids+1
dids=dids+1
if times\=='ANYKEY' & dids>=times then exit
if times\=='ANYKEY' & dids>=times then exit
else if inkey("NOWAIT")\=='' then exit
else if inkey("NOWAIT")\=='' then exit
end /*forever*/
end /*forever*/
end
end


if wordpos(k,shiftkeys)\==0 then
if wordpos(k,shiftkeys)\==0 then
do
do
_=words(y)
_=words(y)
if _>2 then call er 59
if _>2 then call er 59
onoff=
onoff=
warnif=0
warnif=0
iswas='is'
iswas='is'
if y==',' then y=
if y==',' then y=

if y\=='' then do
if _==2 then do
if y\=='' then do

_=word(y,2)
warnif=wordpos(translate(_),@warns)
if _==2 then do
if warnif==0 then call er 55,_ k 'WARN'
_=word(y,2)
if warnif==3 then warnif=0
warnif=wordpos(translate(_),@warns)
y=subword(y,1,1)
if warnif==0 then call er 55,_ k 'WARN'
end
if warnif==3 then warnif=0
onoff=wordpos(translate(y),@offon)
y=subword(y,1,1)
if onoff==0 then call er 50,'ON-or-OFF' y
end

if onoff\==3 then iswas='was'
end
onoff=wordpos(translate(y),@offon)
if y==',' then y=
if onoff==0 then call er 50,'ON-or-OFF' y
if onoff\==3 then iswas='was'
do j=1 for 3
end

if y==',' then y=

do j=1 for 3
dakey=word(shiftkeys,j)
dakey=word(shiftkeys,j)
if warnif\==0 then if shiftstate(dakey)+1==warnif then call $t ".J=r" tops dakey iswas'('word(@offon,warnif)")"
if warnif\==0 then if shiftstate(dakey)+1==warnif then call $t ".J=r" tops dakey iswas'('word(@offon,warnif)")"

if k=="ALLLOCKS" | k==dakey then
if k=="ALLLOCKS" | k==dakey then
do
do
if y\=='' &,
if y\=='' &,
onoff\==3 then call shiftstate dakey,onoff-1
onoff\==3 then call shiftstate dakey,onoff-1
else if warnif==0 then call $t ".I=25" tops dakey 'is ('word(@offon,shiftstate(dakey)+1)")"
else if warnif==0 then call $t ".I=25" tops dakey 'is ('word(@offon,shiftstate(dakey)+1)")"
end
end

end /*j*/
end /*j*/

exit
exit
end
end


if y=='' then call er 54
if y=='' then call er 54
cod=
cod=
codz='Z'
codz='Z'


if pos('-',k)\==0 then
if pos('-',k)\==0 then do
parse var k cod '-' k
do
_='S SHIFT C CTRL CONTROL A ALT ALTERNATE'
parse var k cod '-' k
if cod=='' | wordpos(cod,_)==0 then call er 50,"key" origk
_='S SHIFT C CTRL CONTROL A ALT ALTERNATE'
cod=left(cod,1)
if cod=='' | wordpos(cod,_)==0 then call er 50,"key" origk
cod=left(cod,1)
codl=lower(cod)
codz=cod
codl=lower(cod)
if k=='' then call er 50,"key" origk
codz=cod
end
if k=='' then call er 50,"key" origk

end
if abbrev('APOSTROPHE',k,5) then k = "'"
if k=='ASTERISKKEYPAD' | k=='STARKEYPAD' then k = "*KEYPAD"
if k=='BACKSLASH' then k = "\"
if k=='COMMA' then k = ","
if k=='DEL' then k = "DELETE"
if k=='DELKEYPAD' then k = "DELETEKEYPAD"
if k=='ENT' then k = "ENTER"
if k=='ENTKEYPAD' then k = "ENTERKEYPAD"
if k=='EQUAL' then k = "="
if k=='FIVEKEYPAD' then k = "5KEYPAD"
if k=="GRAVEACCENT" | k=='GRAVE' then k = "`"
if k=='INSKEYPAD' then k = "INSKEYPAD"
if k=='LEFTBRACKET' then k = "["
if k=='MINUS' then k = "-"
if k=='MINUSKEYPAD' then k = "-KEYPAD"
if k=="PAUSE" | k=='BREAK' then k = "PAUSEBREAK"
if k=='PGDN' then k = "PAGEDOWN"
if k=='PGDNKEYPAD' then k = "PAGEDOWNKEYPAD"
if k=='PGUP' then k = "PAGEUP"
if k=='PGUPKEYPAD' then k = "PAGEUPKEYPAD"
if k=='PLUSKEYPAD' then k = "+KEYPAD"
if k=='PRINTSCRN' then k = "PRINTSCREEN"
if k=='RIGHTBRACKET' then k = "]"
if k=='SEMICOLON' then k = ";"
if k=='SPACE' | k=="SPACEBAR" then k = 'BLANK'


if wordpos(k,'PERIOD DOT DECIMAL DECIMALPOINT')\==0 then k="."
if abbrev('APOSTROPHE',k,5) then k="'"
if wordpos(k,'SLASH SOLIDUS VIRGULE OBELUS')\==0 then k="/"
if k=='ASTERISKKEYPAD' | k=='STARKEYPAD' then k="*KEYPAD"
if wordpos(k,'SLASHKEYPAD SOLIDUSKEYPAD VIRGULEKEYPAD OBELUSKEYPAD')\==0 then k="/KEYPAD"
if k=='BACKSLASH' then k="\"
if k=='COMMA' then k=","
if k=='DEL' then k="DELETE"
if k=='DELKEYPAD' then k="DELETEKEYPAD"
if k=='ENT' then k="ENTER"
if k=='ENTKEYPAD' then k="ENTERKEYPAD"
if k=='EQUAL' then k="="
if k=='FIVEKEYPAD' then k="5KEYPAD"
if k=="GRAVEACCENT" | k=='GRAVE' then k="`"
if k=='INSKEYPAD' then k="INSKEYPAD"
if k=='LEFTBRACKET' then k="["
if k=='MINUS' then k="-"
if k=='MINUSKEYPAD' then k="-KEYPAD"
if k=="PAUSE" | k=='BREAK' then k="PAUSEBREAK"
if k=='PGDN' then k="PAGEDOWN"
if k=='PGDNKEYPAD' then k="PAGEDOWNKEYPAD"
if k=='PGUP' then k="PAGEUP"
if k=='PGUPKEYPAD' then k="PAGEUPKEYPAD"
if k=='PLUSKEYPAD' then k="+KEYPAD"
if k=='PRINTSCRN' then k="PRINTSCREEN"
if k=='RIGHTBRACKET' then k="]"
if k=='SEMICOLON' then k=";"
if k=='SPACE' | k=="SPACEBAR" then k='BLANK'
if wordpos(k,'PERIOD DOT DECIMAL DECIMALPOINT')\==0 then k="."
if wordpos(k,'SLASH SOLIDUS VIRGULE OBELUS')\==0 then k="/"
if wordpos(k,'SLASHKEYPAD SOLIDUSKEYPAD VIRGULEKEYPAD OBELUSKEYPAD')\==0 then k="/KEYPAD"
base=
base=


do 1 /*the "1" enables the use of the LEAVE instruction.*/
do 1
len1=length(k)==1
len1=(length(k)==1)
uppc=isupp(k)
uppc=isUpp(k)
numb=isint(k)
numb=isint(k)

if len1 then do
if len1 then do
dkey=c2d(k)
dkey=c2d(k)
if uppc then do
if uppc then do
if cod=='A' then do
if cod=='A' then do
_='30 48 46 32 18 33 34 35 23 36 37 38 50 49 24 25 16 19 31 20 22 47 17 45 21 44'
_='30 48 46 32 18 33 34 35 23 36 37 38 50 49 24 25 16 19 31 20 22 47 17 45 21 44'
base='0;'word(_,dkey-96)
base='0;'word(_,dkey-96)
end
end
d.z=21
d.z=21
d.s=0
d.s=0
Line 737: Line 771:
base=d.codz+dkey
base=d.codz+dkey
end
end

if numb then do
if numb then do
dakey=dkey-47
dakey=dkey-47
if cod='' then base=dkey
if cod='' then base=dkey
if cod=='S' then base=word("41 33 64 35 36 37 94 38 42 49",dakey)
if cod=='S' then base=word("41 33 64 35 36 37 94 38 42 49",dakey)

if cod=='A' then if k<3 then base="0;"word(129 120,dakey)
if cod=='A' then if k<3 then base="0;"word(129 120,dakey)
else base="0;"119+dakey
else base="0;"119+dakey

if cod=='C' then do
if cod=='C' then do
if k==2 then base=0
if k==2 then base=0
if k==6 then base=30
if k==6 then base=30
end
end
end
end

if base\=='' then leave
if base\=='' then leave
call er 50,'key' origk
call er 50,'key' origk
end
end

ik=wordpos(k,'DELETE DOWNARROW END HOME INSERT LEFTARROW PAGEDOWN PAGEUP RIGHTARROW UPARROW')
ik=wordpos(k,'DELETE DOWNARROW END HOME INSERT LEFTARROW PAGEDOWN PAGEUP RIGHTARROW UPARROW')


select
select
when left(k,1)=='F' then do
when left(k,1)=='F' then do
functionkey=1
functionKey=1
fn=substr(k,2)
fn=substr(k,2)
if \isint(fn) | fn<1 | fn>12 then call er 81,1 12 k "FunctionKey"
if \isint(fn) | fn<1 | fn>12 then call er 81,1 12 k "FunctionKey"
d.z=58
d.z=58
d.s=83
d.s=83
d.c=93
d.c=93
d.a=103
d.a=103
if fn<11 then base='0;' || (d.codz+fn)
if fn<11 then base='0;' || (d.codz+fn)
else do
else do
d.z=133-11
d.z=133-11
d.s=135-11
d.s=135-11
d.c=137-11
d.c=137-11
d.a=139-11
d.a=139-11
base='0;' || (d.codz+fn)
base='0;' || (d.codz+fn)
end
end
end
end

when ik\==0 then do
when ik\==0 then do
d.z='83 80 79 71 82 75 81 73 77 72'
d.s=d.z
d.z='83 80 79 71 82 75 81 73 77 72'
d.c='147 145 117 119 146 115 118 132 116 141'
d.s=d.z
d.a='163 154 159 151 162 155 161 153 157 152'
d.c='147 145 117 119 146 115 118 132 116 141'
base='224;'word(d.codz,ik)
d.a='163 154 159 151 162 155 161 153 157 152'
end
base='224;'word(d.codz,ik)
end
when k=='PRINTSCREEN' & cod="C" then base='0;114'

when k=='PAUSEBREAK' & cod="C" then base='0;0'
when k=='NULL' & cod=='' then base="0;3"
when k=='PRINTSCREEN' & cod="C" then base='0;114'
when k=='BACKSPACE' then do
when k=='PAUSEBREAK' & cod="C" then base='0;0'
d.z=8
when k=='NULL' & cod=='' then base="0;3"

d.s=8
when k=='BACKSPACE' then do
d.c=127
d.a=0
d.z=8
base=d.codz
d.s=8
end
d.c=127
d.a=0
when k=='TAB' then do
d.z=9
base=d.codz
d.s='0;15'
end

d.c='0;148'
when k=='TAB' then do
d.z='0;165'
base=d.codz
d.z=9
end
d.s='0;15'
d.c='0;148'
d.z='0;165'
base=d.codz
end

when k=='BLANK' then do
when k=='BLANK' then do
d.z=92
d.z=92
Line 802: Line 846:
base=d.codz
base=d.codz
end
end

when k=='ENTER' then do
when k=='ENTER' then do
d.z=13
d.z=13
Line 809: Line 854:
base=d.codz
base=d.codz
end
end

when k=='-' then do
when k=='-' then do
d.z=45
d.s=95
d.z=45
d.c=31
d.s=95
d.a='0;130'
d.c=31
base=d.codz
d.a='0;130'
end
base=d.codz
end
when k=='=' then do

d.z=61
when k=='=' then do
d.s=43
d.c=
d.z=61
d.a='0;131'
d.s=43
base=d.codz
d.c=
end
d.a='0;131'
base=d.codz
when k=='[' then do
d.z=91
end

d.s=123
when k=='[' then do
d.c=27
d.a='0;26'
d.z=91
base=d.codz
d.s=123
end
d.c=27
d.a='0;26'
when k==']' then do
d.z=93
base=d.codz
d.s=125
end

d.c=29
when k==']' then do
d.a='0;27'
base=d.codz
d.z=93
end
d.s=125
d.c=29
when k=='\' then do
d.z=92
d.a='0;27'
d.s=124
base=d.codz
d.c=28
end

d.a='0;43'
when k=='\' then do
base=d.codz
end
d.z=92
d.s=124
when k==';' then do
d.z=59
d.c=28
d.s=58
d.a='0;43'
d.c=
base=d.codz
d.a='0;39'
end

base=d.codz
end
when k==';' then do
d.z=59
when k=="'" then do
d.z=39
d.s=58
d.s=34
d.c=
d.c=
d.a='0;39'
d.a='0;40'
base=d.codz
base=d.codz
end

end
when k==',' then do
when k=="'" then do
d.z=44
d.z=39
d.s=60
d.s=34
d.c=
d.c=
d.a='0;51'
d.a='0;40'
base=d.codz
base=d.codz
end
end

when k=='.' then do
when k==',' then do
d.z=46
d.s=62
d.z=44
d.c=
d.s=60
d.a='0;52'
d.c=
base=d.codz
d.a='0;51'
end
base=d.codz
end
when k=='/' then do

d.z=47
when k=='.' then do
d.s=63
d.c=
d.z=46
d.a='0;53'
d.s=62
base=d.codz
d.c=
end
d.a='0;52'
base=d.codz
when k=='`' then do
d.z=96
end

d.s=126
d.c=
when k=='/' then do
d.a='0;41'
d.z=47
base=d.codz
d.s=63
end
d.c=
d.a='0;53'
when k=='HOMEKEYPAD' then do
d.z='0;71'
base=d.codz
d.s=55
end

d.c='0;119'
when k=='`' then do
base=d.codz
end
d.z=96
d.s=126
when k=='UPARROWKEYPAD' then do
d.z='0;72'
d.c=
d.s=55
d.a='0;41'
d.c='0;141'
base=d.codz
end

when k=='HOMEKEYPAD' then do
d.z='0;71'
d.s=55
d.c='0;119'
base=d.codz
end

when k=='UPARROWKEYPAD' then do
d.z='0;72'
d.s=55
d.c='0;141'
base=d.codz
end

when k=='PAGEUPKEYPAD' then do
d.z='0;73'
d.s=57
d.c='0;132'
base=d.codz
base=d.codz
end
end

when k=='PAGEUPKEYPAD' then do
when k=='LEFTARROWKEYPAD' then do
d.z='0;73'
d.s=57
d.z='0;75'
d.c='0;132'
d.s=52
base=d.codz
d.c='0;115'
end
base=d.codz
end
when k=='LEFTARROWKEYPAD' then do

d.z='0;75'
when k=='5KEYPAD' then do
d.s=52
d.c='0;115'
d.z='0;76'
d.s=53
d.c='0;143'
base=d.codz
end

when k=='RIGHTARROWKEYPAD' then do
d.z='0;77'
d.s=54
d.c='0;116'
base=d.codz
end

when k=='ENDKEYPAD' then do
d.z='0;79'
d.s=49
d.c='0;117'
base=d.codz
base=d.codz
end
end

when k=='5KEYPAD' then do
when k=='DOWNARROWKEYPAD' then do
d.z='0;76'
d.s=53
d.z='0;80'
d.c='0;143'
d.s=50
base=d.codz
d.c='0;145'
end
when k=='RIGHTARROWKEYPAD' then do
d.z='0;77'
d.s=54
d.c='0;116'
base=d.codz
base=d.codz
end
end

when k=='ENDKEYPAD' then do
when k=='PAGEDOWNKEYPAD' then do
d.z='0;79'
d.s=49
d.z='0;81'
d.c='0;117'
d.s=51
base=d.codz
d.c='0;118'
end
when k=='DOWNARROWKEYPAD' then do
d.z='0;80'
d.s=50
d.c='0;145'
base=d.codz
base=d.codz
end
end

when k=='PAGEDOWNKEYPAD' then do
when k=='INSERTKEYPAD' then do
d.z='0;81'
d.s=51
d.z='0;82'
d.c='0;118'
d.s=48
base=d.codz
d.c='0;146'
end
base=d.codz
end
when k=='INSERTKEYPAD' then do

d.z='0;82'
when k=='DELETEKEYPAD' then do
d.s=48
d.c='0;146'
d.z='0;83'
d.s=46
d.c='0;147'
base=d.codz
end

when k=='ENTERKEYPAD' then do
d.z=13
d.c=10
d.a='0;166'
base=d.codz
base=d.codz
end
end

when k=='DELETEKEYPAD' then do
when k=='/KEYPAD' then do
d.z='0;83'
d.s=46
d.z=47
d.c='0;147'
d.s=d.z
base=d.codz
d.c='0;142'
end
d.a='0;74'
base=d.codz
when k=='ENTERKEYPAD' then do
d.z=13
end

d.c=10
when k=='*KEYPAD' then do
d.a='0;166'
base=d.codz
d.z=42
end
d.s='o;144'
d.c='0;78'
when k=='/KEYPAD' then do
d.z=47
base=d.codz
d.s=d.z
end

d.c='0;142'
when k=='-KEYPAD' then do
d.a='0;74'
base=d.codz
d.z=45
end
d.s=d.z
d.c='0;149'
when k=='*KEYPAD' then do
d.z=42
d.a='0;164'
d.s='o;144'
base=d.codz
d.c='0;78'
end

base=d.codz
when k=='+KEYPAD' then do
end
d.z=43
when k=='-KEYPAD' then do
d.z=45
d.s=d.z
d.s=d.z
d.c='0;150'
d.c='0;149'
d.a='0;55'
d.a='0;164'
base=d.codz
base=d.codz
end
otherwise nop
end
when k=='+KEYPAD' then do
d.z=43
d.s=d.z
d.c='0;150'
d.a='0;55'
base=d.codz
end
otherwise nop
end /*select*/
end /*select*/


if base\=='' then leave; call er 50,'key' origk
if base\=='' then leave
call er 50,'key' origk
end /*do 1*/
end /*do 1*/


Line 994: Line 1,067:
yy=
yy=


do j=1 for jy
do j=1 for jy
w=word(y,j)
w=word(y,j)
lw=length(w)
lw=length(w)
lc=left(w,1)
lc=left(w,1)
rc2=right(w,2);upper rc2
rc2=right(w,2); upper rc2

if ((lc=='"' & rc2=='"X') | (lc=="'" & rc2=="'X")) & lw>3 then
if ((lc=='"' & rc2=='"X') | (lc=="'" & rc2=="'X")) & lw>3 then
do
do
if (lw-3)//2\==0 then call er 56,w 'hexdigits for the hexstring' w
if (lw-3)//2\==0 then call er 56,w 'hexdigits for the hexstring' w
wm=substr(w,2,lw-3);if \ishex(wm) then call er 40,w
wm=substr(w,2,lw-3)
if \isHex(wm) then call er 40,w
w=x2c(wm)
w=x2c(wm)
end
end

yy=yy w
yy=yy w
end /*j*/
end /*j*/
/*if useauto=1, then use AUTOENTER as is*/
/*if useAuto=1, then use AUTOENTER as is.*/
/*if useauto=0 & funcKey, then use ENTER*/
/*if useAuto=0 & funcKey, then use ENTER.*/
if \useauto & functionkey then autoenter=13
if \useAuto & functionKey then autoEnter=13
yy=substr(yy,2)
yy=substr(yy,2)
!!='1b'x"[" /* ESC[s ---> save cursor position.*/
!!='1b'x"[" /* ESC[s ───► save cursor position. */
/* ESC[u ---> restore cursor position.*/
/* ESC[u ───► restore cursor position. */
/* ESC[1A ---> move cursor up 1 line*/
/* ESC[1A ───► move cursor up 1 line.*/

@echo !!"s"!! || base';"'yy'";'autoenter'p'!!"u"!!'1A' /*issue define.*/
@echo !!"s"!! || base';"'yy'";'autoEnter'p'!!"u"!!'1A' /*issue the define.*/
nk=k
nk=k
if cod\=='' then nk=codl"-"k
if cod\=='' then nk=codl"-"k

call $t '.Q=1' fops right(nk,max(length(nk),5)) "──►" yy
call $t '.Q=1' fops right(nk,max(length(nk),5)) "──►" yy
exit /*stick a fork in it, we're all done. */
exit

/*═════════════════════════════one─liner subroutines══════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/
!all: !!=!;!=space(!);upper !;call !FID;!nt=right(!var('OS'),2)=="NT";!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,"? ?SAMPLES ?AUTHOR ?FLOW")==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1
!cal: if symbol('!CALL')\=="VAR" then !call=; return !call
!env: !env='ENVIRONMENT'; if !sys=='MSDOS' | !brexx | !r4 | !roo then !env='SYSTEM'; if !os2 then !env='OS2'!env; !ebcdic=1=='f0'x; return
!FID: parse upper source !sys !fun !FID . 1 . . !fn !ft !fm .; call !sys; if !dos then do; _=lastpos('\',!fn); !fm=left(!fn,_); !fn=substr(!fn,_+1); parse var !fn !fn '.' !ft; end; return word(0 !fn !ft !fm,1+("0"arg(1)))
!rex: parse upper version !ver !vernum !verdate .; !brexx='BY'==!vernum; !kexx='KEXX'==!ver; !pcrexx='REXX/PERSONAL'==!ver | 'REXX/PC'==!ver; !r4='REXX-R4'==!ver; !regina='REXX-REGINA'==left(!ver,11); !roo='REXX-ROO'==!ver; call !env; return
!sys: !cms=!sys=='CMS'; !os2=!sys=="OS2"; !tso=!sys=='TSO' | !sys=="MVS"; !vse=!sys=='VSE'; !dos=pos("DOS",!sys)\==0 | pos('WIN',!sys)\==0 | !sys=="CMD"; call !rex; return
!var: call !FID; if !kexx then return space(dosenv(arg(1))); return space(value(arg(1),,!env))


$defkey: !call=']$DEFKEY'; call "$DEFKEY" arg(1); !call=; return result
/*═════════════════════════════general 1-line subs══════════════════════*/
$t: !call=']$T'; call "$T" arg(1); !call=; return result
!all:!!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1
!cal:if symbol('!CALL')\=="VAR" then !call=;return !call
appenda: procedure; parse arg x,_; if right(x,length(_))\==_ then x=x || _; return x
er: parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1,2) !FID(1)) _2; if _1<0 then return _1; exit result
!env:!env='ENVIRONMENT';if !sys=='MSDOS'|!brexx|!r4|!roo then !env='SYSTEM';if !os2 then !env='OS2'!env;!ebcdic=1=='f0'x;return
halt: call er .1
!fid:parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .;call !sys;if !dos then do;_=lastpos('\',!fn);!fm=left(!fn,_);!fn=substr(!fn,_+1);parse var !fn !fn '.' !ft;end;return word(0 !fn !ft !fm,1+('0'arg(1)))
hasCol: return pos(':',arg(1))\==0
!rex:parse upper version !ver !vernum !verdate .;!brexx='BY'==!vernum;!kexx='KEXX'==!ver;!pcrexx='REXX/PERSONAL'==!ver|'REXX/PC'==!ver;!r4='REXX-R4'==!ver;!regina='REXX-REGINA'==left(!ver,11);!roo='REXX-ROO'==!ver;call !env;return
homeDrive: if symbol('HOMEDRIVE')\=="VAR" then homeDrive=p(!var('HOMEDRIVE') 'C:'); return homeDrive
!sys:!cms=!sys=='CMS';!os2=!sys=='OS2';!tso=!sys=='TSO'|!sys=='MVS';!vse=!sys=='VSE';!dos=pos('DOS',!sys)\==0|pos('WIN',!sys)\==0|!sys=='CMD';call !rex;return
!var:call !fid;if !kexx then return space(dosenv(arg(1)));return space(value(arg(1),,!env))
isHex: return datatype(arg(1),'X')
isint: return datatype(arg(1),'W')
$defkey:!call=']$DEFKEY';call "$DEFKEY" arg(1);!call=;return result
isNum: return datatype(arg(1),'N')
$t:!call=']$T';call "$T" arg(1);!call=;return
isUpp: return datatype(arg(1),'U')
appenda:procedure;parse arg x,_;if right(x,length(_))\==_ then x=x||_;return x
er:parse arg _1,_2;call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2;if _1<0 then return _1;exit result
it: "ARG"(1);if rc==0 then return; call er 68,rc arg(1)
noValue: !sigl=sigl; call er 17,!FID(2) !FID(3) !sigl condition('D') sourceline(!sigl)
halt:call er .1
hascol:return pos(':',arg(1))\==0
p: return word(arg(1),1)
prefixa: procedure; parse arg x,_; if left(x,length(_))\==_ then x=_ || x; return x
homedrive:if symbol('HOMEDRIVE')\=="VAR" then homedrive=p(!var('HOMEDRIVE') 'C:');return homedrive
ishex:return datatype(arg(1),'X')
squish: return space(translate(arg(1),,word(arg(2) ',',1)),0)
syntax: !sigl=sigl; call er 13,!FID(2) !FID(3) !sigl !cal() condition('D') sourceline(!sigl)
isint:return datatype(arg(1),'W')
whenstamp: arg whenFID; call lineout whenFID,strip(left(date('U'),6)left(date("S"),4) time() arg(2)); call lineout whenFID,' '; call lineout whenFID; return
isnum:return datatype(arg(1),'N')
</lang>
isupp:return datatype(arg(1),'U')
it:"ARG"(1);if rc==0 then return;call er 68,rc arg(1)
novalue:!sigl=sigl;call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
p:return word(arg(1),1)
prefixa:procedure;parse arg x,_;if left(x,length(_))\==_ then x=_||x;return x
squish:return space(translate(arg(1),,word(arg(2) ',',1)),0)
syntax:!sigl=sigl;call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)
whenstamp:arg whenfid;call lineout whenfid,strip(left(date('U'),6)left(date("S"),4) time() arg(2));call lineout whenfid,' ';call lineout whenfid;return</lang>


=={{header|Ruby}}==
=={{header|Ruby}}==
Retrieved from "https://rosettacode.org/wiki/Keyboard_macros"