-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathrex.kex
148 lines (127 loc) · 6.78 KB
/
rex.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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
'set novalue on' /* force KEXX and its way of SIGNAL ON NOVALUE */
/* Usage: [MACRO] REX [name] */
/* Purpose: 'REX a n y' is a shorthand for 'X "a n y.rex"', */
/* 'REX' alone is a shorthand for 'X untitled.rex'.*/
/* An empty (new) file is filled with the template */
/* specified in macro REX after KEXX label COPY: */
/* Requires: NT KEDITW32 or OS/2 KEDIT 5 for long file names */
/* (Frank Ellermann, 2015) */
NAME = strip( strip( strip( arg( 1 )),, '"' ))
if NAME = '' then do
if size.1() = 0 & ft.1() = 'REX' then NAME = fn.1()
else NAME = 'untitled'
end
'x "' || NAME || '.rex"'
if rc <> 0 then exit rc
if sign( size.1()) then exit rc
SALT = alt.1() alt.2()
do N = COPY() to sourceline()
'i' sourceline( N )
end
'top' ; 'forw half'
'set alt' SALT ; exit rc
COPY: if arg() then return sigl ; else return 1 + COPY( 'sigl' )
/* Classic REXX 5.00 (Regina) or 6.03+ (ooRexx) with RexxUtil */
signal on novalue name ERROR ; parse version UTIL REXX .
if ( 0 <> x2c( 30 )) | ( REXX <> 5 & REXX < 6.03 )
then exit ERROR( 'untested' UTIL REXX )
if 6 <= REXX then interpret 'signal on nostring name ERROR'
if 5 <= REXX then interpret 'signal on lostdigits name ERROR'
signal on halt name ERROR ; signal on failure name ERROR
signal on notready name ERROR ; signal on error name ERROR
numeric digits 20 ; UTIL = REGUTIL()
/* -------------------------------------------------------------- */
exit USAGE( 'not yet implemented' )
/* ----------------------------- (REXX USAGE template 2016-03-06) */
USAGE: procedure /* show (error +) usage message: */
parse source . . USE ; USE = filespec( 'name', USE )
say x2c( right( 7, arg())) /* terminate line (BEL if error) */
if arg() then say 'Error:' arg( 1 )
say 'Usage:' USE 'arguments'
say /* suited for REXXC tokenization */
say ' FIXME'
return 1 /* exit code 1, nothing happened */
/* ----------------------------- (SysFileTree wrapper 2017-05-12) */
/* Treat SysFileTree errors as fatal, otherwise return the number */
/* of found files stored in stem.0 for the stem specified as 2nd */
/* argument. Attributes (4th + 5th SysFileTree argument) are not */
/* supported; the first three SysFileTree arguments are required. */
/* Clobbers DIRTREE.. in the scope of the caller. */
DIRTREE: /* return number of found files: */
if right( arg( 2 ), 1 ) = '.' then DIRTREE.. = arg( 2 )
else DIRTREE.. = arg( 2 ) || '.'
if SysFileTree( arg( 1 ), DIRTREE.., arg( 3 )) = 0
then return value( DIRTREE.. || 0 )
else exit ERROR( 'SysFileTree failed near line' sigl )
/* ----------------------------- (RXQUEUE portability 2020-03-14) */
/* ooRexx 6.04 does not yet support ADDRESS ... WITH, otherwise */
/* the same syntax could get the command output in a REXX stem */
/* without using a REXX queue (aka REXX stack). */
RXLIFO: procedure expose rc
signal off error ; parse version . REXX .
LIFO = 'RxQueue' rxqueue( 'get' ) '/LIFO'
if REXX <> 5 then address CMD arg( 1 ) || '|' || LIFO
else address SYSTEM arg( 1 ) || '|' || LIFO
return ( .RS < 0 ) /* 0: okay (any rc), 1: failure */
/* ----------------------------- (Regina SysLoadFuncs 2015-12-06) */
REGUTIL: procedure /* Not needed for ooRexx > 6.03 */
if RxFuncQuery( 'SysLoadFuncs' ) then do
ERR = RxFuncAdd( 'SysLoadFuncs', 'RexxUtil' )
if ERR <> 0 then exit ERROR( 'RexxUtil load error' ERR )
end /* static Regina has no RexxUtil */
ERR = SysLoadFuncs() ; return SysUtilVersion()
/* ----------------------------- (STDERR: unification 2020-04-07) */
/* PERROR() emulates lineout( 'STDERR:', emsg ) with ERROUT(). */
/* ERROUT() emulates charout( 'STDERR:', emsg ). */
/* Example: exit 1 | PERROR( 'result 0 or 1 as for lineout()' ) */
/* ERROR() shows an error message and the source line number sigl */
/* on stderr. Examples: if 0 = 1 then exit ERROR( 'oops' ) */
/* call ERROR 'interactive debug here' */
/* ERROR() can also catch exceptions (REXX conditions), examples: */
/* SIGNAL ON ERROR non-zero rc or unhandled FAILURE */
/* SIGNAL ON NOVALUE NAME ERROR uninitialized variable */
/* CALL ON NOTREADY NAME ERROR blocked I/O (incl. EOF on input) */
/* ERROR() uses ERROR. in the context of its caller and returns 1 */
/* for explicit calls or CALL ON conditions. For a SIGNAL ON ... */
/* condition ERROR() ends with exit 1. */
PERROR: return sign( ERROUT( arg( 1 ) || x2c( 0D0A )))
ERROUT: procedure
parse version S V . ; signal off notready
select
when 6 <= V & V < 7 then S = 'STDERR:' /* (o)oRexx */
when S == 'REXXSAA' then S = 'STDERR:' /* IBM Rexx */
when V == 5.00 then S = '<STDERR>' /* Regina */
otherwise S = '/dev/con' /* Quercus */
end /* Kedit KEXX 5.xy not supported */
return charout( S, arg( 1 ))
ERROR: /* trace off, save result + sigl */
ERROR.3 = trace( 'o' ) ; ERROR.1 = value( 'result' )
ERROR.2 = sigl ; call PERROR
ERROR.3 = right( ERROR.2 '*-*', 10 )
if ERROR.2 <= sourceline()
then call PERROR ERROR.3 strip( sourceline( ERROR.2 ))
else call PERROR ERROR.3 '(source line unavailable)'
ERROR.3 = right( '+++', 10 ) condition( 'c' ) condition( 'd' )
if condition() = '' then ERROR.3 = right( '>>>', 10 ) arg( 1 )
call PERROR ERROR.3
select
when sign( wordpos( condition( 'c' ), 'ERROR FAILURE' ))
then ERROR.3 = 'RC' rc
when condition( 'c' ) = 'SYNTAX'
then ERROR.3 = errortext( rc )
when condition( 'c' ) = 'HALT'
then ERROR.3 = errortext( 4 )
when condition( 'c' ) = 'NOTREADY' then do
ERROR.3 = condition( 'd' )
if ERROR.3 <> '' then do
ERROR.3 = stream( ERROR.3, 'd' )
end
end
otherwise ERROR.3 = ''
end
if ERROR.3 <> '' then call PERROR right( '>>>', 10 ) ERROR.3
parse value ERROR.2 ERROR.1 with sigl result
if ERROR.1 == 'RESULT' then drop result
trace ?L /* -- interactive label trace -- */
ERROR: if condition() = 'SIGNAL' then exit 1
else return 1