$err.rex: Difference between revisions

From Rosetta Code
Content added Content deleted
m (elided a blank line.)
(convert to a redirect page)
 
(One intermediate revision by one other user not shown)
Line 1: Line 1:
#REDIRECT [[$ERR.REX]]
<!-- This page was re-instated after it was moved or renamed.

Many references (links) to this page were broken because of that action, and
it's a lot easier to just re-instate this page instead of trying to find out where all the links are broken.

Because of its size, it isn't feasible to include it with the invoking REXX programs (Rosetta Code tasks),
or for that matter, the other REXX programs that may be invoked in turn).
This page doesn't belong to any specific Rosetta Code task, but instead,
it belongs to (or is in) many REXX solutions (computer programs) that,
when encountering an error,
invoke the $ERR.REX (REXX) program to display the error message(s)
(in color, if supported by the particular REXX interpreter being used).

--- Gerard Schildberger -->


==$ERR.REX==
This is the &nbsp; '''$ERR.REX''' &nbsp; (REXX) program which is used by many other REXX programs to display error or
<br>informational message(s), &nbsp; some of the options are:
::* &nbsp; displaying messages in color(s) &nbsp; &nbsp; (if supported)
::* &nbsp; writing the error message(s) to a file
::* &nbsp; splitting the message(s) into multiple lines
::* &nbsp; adding indentation
::* &nbsp; adding blank lines before and/or after the displaying of the message(s)
::* &nbsp; ... and other options


The help for the &nbsp; '''$ERR''' &nbsp; REXX program is included here &nbsp; ──► &nbsp; [[$ERR.HEL]].

The &nbsp; '''$ERR''' &nbsp; REXX program makes use of &nbsp; '''$T''' &nbsp; REXX program which is used to display error messages in color (if supported) &nbsp; via &nbsp; '''$T''').
<br>The &nbsp; '''$T''' &nbsp; REXX program is included here &nbsp; ──► &nbsp; [[$T.REX]].

REXX programs not included are &nbsp; '''$H''' &nbsp; which shows '''help''' and other documentation.
<lang rexx>/*REXX program to display error or informational messages (in color, if supported). */
trace off /*turn off all REXX cmd error messages.*/
parse arg ! /*obtain the original arguments. */
if !all( arg() ) then exit /*Request for help? Display, then exit*/
if !cms then address '' /*handle ADDRESS for CMS. */
signal on halt /*be able to handle the halting of pgm.*/
signal on noValue /* " " " " undefined variables*/
signal on syntax /* " " " " pgm syntax errors.*/
numeric digits 100 /*what the hell, support big numbers. */
/*══════ a list of external commands. */
@ctty = 'CTTY' /*point to the CTTY command. */
@globalv = 'GLOBALV' /* " " " GLOBALV " */
@finis = 'FINIS' /* " " " FINIS " */
@subcom = 'SUBCOM' /* " " " CMS SUBCOM " */
@cpset = 'CP SET' /* " " " CP SET " */
@conwait = 'CONWAIT' /* " " " CONWAIT " */
@cpspool = 'CP SPOOL' /* " " " CP SPOOL " */
@cmstype = 'SET CMSTYPE' /* " " " SET CMSTYPE " */

if !cms | !dos then @ = '────────' /*use hyphens for dashes in messages. */
else @ = '--------' /* " minuses " " " " */

parse var !! !! ' ..F=' ftops /*is $ERR to write errors to file? */
if ftops\=='' then ftops='.F='ftops /*Yes, then add to FTOPS variable. */
etops=strip(ftops '.C=red .END=1') /*also, add it to the ETOPS variable.*/
g.1=space(!!) /*a version with no extra blanks. */
pblank='05'x /*use pseudoBlank as the "true" blank*/

do j=2 to 9 /*process some possible shortcuts. */
k=j-1 /*point to the previous variable. */
parse var g.k a.k g.j /*get the "G" version (equals "all").*/
if a.k==',' then a.k= /*if omitted, then use a null. */
g.k=translate(g.k,,pblank) /*translate to a true blank. */
a.k=translate(a.k,,pblank) /* " " " " " */
aU.k=a.k; upper aU.k /*get an uppercase version of a.k */
L.k=length(a.k) /*get the length of the a.k variable.*/
c.k= comma(a.k) /*add a comma (,) to the number. */
w.k=length(c.k) /*get the length of commatized number. */
end /*j*/
/* [↓] shortcut versions of a. */
a2=a.2; a3=a.3; a4=a.4; a5=a.5; a6=a.6; a7=a.7; a8=a.8
g3=g.3; g4=g.4; g5=g.5; g6=g.6; g7=g.7; g8=g.8
aa5=a.5
if isNum(aa5) then aa5=abs(aa5) /*if it's a number, then use ABS value.*/
i=a.1 /*this is the error number. */
errmsgto=
errmsgnt=
xedit=0 /*indicate no XEDIT (so far). */

if !cms then do /*if CMS, then do some housework first.*/
@globalv 'SELECT' !fn "GET ERRMSGTO ERRMSGNT"
@finis '* * *' /*close all open files. */
@cmstype 'RT' /*ensure the user sees the error msgs. */
@conwait /*wait for all messages to be written. */
@cpspool 'CON TERM' /*ensure user sees the error messages. */
@cpset' IMSG ON' /* " " " informational msgs. */
@cpset' EMSG ON' /* " " " error " */
@subcom 'XEDIT' /*see if executing under XEDIT. */
xedit=\rc & \cmsflag('SUBSET') /*set flag: running under XEDIT |SUBSET*/
ufid=a3 a4 a5 /*maybe obtain a fileID for a message. */
end

if !dos then do /*if DOS, then perform some housework.*/
if \!nt then @ctty 'con' /*Not Windows NT? Then use CTTY cmd.*/
_=a4
if _\=='' & right(_,1)\=="\" then _=_'\'
ufid=_ || a2'.'a3
end

i=space( translate(i, , '-'), 0) /*remove all minus signs from string. */
if i=='' then call erb 57 /*Is it null? Than an oops-say message*/

if i=0 then do /*if "error" is zero, show the author. */
_= /*now, start with a clean slate. */
iL=length(i) /*use number of zeroes for more info. */
if iL>1 then _=@'author'@"÷÷÷÷Gerard J. Schildberger"
if iL>2 then _=_ '÷÷phone (701)-242-8238'
if iL>3 then _=_ '÷÷E-mail gerardS@rrt.net'
if iL>5 then _=_ '÷÷9411 West Ridge Road,'
if iL>5 then _=_ '÷÷Hankinson, ND 58041'
atops=strip(ftops '.A=-2 .X=-2 .E=2 .C=yell .J=c .BOX= .KD=÷')
if _\=='' then call $t atops _ /*tell if more info if than one zero.*/
exit 0 /*exit with a return code of zero. */
end

if i==14000 |, /*is this a message for a HALT ? */
i==14.1 then do /* ··· or in some cases, 14.1 error. */
htops=strip(ftops '.X=-1 .C=red .J=c .BOX=')
call $t htops 'The REXX program' @ a2 @ "has been halted !"
exit 14000 /* ··· and indicate a HALT condition*/
end


if \isInt(i) then call erb 53,i "error_code" /*Hmmm, we got an "internal" pgm error.*/
oi=i /*keep the original error number around*/
xedit= (xedit & i>0) /*inside the XEDIT program? */
i=abs(i) /*use the absolute value of I. */
if i<1400 | i>1499 then call erb 99,oi /*check for a legal range of I. */
k=i-1400 /*from now on, use a shorter I. */
if xedit then address 'XEDIT' "SET MSGM ON LONG" /*allow XEDIT messages to be seen. */
call sy /*display a blank line for the eyeballs*/
call sy '($$$'i") *error*:" /*write a header line (before the msg).*/

/*now, display the error message(s). */


if k== 0 then call sy "some commands can't or shouldn't be executed while in" g3
if k== 1 then call sy "the" g3 'was previously specified or specified more than once'
if k== 2 then call sy "the" a4 "argument can't be" choose("negative",g5)":" a3
if k== 3 then call sy 'the (disk) filemode' a3 "can't have any read-only extensions" g4
if k== 4 then call sy 'the' a4 "filemode/address can't be" choose('RELEASEd',g5)":" a3
if k== 5 then do
call sy "illegal compator operator" @ a3 'specified,'
call sy "it must be one of: = \= < <= > >= \< \>"
end
if k== 6 then call sy "no special characters are allowed in the" g4':' a3
if k== 7 then call sy "fixed-point underflow or overflow (result is too small or too large)"
if k== 8 then call sy "illegal filemode" @ a3 @ g4
if k== 9 then call sy "a terminal screen (CRT) is required with the" @ a3 @ 'feature'
if k==10 then if a3=='' then call sy "missing fileid for" g4
else call sy "illegal fileid" @ space(a3 a4 a5) @ g6
if k==11 then call sy "comparand operand must be an = or \= when using *xxx* type comparisons"
if k==12 then call sy "not enough" choose('virtual storage',g4)", at least" a3 'are needed'
if k==13 then do
call sy "REXX syntax error"
if isInt(a.6) then call sy errortext(a.6)
call syline
end
if k==14 then call sy 'the' a5 "argument" a3 "can't be" choose('greater',a.7) "than" a6 a4
if k==15 then do
if a3=='' then call sy "division by zero"
else do
call sy 'raising a negative number' @ a3 @
call sy "to a negative or an odd fractional power" @ a4 @
call fto g5
end
end
if k==16 then do
call sy "illegal MDISK" g4 'address:' a3","
call sy 'it must be exactly three hexadecimal characters (but not 000), or it may be'
call sy "preceeded by an asterisk (*) followed by three decimal characters"
end
if k==17 then do
call sy "undefined REXX variable referenced" a.6
call syline
end
if k==18 then do
call sy "illegal MDISK address or filemode,"
call sy "the 191 A MDISK address is reserved for the CMS user's private MDISK"
end
if k==19 then call sy 'numeric digits ('comma(a6)") isn't sufficient to" a4 a5 'to' a3
if k==20 then call sy "the" a3 @ a4 'and' g5 @ "aren't alike"
if k==21 then call sy choose("increment",a3) 'must be preceeded by a plus (+) or a minus (-)'
if k==22 then do
_='combination of characters:'
if L.4==1 then _="character:"
call sy a3 'contains an invalid' _ g4
end
if k==23 then call sy "the" a3 choose("option",a5) "requires the" a4 choose('option or feature',g6)
if k==24 then call sy "illegal" choose('volume',a4) "serial:" a3 ' (it must be six or less characters)'
if k==25 then do
call sy "you must be in the" a3 'mode/program to use the'
call sy "specified command (or it's" g4 "option)"
end
if k==26 then do
call sy "illegal MDISK" g4 'address:' a3","
call sy 'it must be exactly three hexadecimal characters (but not 000)'
end
if k==27 then call sy choose('number',g4) "can't be negative or zero (must be positive):" a3
if k==28 then call sy "duplicate" a3 'defined or specified:' g4
if k==29 then call sy "illegal filemode:" a3', it must be one character'
if k==30 then do
call say30
if a5==a6 | a6=='' | a6=="," then call sy "it must be" space(aa5 g8 _b)
else do
_to='to'
if a6==aa5+1 then _to="or"
call sy 'it must be from' aa5 _to a6 _b
end
end
if k==31 then call sy "no lines (or incorrect lines) were put in the program stack" g3
if k==32 then call sy 'the command' a3 "exited, but it isn't supposed to exit or stop"
if k==33 then call sy 'the' a3 "MDISK isn't a CMS MDISK, it's in the wrong format"
if k==34 then call sy @ a3 a4 @ "can't be executed from the" a5 'MDISK'
if k==35 then do
call sy "no" choose('argument',a4) 'was specified after or'
call fto a3 g5
end
if k==36 then call sy 'file' @ g3 @ "can't exist on the" a5 'MDISK'
if k==37 then do
y=a3
_=pos(a3,'''"`{[(«')
if _\==0 then y=translate(word('single_quote double_quote grave_accent left_brace left_bracket left_parenthesis left_double_carrot',_),,"_") a3
call sy 'unmatched' y g4
end
if k==38 then call sy 'file' @ space(a3 a4 a5) @ choose("can't be located or is empty",g6)
if k==39 then call sy "the" a3 choose('argument',a8) 'must be' a4 a5 "the" a6 choose('argument',a7)
if k==40 then do
call sy 'argument' @ a3 @ "isn't a valid hexadecimal string/number"
call sy "(it contains a character other than 0123456789ABCDEFabcdef or a blank)"
call fto g4
end
if k==41 then do
call sy "VM userid" @ g3 @ "doesn't exist or"
call sy 'is illegal (it may have an illegal character in it)'
end
if k==42 then call sy "the MDISK" a4 'for the user' a3 "doesn't exist"
if k==43 then call sy "illegal password for the" a3 a5 'MDISK was specified'
if k==44 then do
call sy "a CMS command is being used out of context, or"
call sy 'a command was renamed, or the FSTs have been altered'
_='DOS'
if !cms then _="CMS";call sy '(you may have to IPL' _")"
end
if k==45 then call sy 'VM userid' @ g3 @ "isn't logged on"
if k==46 then call sy "the file's" @ g4 "LRECL can't exceed" a3
if k==47 then call sy a3 @ a4 @ "not found" g5
if k==48 then do
_=
L=1
if L.4==1 | right(aU.4,1)=='X' then _=" an"
if _=='' then L=0
call sy @ a3 g5 @ 'contains'_ "invalid character"s(L)':' a4
end
if k==49 then call sy "CP LINK error for MDISK" a4 'userid' a3
if k==50 then do
call sy 'illegal/invalid' a3 "specified" @ a4 @
call fto g5
end
if k==51 then call sy choose("documentation",a5) 'for' a3 a4 "couldn't be located"
if k==52 then do
call sy "arguments aren't permitted"
call fto a4
end
if k==53 then do
call sy 'argument' @ a3 @ "isn't numeric" g5
call fto a4
end
if k==54 then do
call sy "not enough" choose('arguments',a3) "were specified" g5
call fto a4
end
if k==55 then do
call sy "illegal argument" @ a3 @ g5
call fto a4
end
if k==56 then call sy "illegal number of" choose('arguments',a4) "were specified" g5 a3
if k==57 then do
y=choose("arguments",a3)
z='was'
if translate(right(y,1))=="S" then z='were'
call sy "no" y z "specified"
end
if k==58 then call sy "only" g3 'argument's(a3) 'are accepted'
if k==59 then do
call sy "too many" choose('arguments',a3) "were specified" g5
call fto a4
end
if k==60 then call sy "argument#" a4 @ a3 @ 'must be an * or numeric'
if k==61 then call sy "conflicting arguments:" g3
if k==62 then call sy choose('fileid1',a3) "and" choose('fileid2',a4) "can't be identical" g5
if k==63 then do
call sy "no" 'argument was specified after or'
call fto g3
end
if k==64 then call sy "up to" g3 'argument's(a3) 'are accepted'
if k==65 then call sy "bad argument" @ a3 @ "illegal use of" g4
if k==66 then call sy "only" a3 'to' a4 "arguments are accepted"
if k==67 then call sy "unable to parse" a3 'from the results of:' g4
if k==68 then do
call sy "return code" a3 'doing:'
call sy g4
i=a3
end
if k==69 then call sy 'user' @ a3 @ "can't be logged on while the command" @ a2 @ 'is running'
if k==70 then do
if a3==2 then call sy "the" @ a2 @ 'command must be executed under the' a4 "userid"
if a3==1 then call sy "the" @ a2 @ "command must be executed from the A MDISK"
call sy "illegal use of the" @ a2 @ "command, subrc="a3
end
if k==71 then call sy "can't attach a" g3
if k==72 then do
call sy 'argument' @ a3 @ "isn't alphabetic" g5
call fto a4
end
if k==73 then do
call sy "an attempt was made to execute an unauthorized or restricted command"
if g3\=='' then call sy g3
end
if k==74 then call sy "the user" @ a3 @ 'must be in' a4 "mode"
if k==75 then call sy "no" choose('write',a4) "access to the" @ choose('A',space(left(a3),1)) @ "MDISK"
if k==76 then call sy a3 g5 "isn't known or supported:" a4
if k==77 then call sy space('error' a3 "in writing to disk file" @ g4 @)
if k==78 then call sy choose("file",g6) @ a3 a4 a5 @ 'not found'
if k==79 then call sy "the time window for execution is" a3 'through' a4
if k==80 then call sy @ a3 @ "isn't a known userid"
if k==81 then do
call sy 'argument' @ a5 space(@ g7) "is out of range"
_=max(w.3,w.4)
if L.3\==0 then call sy 'the lower limit is:' right(c.3,_)
if L.4\==0 then call sy 'the upper limit is:' right(c.4,_)
call fto a6
end
if k==82 then call sy g4 @ a3 @ "can't be located"
if k==83 then call sy "the" @ g3 @ 'option is required'
if k==84 then call sy "file" @ g4 @ 'had a syntax error for' a3
if k==85 then call sy "illegal combination of arguments:" g4
if k==86 then do
call sy "the" choose(a3,a2) 'command is being invoked out of context'
if g4\=='' then call sy g4
end
if k==87 then do
call sy 'argument' @ a3 @ "isn't a valid" choose('bit digit',a4)
call sy '(it contains more than one binary digit)'
call fto g5
end
if k==88 then call sy g4 @ a3 @ "doesn't exist"
if k==89 then call sy 'the' a3 "command can't be found"
if k==90 then do
call sy 'evaluation of' a3 "contains a zero divisor and"
call sy 'the result is infinite' g4
end
if k==91 then do
call sy 'argument' @ a3 @ "isn't a valid" choose('bit string',a4)
call sy '(it contains a non-binary character other than 0 or 1)'
call fto g5
end
if k==92 then do
call sy choose('argument',a4) @ a3 @ "isn't a whole number (integer)" g7
call fto a5
end
if k==93 then call sy "file" @ g3 @ 'already exists'
if k==94 then call sy "the T-DISK requested can't be obtained"
if k==95 then call sy "not enough free storage can be obtained"
if k==96 then call sy "illegal file" @ g3 @ 'or it was incorrectly modified'
if k==97 then do
call sy "a command failed,"
if a3\=='' then call sy "sub-command" @ g3 @','
call sy "it's all or partially restricted to authorized users"
end
if k==98 then do
call sy "an attempt was made to execute the" @ a2 @ 'command while'
call sy "the user" @ userid() @ "was in disconnected mode"
end
if k==99 then call sy "illegal error number for the" !fn 'REXX EXEC' ":" g3

if a2\=='' then call sy "for the" @ a2 @ 'command or function.'
call sy
if errmsgnt\=='' & errmsgto\=="" then call sy 'A notification (via $M) of this error has been sent to' errmsgto
if !cms then @globalv 'SELECT' !fn "PURGE"
if \isInt(i) then call er 53, i
exit sign(oi)*i


/*─────────────────────────────general 1-line subs────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
!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=3=='f3'x; if !crx then !env='DOS'; 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'; !crx=left(!sys,6)=='DOSCRX'; call !rex; return
!var: call !fid; if !kexx then return space(dosenv(arg(1))); return space(value(arg(1),,!env))
$t: !call=']$T'; call "$T" arg(1); call=; return
choose: parse arg c1,c2; if c2=='' | c2=="," then return c1; return c2
comma: procedure; parse arg _,c,p,t; c=pickBlank(c,","); o=p(p 3); p=abs(o); t=p(t 999999999); if \isInt(p) | \isInt(t) | p==0 | arg()>4 then return _; n=_'.9'; #=123456789; k=0; return comma_()
comma_: if o<0 then do; b=verify(_,' '); if b==0 then return _; e=length(_)-verify(reverse(_),' ')+1; end; else do; b=verify(n,#,"M"); e=verify(n,#'0',,verify(n,#"0.",'M'))-p-1; end; do j=e to b by -p while k<t; _=insert(c,_,j); k=k+1;end;return _
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
erb: call sy; if a2\=="" then call sy '('!fn "was invoked by the" @ a2 @ 'EXEC)'; call er arg(1),arg(2)
fto: parse arg fto ftox; ftoo='option'; if right(fto,2)=='()' then ftoo='function'; if fto\=='' then call sy "for the" ftoo @ space(fto ftox) @; return
halt: call er .1
isInt: return datatype(arg(1),'W')
isNum: return datatype(arg(1),'N')
noValue: !sigl=sigl; call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
opf: if right(arg(1),2)=='()' then return "function"; return 'option'
p: return word(arg(1),1)
pickBlank: procedure; parse arg x,y; arg xu; if xu=='BLANK' then return ' '; return p(x y)
s: if arg(1)==1 then return arg(3); return p(arg(2) 's')
say30: if a5==-1 then call sy 'illegal' a4":" a3; else call sy "illegal length of" a4":" a3; _t=p(a7 'character'); _b=_t || s(p(a6 aa5))" in length"; return
sy: sy=arg(1); if length(sy)<81 then do; call syit sy; return; end; sysy=; do forever while sy\==''; parse var sy _t sy; if length(sysy _t)<80 then do;sysy=sysy _t;iterate;end; call syitb;sysy=_t;end; if strip(sysy)\=='' then call syitb;return
syfunc: if left(a6,1)==']' then do; _sl=g8; call sy "invocation of an undefined REXX function/subroutine" substr(a6,2); end; return
syit: syit=arg(1); if xedit then address 'XEDIT' "EMSG" syit; else if a2=='$T' then say syit; else call $t etops syit; if errmsgto\=='' & syit\=='' then call '$M' errmsgto syit; return
syitb: if left(sysy,1)==' ' then sysy=substr(sysy,2); call syit sysy; return
syline: if a5\==0 then call sy 'on line' a5 "of" ufid; _sl=g7; call syfunc; if _sl\=='' then do; call sy; call sy "REXX sourceline is:"; call sy; call sy _sl; call sy; end; if !cms then do;'EXECSTAT' a2 a3;if rc==0 then "EXECDROP" a2 a3;end;return
syntax: !sigl=sigl; call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)</lang>

Latest revision as of 23:51, 6 September 2017

Redirect to:

Retrieved from "https://rosettacode.org/wiki/$err.rex?oldid=268102"