-
Notifications
You must be signed in to change notification settings - Fork 2
/
extract.kex
108 lines (101 loc) · 5.44 KB
/
extract.kex
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
'set novalue on' /* force KEXX and its way of SIGNAL ON NOVALUE */
/* Usage: MACRO EXTRACT argument */
/* Examples: MACRO EXTRACT /color arrow/=/arb/ */
/* MACRO EXTRACT /block/macro ascii/last */
/* Option: SYNONYM EXTract 3 MACRO EXTRACT */
/* Purpose: Command EXTract works only within macros, not */
/* on the command line. Macro EXTRACT shows the */
/* possible results of command EXTract. Operands */
/* have to be delimited and can be abbreviated: */
/* MACRO EXTRACT /SYN/=/MACRO ASCII/VAR/ */
/* reports SYNONYM.1, EQUALSIGN.1, and EXTRACT.1, */
/* but not VARBLANK.1, just like command EXTract. */
/* Special: Macro EXTRACT uses 'nomsg query VAR' to get the */
/* variable names set by 'command extract /VAR/', */
/* (e.g. VARBLANK.0 etc.). But 'nomsg query REXX' */
/* reports error 153 (rc 99) if no external REXX */
/* interpreter is loaded. This is now handled as */
/* special case, similar problems are reported. */
/* Caveats: Kedit 5.0 DIALOG shows only up to 10 lines and */
/* certain long results like MACRO EXTRACT /ATTR/ */
/* or MACRO EXTRACT /RING/ won't work as expected. */
/* Updated 2008: Added missing POINT abbreviation for EXT 'P *'. */
/* Fixed KeditW 1.0 TOOLButton, a QUERY to expand */
/* abbreviations does not work for SYN *, TOOLB *, */
/* and TOOLB. Added six Kedit 5 abbreviations not */
/* found by KeditW QUERY but supported by EXTRACT. */
/* See also: KHELP EXTRACT, KHELP QUERY MACRO, KHELP = */
/* <http://purl.net/xyzzy/kex/extract.kex> */
/* Requires: Kedit 5.0 or KeditW 1.0 (Frank Ellermann, 2000) */
ISKW = ( 'KEDIT' <> version.1()) ; EOL = d2c( 10 )
LINE = '' ; WORD = '' ; LONG = 13 + 7 * ISKW
WHAT = '' ; STOP = left( strip( arg( 1 )), 1 )
if \ datatype( STOP, 'A' ) then parse arg (STOP) WHAT
if WHAT = '' then do /* show EXTRACT message */
'extract' arg( 1 ) ; exit rc
end
do until WHAT = ''
parse var WHAT NEXT (STOP) WHAT
'nomsg query' NEXT ; WORD = word( NEXT, 1 )
if rc = 0 then do /* RING and MACRO okay, */
ABBR = word( lastmsg.1(), 1 ) /* expect EXTRACT name: */
ABBR = 'Point PREfix SYNonym TOOLButton' ABBR
ABBR = MATCH( WORD, ABBR )
end
else if rc = 5 & ISKW then do /* use old abbreviation */
ABBR = 'BORDer CURSORSHape EAPreserve KEYBoard PSCReen'
ABBR = 'RETRace SCReen SHIFTState' ABBR
ABBR = MATCH( WORD, ABBR )
end
else if rc <> 5 then ABBR = MATCH( WORD, 'REXXversion' )
else ABBR = '' /* WORD.x variable name */
if ABBR <> '' then WORD = translate( ABBR )
'extract' STOP || NEXT || STOP
if WORD = '=' then WORD = 'EQUALSIGN'
else if rc = 5 then WORD = 'EXTRACT'
else if rc <> 0 then leave
W = VALUE( WORD || '.0' )
if datatype( W, 'w' ) then do W = 0 to W
NEXT = WORD || '.' || W
LINE = LINE || EOL || left( NEXT, LONG ) VALUE( NEXT )
end
else do /* this must not happen */
STOP = "'command EXTRACT" STOP || NEXT || STOP || "'"
'emsg' STOP 'has not set variable' WORD || '.0' ; exit 4
end /* missing special case */
if WORD = 'EXTRACT' then leave /* rc 5 aborts EXTRACT */
end
STOP = rc /* rc 5 normally quiet: */
if WORD = 'EXTRACT' then 'emsg' WORD 'rc' STOP
if ISKW = 0 | length( LINE ) <= 512 then do
WHAT = delimit( 'EXTRACT' strip( arg( 1 )))
if ISKW then WHAT = WHAT 'fixed'
'dialog' delimit( strip( LINE, 'L', EOL )) 'title' WHAT
end
else do /* bypass DIALOG limit: */
'extract /MSGLINE' ; 'msgline ON 1 1'
do until LINE = ''
parse var LINE W (EOL) LINE ; say W
end
'msgline' MSGLINE.1 MSGLINE.2 MSGLINE.3 MSGLINE.4
end
exit STOP
VALUE: /* --- REXX value('x') of (un)defined 'x' */
"imm OLDRC =" rc "; 'novalue off' ; exit OLDRC"
interpret 'SIGL =' arg( 1 ) /* SIGL already changed */
"imm OLDRC =" rc "; 'novalue on' ; exit OLDRC"
return SIGL /* preserve RC + RESULT */
MATCH: procedure /* --- find abbreviation in list of words */
DEBUG = debugging.1() ; 'debugging off'
MATCH = MAT.H( arg( 1 ), arg( 2 )) ; 'debugging' DEBUG
return MATCH /***** trusted code *****/
MAT.H: procedure /* --- find abbreviation in list of words */
parse arg U, S ; U = translate( U )
do while S <> ''
parse var S X S ; T = translate( X )
if abbrev( T, U ) then do
if datatype( substr( X, length( U ) + 1, 1 ), 'U' ) = 0
then return X /* else abbr. too short */
end /* upper case indicates */
end /* a minimal truncation */
return S