Anonymous user
LINESIZE.REX: Difference between revisions
restructured program, added comments and whitespace.
(Added a link to the HELP for this REXX program. -- ~~~~) |
(restructured program, added comments and whitespace.) |
||
Line 1:
The '''LINESIZE.REX''' is a REXX program to emulate the '''linesize'''
<br><br><br>The help for the '''LINESIZE''' REXX program is included here ──► [[LINESIZE.HEL]].
<lang rexx>/*REXX*/ trace off
/*┌────────────────────────────────────────────────────────────────────┐
Line 8:
│ support the LINESIZE built-in function. │
│ │
│
│ │
│ CMS │
│ TSO │
│ PC/REXX │
│ Personal REXX │
│ R4 │
│ ROO │
│ │
│ Method: to save time, this program first attempts to find the DOS │
Line 17 ⟶ 23:
└────────────────────────────────────────────────────────────────────┘*/
parse arg !
if \!dos then return 24 80 /*not DOS? Return default.*/▼
if !all(arg()) then exit
if !cms then address ''
signal on halt
signal on novalue
signal on syntax
@abc='abcdefghijklmnopqrstuvwxyz'
@erase = 'ERASE'
@find = 'FIND'
@MODE = 'MODE'
tfid= /*name of a temporary FID. */
/*Note: /i = ignore case.*/
@find_col = '/i "column"'
findLines=1
Line 33 ⟶ 48:
parse var !! _ . '(' ops ')' __
if _\=='' | __\=='' then call er 59
ops=space(ops)
do while ops\==''
parse var ops _1 2 1 _ . 1 _o ops
upper _
select
when _==',' then nop
when _1=='.' & pos("=",_)\==0 then tops=tops _o
when abbn('SCRWIDths' )|,
abbn('WIDths' )|,
Line 45 ⟶ 62:
abbn('WIDs' )|,
abbn('COLumns' )|,
abbn('COLs' ) then
otherwise call er 55,_o
end /*select*/
end /*while*/
/*──────────────attempt to use the DOS environmental variable: LINES. */
if
sd=word(!var('LINES'),1)
if \
sd=sd/1
end
/*──────────────if not defined, then use (DOS) MODE (writes to a file). */
if sw==0
do /*first, find temp. disk. */
call gettfid ,'$$$' /*get a TEMP id: !fn $$$ */
Line 68 ⟶ 85:
call linein tfid,1,0 /*point to record 1. */
do while sw==0
if lines(tfid)==0 then leave
_=translate(linein(tfid),,'=:') /*translate = : --> blanks.*/
parse upper var _ yname yval .
if yname=='COLUMNS' then sw=yval
end /*
@erase tfid /*erase the temp. file. */
Line 79 ⟶ 96:
if sw==0 then sw=80
/*use positive values. */
return abs(sw) /*return width. */
Line 87 ⟶ 104:
!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;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))
$fact!:procedure;parse arg x _ .;l=length(x);n=l-length(strip(x,'T',"!"));if n<=-n|_\==''|arg()\==1 then return x;z=left(x,l-n);if z<0|\
$fact:procedure;parse arg x _ .;arg ,n ! .;n=p(n 1);if \
$sfxa:parse arg ,s,m;arg u,c;if pos(left(s,2),u)\==0 then do j=length(s) to compare(s,c)-1 by -1;if right(u,j)\==left(c,j) then iterate;_=left(u,length(u)-j);if
$sfxf:parse arg y;if right(y,1)=='!' then y=$fact!(y);if \
$sfxm:parse arg z;arg w;b=1000;if right(w,1)=='I' then do;z=shorten(z);w=z;upper w;b=1024;end;p=pos(right(w,1),'KMGTPEZYXWVU');if p==0 then return arg(1);n=shorten(z);r=num(n,f,1);if
$sfxz:return $sfxa($sfxa($sfxa($sfxa($sfxa($sfxa(y,'PAIRs',2),'DOZens',12),'SCore',20),'GREATGRoss',1728),'GRoss',144),'GOOGOLs',1e100)
abb:arg abbu;parse arg abb;return abbrev(abbu,_,abbl(abb))
Line 105 ⟶ 122:
erx:call er '-'arg(1),arg(2);exit ''
getdtfid:tfid=p(!var("TMP") !var('TEMP') homedrive()"\");if substr(tfid,2,1)==':'&substr(tfid,3,1)\=="\" then tfid=insert('\',t,2);return strip(tfid,'T',"\")'\'arg(1)'.'arg(2)
halt:call er .1
homedrive:if symbol('HOMEDRIVE')\=="VAR" then homedrive=p(!var('HOMEDRIVE') 'C:');return homedrive
int:int=num(arg(1),arg(2));if \
na:if arg(1)\=='' then call er 01,arg(2);parse var ops na ops;if na=='' then call er 35,_o;return na
nai:return int(na(),_o)
Line 116 ⟶ 133:
no:if arg(1)\=='' then call er 01,arg(2);return left(_,2)\=='NO'
novalue:!sigl=sigl;call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
num:procedure;parse arg x .,f,q;if x=='' then return x;if
p:return word(arg(1),1)
s:if arg(1)==1 then return arg(3);return word(arg(2) 's',1)
|