/*
Author: Les Koehler
Date: 17 Oct 2015 01:40:00
Update: 31 Oct 2015 04:03:27 - Use showit.rex for Help
Update: 7 Nov 2015 20:13:18 - Add WhoCalledMe & ::requires for it
*/ beghelp=thisline()+1 /*
&lcsme.rex: See "Purpose", below
Copyright (C) 2015 Leslie L. Koehler
This is free software. See "Notice:" at the bottom of
&this file.
Author: Les Koehler vmrexx@tampabay.rr.com
Purpose: Return a string for the caller to INTERPRET that will dump his
vars to a file and allow adding the file to the THE ring. For
.REX programs THE can be invoked, if installed, or the code can
be tailored to replace the default Notepad.
The file is named the same as the file being edited,
with a prefix of the upper case drive letter followed by an
underscore (e.g. C_), an optional identifier, a suffix of: .N
and an extension of .SDV. Initially, N=0 but If KEEP is
specified then N is incremented by 1 until a non-existing file
is found.
If not invoked from a THE edit session, and a version of
ooRexx earlier than 4.2 is installed, then the 5th argument
is required to identify the full path and file of the caller.
Version 4.2 introduced .stackframes, and it is used if
available.
Syntax: INTERPRET &sme(-->
Arg#: 1 2 3 4 5
>-- ['Keep'] [,edit command varname][,'identifier'] [,'stem.'] [,filename] -->
or:
>-- ['Delete' , '*' | first [,'*' | last]] [,'stem.',['searchid']]-->
>-- ) --><--
Help: &lcsme [&helps]
Notes:
1-For a Delete, note that in order to pass a searchid, you must provide
a stem name and Interpret the result. This is a safety measure so that
you can verify the results using SAY the first time and then allow the
delete the second time. The searchid must start with an upper case
drive letter followed by "_". See below.
2-If a stemname is passed when dumping variables, the individual
commands are returned in the stem for you to Interpret or SAY.
*/ /*
Note: This code was written for THE and ooRexx.
If the file being edited is DIR.DIR, then date.time is used
as the filename.
*/ /*
With KEEP you have the possible result of:
X_something.the.0.SDV
X_something.the.1.SDV
etc.
If you use the optional identifier, then you might get
something like:
X_something.the.ident.0.SDV
X_something.the.ident.1.SDV
The optional identifier allows you to more easily
tie the &sme invocation in your code to the file it produces.
You might, for instance, choose to use a line number or a
label as an identifier and call &sme multiple times during a
debugging session.
In order to provide maximum flexibility, when doing a Delete for
such files, the SearchId is allowed to end with either a
period or an asterisk. Thus the following set of files can be
selectively deleted, as needed:
X_something.the.ident1.0.SDV
X_something.the.ident1.1.SDV
X_something.the.ident1.2.SDV
X_something.the.ident2.0.SDV
X_something.the.ident2.1.SDV
X_something.the.ident2.2.SDV
See the example near the end of this prolog.
Of course the usual simple forms of Delete (without SearchId)
continue to work as expected for THE macros.
The Drive Letter prefix is to accomodate the use of different
thumb drive letters on different machines, as they were for me
when I wrote the code!
*/ /*
Examples for THE:
Interpret &lcsme() -- Dumps the variables to a file
-- replacing the previous file.
Interpret &lcsme(,'edit')
Interpret edit -- Dumps the vars and edits the file
-- replacing the previous file.
*/ /*
Interpret &lcsme(,,'identifier') -- Dumps the vars and adds
-- '.identifier' after the original
-- extension, replacing the
-- previous file.
*/ /*
Interpret &lcsme('K') -- Dumps the vars to a new file,
-- keeping the previous file.
Interpret &lcsme('K','edit') -- Dumps the vars to a new file,
Interpret edit -- keeping the previous file and
-- edits the new file.
*/ /*
Interpret &lcsme(,,,'mystem.') -- Sets the elements of MYSTEM.
-- to the commands to Interpret:
do m=1 to mystem.0
interpret mystem.m
end
Interpret &lcsme('K','edit',,'mystem.') -- Similar to above, except
do m=1 to mystem.0 -- a new file is created
interpret mystem.m -- and we can edit it
end -- later.
Interpret edit
*/ /*
Interpret &lcsme('D','*') -- Deletes all the program's SDV files
Interpret &lcsme('D',3,6) -- Deletes generation 3 to 6
Interpret &lcsme('D',3,'*') -- Deletes generation 3 to last
Interpret &lcsme('D','*',,'mystem.') -- Sets the elements of MYSTEM.
-- to the commands to Interpret,
-- perhaps like this:
do m=1 to mystem.0
interpret mystem.m
end
*/ /*
Interpret &lcsme('D','*',,'mystem.',,
'N:\MyTHEstuff\F_testt.the.')
-- Similar to above, but searches
-- in a specific folder for SDV files
-- that belong to a specific program executed from
-- the F drive.
-- SysFileTree is used to do the search.
-- The searchid must end with a period
-- or an asterisk. Asterisk should only
-- be used when it is necessary to match
-- the trailing part of a subset of
-- identifiers. Normally an asterisk
-- is appended to the searchid anyway.
-- Special allowance is made to handle an asterisk
-- for the original filename and/or filetype. This
-- makes cleanup of a cluttered DIR easier.
-- The elements of MYSTEM. are set to
-- the commands to Interpret, just like
-- the previous example.
*/ /*
-- Using Identifiers
-- If you code:
/* Some code */
Interpret &lcsme('K',,'Les')
/* More code */
Interpret &lcsme('K',,'Lee')
-- and run it several times, you might wind up with these files:
C:\MyRexxStuff\testprogram.rex.Les.0.SDV
C:\MyRexxStuff\testprogram.rex.Les.1.SDV
C:\MyRexxStuff\testprogram.rex.Les.2.SDV
C:\MyRexxStuff\testprogram.rex.Les.3.SDV
C:\MyRexxStuff\testprogram.rex.Lee.0.SDV
C:\MyRexxStuff\testprogram.rex.Lee.1.SDV
C:\MyRexxStuff\testprogram.rex.Lee.2.SDV
C:\MyRexxStuff\testprogram.rex.Lee.3.SDV
-- If you then wanted to delete the generation 1 and 2 files you might
-- code:
interpret &lcsme('D',1,2,'mystem.', ,
'C:\MyRexxStuff\C_testprogram.rex.')
-- but you would NOT get the result you want! Instead, just the first 2
-- files found would be deleted, because the code would detect that you
-- wanted to delete just TWO files, i.e. 2-1+1. Instead, you should code
-- something like this:
interpret &lcsme('D',1,2,'mystem.', ,
'C:\MyRexxStuff\C_testprogram.rex.Le*')
do m=1 to mystem.0
interpret mystem.m
end
-- and the shorcut code will be avoided.
-- See testoodumpx.rex and testoodump.the to
-- play around, or create new test cases for yourself.
-- The settings for keywords, minimum abbreviations and flags are
-- just below the 'flags=' statement. Just define your
-- non-conflicting keyword and add the matching label and code near
-- the DUMP: label! Finally, update the Help within the prolog and
-- you're done. This is also an easy way to create a simple test case
-- that demonstrates a bug to send to me.
-- NOTE: If invoked from a .REX program, you will have to tailor
-- EDIT_CMD, START_EDITOR, EDITOR and SAYIT below
-- to suit your editor. If you want THE to display output from .REX
-- programs, take a look at THESTACK.REX and the logic after the
--
lesk?=left(who_am_i,4)='LESK'
--
-- statement. You might find that the easiest way to go.
-- Notice that there are 3 different ways an editor may have
-- to be invoked. That's why there are 3 variables. If you
-- change them, be sure to test your changes! Getting the quotes
-- right under various circumstances can be tricky!
-- I am deeply thankfull to Walter Pachl for his relentless
-- testing that allowed me to adapt this code to his work habits.
-- He also contributed the original EXPANDED_DUMPVARS.REX code that
-- tries to fit the Name column in to a fixed width, And it
-- handles hex! See WIDTH= below to change the column width.
-- Additional thanks to Gil Barmater for the pieces of Object code
-- that replace SysDumpVariables for handling CR & LF. All I did
-- was piece it all together to suit what I needed!
*/
endhelp=thisline()-2
--trace r
width=21 /* Width of Name= column for expanded_oodumpvars. 0=No action */
walter?=Userid()='Walter'
the_installed?=Value('THE_MACRO_PATH',,'ENVIRONMENT')\=''
--the_installed?=0 /* Uncomment this for testing w/o THE */
If walter? Then the_installed?=0
who_am_i=Value('COMPUTERNAME',,'ENVIRONMENT')
lesk?=Left(who_am_i,4)='LESK'
--lesk?=0 /* For my testing */
editor='"start /max notepad"'
If walter? Then editor='"start /max ked"'
If the_installed? Then Do
--race ?r
edit_cmd=' Address THE "THE"' /* When running from THE */
If lesk? Then
start_editor= ,
'"cmd.exe /c start /max c:\the\thec.exe "'
-- start_editor=Word(edit_cmd,2)'stack' /* When not */
-- if lesk? then start_editor='"start THEC"'
Else start_editor='start "c:\the\THE.exe"'
sayit='"emsg"' /* The command for the editor to use for messages */
editor='THE'
End
Else Do
If walter? Then Do
edit_cmd='"start /max ked"' /* Primary cmd to return as edit var */
start_editor='"start /max ked"' /* Secondary, if primary fails */
End
Else Do
edit_cmd='"start /max notepad"' /* Primary cmd to return as edit var */
start_editor='"start /max notepad"' /* Secondary, if primary fails */
End
End
ayit='say'
--exit
--call trace r
Parse Source os how fullme
Parse version whatrexx lang_level build_date
--call trace o
oorexx?=Pos('ooRexx',whatrexx)>0
regina?=Pos('Regina',whatrexx)>0
if regina? then do
msg=fullme 'cannot run with Regina.'
say msg
Return 'say' msg
End
If \oorexx? Then Do
msg=fullme 'requires ooRexx'
Say msg
Return 'say' msg
End
If Pos('WIN',Translate(os))=0 Then Do
msg=fullme 'cannot run under' os'. Sorry!'
Say msg
Return 'say' msg
End
Parse version '-ooRexx_'version'.'release'.'mod'(' .
version_release=version'.'release
stackframes?=version_release>=4.2
Parse Value Reverse(fullme) With tf'.'em '\' path
fn=Reverse(em)
me=fn':'
ft=Reverse(tf)
path=Reverse(path)'\'
fm=Left(path,1)
If Arg()=1 | how='COMMAND' Then Call check_for_help Arg(1)
Parse Value '0 0 0 0 0 0 0' With del? keep? edit? stem? search? the? rex? .
error?=0
Call on Error name Error /* Hide Win errmsg Called from Rexx or THE? */
--trace o
--address THE 'extract' '/fpath/fmode/filename/'
if \walter? then 'extract' '/fpath/fmode/filename/'
from_the?=(error?=0)
from_the?=(rc=0)
from_rex=\from_the?
Signal Off ERROR
--trace o
If Arg()>5 Then Do
err?=1
msg='Too many arguments ('Arg()'). Only five are allowed.'
Signal err
End
/*trace r*/
del?=Translate(Left(Arg(1),1))='D'
dump?=\del?
keep?=Translate(Left(Arg(1),1))='K'
a5=''
If dump? Then Do
If Arg(5,'O') Then Do /* Build default left portion of fileid */
Call resolve_caller
End
Else Do /* Build left portion from args passed */
msg=''
If Arg(5,'E') Then a5=Strip(Arg(5))
Parse Var a5 letter +1 colon +1 backslash +1 .
If Left(a5,2)\='\\' Then Do
letter?=Datatype(letter,'Mixed')
If \letter? Then msg=msg 'First character must be alphabetic.'
colon?=colon=':'
If \colon? Then msg=msg 'Second character must be a colon (:).'
backslash?=backslash='\'
If \backslash? Then msg=msg 'Third character must be a backslash (\).'
End
Else Do /* Check network drive */
If \Datatype(Substr(a5,3,1),'Alphanumeric') Then Do
msg='The name of a networked drive should start with an' ,
'Alphanumeric.'
End
msg=msg 'Network drives are not supported. Sorry!'
End
If msg\='' Then Do
msg=msg 'arg(5) filespec =' a5
Signal err
End
If \sysisfiledirectory(Left(a5,3)) Then Do
err?=1
msg='Drive letter "'Translate(Left(a5,1))'" not mounted.',
'arg(5) filespec =' a5
Signal err
End
If \sysisfile(Arg(5)) Then Do
err?=1
msg='The fileid, arg(5), must include the full path for an existing',
'.rexx or .rex file.'
Signal err
End
left=path||fm'_'fn'.'
/*
left=fpath.1()fmode.1()'_'filename.1()'.'
*/
him=a5
Parse Value Reverse(him) With hisft '.' hisfn '\' hispath
hisfn=Reverse(hisfn)
hisft=Reverse(hisft)
hisfnft=hisfn'.'hisft
If Wordpos(Translate(hisft),'REX REXX')=0 Then Do
err?=1
msg='The fileid, arg(5), must have an extension (filetype) of',
'.rexx or .rex'
Signal err
End
If Pos('_DIR.DIR.',left)>0 Then Do /* Can't use DIR.DIR */
left=dirfileid.1()fmode.1()'_'hisfnft'.'
End
/*
Else left=fpath.1()fmode.1()'_'hisfnft'.'
*/
Else left=path||upper(fm)'_'hisfnft'.'
End
If Arg(3,'E') Then left=left||Arg(3)'.' /* Add identifier */
End
Else Do /* Delete */
If del? & Arg(4,'O') & Arg(5,'E') Then Do
err?=1
msg='A stemname [Arg(4)] must precede "'Arg(5)'"'
Signal err
End
End
--trace r
If Arg(4,'E') Then Do /* Check stem */
stem?=Left(Reverse(Arg(4)),1)='.'
If \stem? Then Do
err?=1
msg='Stemname"'Arg(4)'" must end with "."'
Signal err
End
stemname=Arg(4)
asterisk?=0
If del? Then Do /* Might have a searchid! */
If Arg(5,'E') Then Do /* Looks like we do. Verify it */
searchid=Arg(5)
Parse Var searchid drive'\' rest
If \sysisfiledirectory(drive'\') Then Do
err?=1
msg='"'searchid'" must start with a directory.'
Signal err
End
Parse Upper Value Reverse(searchid) With '\' -3 '_'mode '\' .
hit=Pos(mode,'ABCDEFGHIJKLMNOPQRSTUVWXYZ')
If mode='' | hit=0 Then Do
err?=1
msg='"'searchid'" must contain "fmode_" as a prefix to the fileid.'
Signal err
End
lastchar=Left(Reverse(searchid),1)
asterisk?=lastchar='*'
If Pos(lastchar,'.*')=0 Then Do
err?=1
msg='"'searchid'" must end with "." or "*"'
Signal err
End
If asterisk? Then searchid=Left(searchid,Length(searchid)-1)
/*
If Left(Reverse(searchid),1)\='.' Then Do
err?=1
msg='"'searchid'" must end with "."'
Signal err
End
*/
z=sysfiletree( searchid ||'*','test.','FL')
If z\=0 Then Do
err?=1
msg='SysFileTree yielded Result='z 'for "'searchid'*"'
Signal err
End
If test.0=0 Then Do
err?=1
msg='No files found by SysFileTree("'searchid'*")'
Signal err
End
search?=1
left=searchid
End
End
End
right='.SDV'
exists?=1
str=''
middle=0
If dump? Then Do
If \keep? Then Do
str='Call SysFileDelete "'left||middle||right'";'
End
Else Do /* Find unused N */
-- call trace o
Do n=0 While exists?
exists?=sysisfile(left||n||right)
End
-- call trace r
middle=n-1
End
If Arg(2,'E') Then Do
varname=Arg(2)
If Symbol(varname)='BAD' Then Do
err?=1
msg='"'Arg(2)'" is not a valid variable name'
Signal err
End
edit?=1
End
edit_cmd=edit_cmd '"'left||middle||right'"' /* !!! */
str=str ,
|| 'Call oosysdumpvariables .context~variables ,' ,
'"'left||middle||right'" ,' width
If edit? Then Do
If the_installed? Then Do
If \stem? Then Do
if from_the? then ,
str=str";rc=0;"||varname"='"edit_cmd,
||";" "if rc\=0 then" start_editor '"'left||middle||right'"'''
else str=str";"||varname"='" start_editor '"'left||middle||right'"'''
End
Else Do
str=str";rc=0;"||varname"=''"edit_cmd"'';", --llk /* two single quotes */
"if rc\=0 then" editor '"'left||middle||right'"'
End
End
Else Do /* THE not installed! Use something else :-( */
If \stem? Then Do
str=str||';'varname"='"start_editor '"'left||middle||right'"'''
End
Else Do
str=str||";rc=0;"varname"=''"edit_cmd"'';", /* two single quotes */
"if rc\=0 then" editor '"'left||middle||right'"'
End
/*
msg='Sorry, but I only understand how to start the THE editor'
signal err
*/
End
End
End
Else Do /* Must be Delete */
If Arg(2,'O') Then Do
err?=1
msg='You must specify a second argument with "Delete"'
Signal err
End
first=Arg(2)
first_is_num?=Datatype(first,'Whole')
first_is_all?=first='*'
If \first_is_num? & \first_is_all? Then Do
err?=1
msg='Argument"'first'"must be a number or "*".'
Signal err
End
last?=Arg(3,'E')
If last? Then Do
last=Arg(3)
last_is_num?=Datatype(last,'Whole')
last_is_all?=last='*'
If \last_is_num? & \last_is_all? Then Do
err?=1
msg='Argument"'last'"must be a number or "*".'
Signal err
End
If first_is_num? & last_is_num? Then Do
If last<first Then Do
err?=1
msg='"'first'" must be <= "'last'".'
Signal err
End
End
End
Else Do /* No third arg, LAST */
If \first_is_all? Then Do
err?=1
msg='"'Arg(1)','Arg(2)'" requires a third argument.'
Signal err
End
End
--trace r
del.0=0
If first_is_all? Then first=0 /* I.e '*' starts with 0 */
If Arg(4,'O') & Arg(5,'O') Then , /* We're in THE! */
left=fpath.1()fmode.1()'_'filename.1()'.'
Else left=Arg(5)
ucleft=Translate(left)
x=left ||'*'
x=sysfiletree( left ||'*','files.','FL') /* Add '*' to the end */
If x=0 Then Do /* All went well */
--trace r
Do f=1 To files.0 /* Filter possible files to delete */
Parse Upper Value Translate(Reverse(files.f)) ,
With ext'.'num'.' /* Our files end with .n.SDV */
num=Reverse(num)
ext=Reverse(ext)
id=''
If Pos(left||num'.'ext,files.f)=0 Then Do /* Look for id */
Parse Value files.f With (left) id '.' (num) rest
rest=rest
End
If id\='' Then newleft=left||id'.'
Else Do
hit=Pos('*',left)
If hit>0 Then Do
test=Left(left,hit-1)
trail=num'.SDV'
Parse Value files.f With (test) fid (trail) .
If fid\='' Then newleft=test||fid
Else newleft=left
End
Else newleft=left
End
If Datatype(num,'Whole') & ext='SDV' Then Do
If num>=first Then Do /* We have a candidate! */
If last? Then Do
If last_is_all? Then Do /* Save fileid to delete */
Parse Value del.0+1 newleft||num||right ,
With ix del.ix 1 del.0 .
End
Else Do
If num<=last Then Do
Parse Value del.0+1 newleft||num||right With ix del.ix 1 del.0 .
If first_is_num? & last_is_num? Then Do
If ix=last-first+1 ,
& \asterisk? Then Leave f /* All done! */
End
End
End
End
Else Do
Parse Value del.0+1 newleft||num||right ,
With ix del.ix 1 del.0 .
End
End
End
End
End
str=''
If del.0\=0 Then Do /* Build the delete string */
Do d=1 To del.0
str=str||'Call SysFileDelete "'del.d'";'
End
End
End
--return exit
If stem? Then Do /* Stem desired? */
stem=''
ctr=0
Do While str\='' /* Pick apart the string and put it in stem */
Parse Var str m';'str
ctr=ctr+1
stem=stem||stemname||ctr"='"m"';"
End
stem=stem||stemname'0='ctr /* Set stemname.0 */
str=stem
End
Return str
RESOLVE_CALLER:
If from_the? Then Do
'extract /fpath/fmode/filename/'
the?=rc=0
If rc=0 Then Do
left=fpath.1||fmode.1'_'filename.1'.' /* C:\folder\X_fileid. */
End
Else Do
msg='The command "extract" failed with rc='rc'. Arg(5) is required'
Signal err
End
/*
left=fpath.1()fmode.1()'_'filename.1()'.' /* C:\folder\X_fileid. */
left=path||fm'_'fn'.'
*/
If Pos('_DIR.DIR.',left)>0 Then Do /* Can't use DIR.DIR */
fn=Date('S')
tm=Space(Translate(Time('L'),' _',':.'),0)
left=dirfileid.1()fmode.1()'_'fn'.'tm'.'
End
End
Else Do
If stackframes? Then Do
/*
cmd=,
"caller=.context~stackFrames[.context~stackFrames~items-1]",
"~executable~package~name"
interpret cmd
*/
him=whocalledme()
Parse Value Reverse(him) With hisft '.' hisfn '\' hispath
hisfn=Reverse(hisfn)
hisft=Reverse(hisft)
hisfnft=hisfn'.'hisft
hispath=Reverse(hispath)'\'
hisfm=upper(Left(hispath,1))
left=hispath||hisfm'_'hisfnft'.'
End
Else Do
If oorexx? Then Do
msg='arg(5) is required with ooRexx version' ,
version_release'. Please upgrade to 4.2 or later.'
Signal err
End
Else Do
msg='arg(5) is required.'
Signal err
End
End
End
Return
ERR:
Select
When del? Then Do
msg?=Pos('.THE',Translate(Arg(5)))>0
End
When \del? & \keep? Then Do
msg?=0
End
Otherwise msg?=0
End
If \msg? Then sayit='say'
Else sayit='msg'
Return sayit "'" me msg "'"
Exit
SYSISFILE:
If oorexx? Then Return 'sysisfile'(Arg(1))
Return Word(Stream(Arg(1),'C','FSTAT'),8)='RegularFile'
SYSISFILEDIRECTORY:
If oorexx? Then Return 'sysisfiledirectory'(Arg(1))
Return Word(Stream(Arg(1),'C','FSTAT'),8)='Directory'
CHECK_FOR_HELP:
Call parse_source
Parse Arg args
If how='COMMAND' Then args='?'
Call parse_args
Return
PARSE_SOURCE:
Parse Source whatos how fullme
Parse Value Reverse(fullme) With ext'.' em '\' mypath
me=Translate(Reverse(em))':'
sme=Substr(me,1,Length(me)-1)
lcsme=Lower(sme)
mypath=Reverse(mypath)'\'
logfile=mypath||Lower(sme)'.log'
ext=Translate(Reverse(ext))
the?=ext='THE'
rex?=\the?
Parse version whatrexx rexxlevel rexx_release_date
oorexx?=Pos('ooRexx',whatrexx)>0
regina?=Pos('REGINA',Translate(whatrexx))>0
If regina? Then Do
Call rxfuncadd 'sysloadfuncs', 'rexxutil', 'sysloadfuncs'
Call sysloadfuncs
End
args=''
opts=''
If the? Then Do
c='command'
cn='command nomsg'
m='macro'
End
Return
PARSE_ARGS:
Call init_vars
-- If Words(args)=0 Then call help
wds=Words(args)
ucargs=Translate(args)
Do w=1 To wds
wd=Word(ucargs,w)
ok?=0
Do v=1 To Words(ucvalids)
If Abbrev(Word(ucvalids,v),wd,Word(abbrev,v)) Then Do
ok?=1
Leave v
End
End
If ok? Then Do
z=Word(flags,v) /* Set flags indirectly */
Call value z'.'w,1 /* Set positional flag */
Call value z,1 /* Set arg flag */
ucwd=Word(ucvalids,v)
argix.wd=ucwd
End
Else Do
Call value 'unknown?.'w,1
unknown?=1
unknowns=unknowns wd
End
End
If help? Then Call help
If unknown? & keyword_parms? Then Do /* Allow parms after keywords */
kwdptrs=''
kwds=''
Do u=1 To wds /* Get the kwds in left to right order */
wd=Word(ucargs,u)
If \unknown?.u Then Do /* Found a keyword */
kwdptrs=kwdptrs u
kwds=kwds wd
End
End
kwdctr=Words(kwdptrs)
Do p=1 To kwdctr /* Get the parms for each kwd */
pix=Word(kwdptrs,p) /* Index into args */
If pix+1<wds & p<kwdctr Then Do /* Another kwd later */
piy=Word(kwdptrs,p+1) /* Ptr to next kwd */
If piy\='' Then Do
piy=piy-1 /* Back up to prev word */
pwords=piy-pix /* Number of words between kwds */
End
Else Do
Iterate
End
End
Else Do /* TAILOR TO SUIT! Last keyword */
If pix<wds Then Do /* Something follows it */
-- If Word(ucargs,p)='FILE' Then pwords=wds-pix /* Get all of it */
If Wordpos(Word(ucargs,p),keyword_parms)>0 Then ,
pwords=wds-pix /* Get all of it */
Else pwords=1 /* Just one word */
End
Else pwords=0
End
Do u=pix+1 To pix+pwords /* Reset unknown?. flags */
Call value 'unknown?.'u,0 /* For parms that go with kwds */
End
vname=Word(kwds,p) /* Name of the var */
vname=argix.vname
vval=Subword(args,pix+1,pwords) /* Value of the var */
Call value vname,vval /* Set it */
End
unknowns='' /* Reset */
unknown?=0
Do u=1 To wds /* Accumulate any args that are still unknown */
If unknown?.u Then unknowns=unknowns Word(args,u)
End
End
unknown?=unknowns\=''
-- Call dump
If unknown? Then Call exit 8 'Unknown option(s):' unknowns
Return
INIT_VARS:
valids='? /? -? Help /Help -Help --Help' /* Keywords */
abbrev='1 2 2 1 2 2 3 ' /* Minimum abbreviation */
flags=Copies('Help? ',Words(valids)) /* Flag to set for keyword */
helps=valids
valids=valids 'Keep Delete' --< your keywords
abbrev=abbrev '1 1' --< your abbreviations
flags=flags 'keep? del?' --< your flagnames
flags=flags 'Unknown? Keyword_parms?' /* Always the last ones */
Do f=1 To Words(flags)
v=Word(flags,f)
Call value v'.'f,0 /* Initialize positional flag */
Call value v,0 /* Initialize arg flag */
End
last=Words(helps)
hhelp=''
Do h=1 To last /* Build the Helps line variable */
If h\=last Then hhelp=hhelp || Word(helps,h) '| '
Else hhelp=hhelp||Word(helps,h)
End
helps=hhelp
unknowns=''
unknown?.=0
ucvalids=Translate(valids)
-- msg.0=0
-- keyword_parms?=1
-- keyword_parms='TO FILE PATH'
-- Parse Value '' With file path To
-- msg.0=0
exposes='sme lcsme me msg. c cn m myrc how' ,
'help? mypath log? the? rex? logfile oorexx? regina? fullme'
Return
MSG: Procedure Expose sme me rex? the?
If rex? Then Say me Arg(1)
Else 'msg' me Arg(1)
Return
EMSG: Procedure Expose sme me emsg rex? the?
If rex? Then Say me Arg(1)
Else 'emsg' me Arg(1)
Return
NEXT:
Parse Arg !stem,!val
If \Datatype(Value(!stem'.0'),'W') Then Call value !stem'.0',0
!ix=Value(!stem'.0')+1
Call value !stem'.0',!ix
Call value !stem'.'||!ix ,!val
Return
THISLINE:
Return sigl
HELP:
--/*
outvar=beghelp endhelp fullme
call showit fullme ,, outvar ,
,'&lcsme='lcsme , '&sme='sme , '&this file.='fullme ,
,'&helps='helps
Call exit
--*/
alph='abcdefghigklmnopqrstuvwxyz'
search4this_file?=1
search4sayit_below?=0
Do h=beghelp To endhelp
data=Sourceline(h)
If search4this_file? Then Do
If Right(data,10)='this file.' Then Do
data=Changestr('this file',data,'&fullme')
search4this_file?=0
search4sayit_below?=1
End
End
If search4sayit_below? Then Do
If Pos('SAYIT below',data)>0 Then Do
data=Changestr('SAYIT below',data,'SAYIT in &fullme')
search4sayit_below?=0
End
End
hit=Pos('&',data)
line=''
If hit>0 Then Do
left=Substr(data,1,hit-1)
data=Substr(data,hit)
vline=''
Do While data\='' & Pos('&',data)>0
-- Parse Var data lead '&' +1 wd data
Parse Var data lead '&' +1 data
vline=vline||lead
lead=''
nonalph=Verify(data,alph,'Nomatch')
If nonalph>0 Then Do
Parse Var data wd =(nonalph) data
End
Else Do
Parse Var data wd data
End
If Symbol(wd)\='BAD' Then Do
If Symbol(wd)='VAR' Then Do
/*
If Left(data,1)=' ' Then ,
vline=vline Value(wd)
Else vline=vline || Value(wd)
*/
vline=vline || Value(wd)
End
Else Do /* Might end in punctuation */
Parse Value Reverse(wd) With punct 2 rest
rest=Reverse(rest)
If Datatype(rest,'S') & Symbol(rest)='VAR' Then Do
vline=vline lead||Value(rest)||punct
End
-- Else vline=vline lead'&'wd data
Else vline=vline lead'&'rest||punct
End
End
--/*
Else Do /* It might be bad because of punctuation */
Parse Value Reverse(wd) With punct 2 rest
rest=Reverse(rest)
If Datatype(rest,'S') & Symbol(rest)='VAR' Then Do
vline=vline lead||Value(rest)||punct
End
Else Do
vline=vline lead'&'data
data=' '
End
End
--*/
End
If data\='' Then vline=vline||lead||data
line=left||Space(vline)
End
Else line=data /* No & in the line */
Call next 'help',line
End
helpfile=fullme'_help.txt'
Call stream helpfile, 'C', 'OPEN WRITE REPLACE'
Do l=1 To help.0
Call lineout helpfile,help.l
End
Call stream helpfile, 'C', 'CLOSE'
-- ADDRESS CMD 'start /max NOTEPAD "'helpfile'"'
Address CMD strip(start_editor,,'"') '"'helpfile'"'
Call exit
Return
EXIT: Procedure Expose sme me sigl msg emsg rex? the?
Parse Arg myrc mymsg
mysigl=sigl
If myrc='' Then myrc=0
If myrc\=0 & mymsg\='' Then Do
Call emsg mymsg
Call msg 'Enter' sme 'HELP for help'
Call emsg 'Rc='myrc
End
Else If myrc=0 & mymsg\='' Then Call msg mymsg
If myrc\=0 Then Call msg 'Exit called from line' mysigl
Exit myrc
LOGIT: Procedure Expose (exposes) sigl
--trace r
mysigl=sigl
Parse Arg logargs
If logargs='' Then logargs=Sourceline(mysigl+1)
Parse Value Right(Space(Date(),0),9,0) Time('L') With ds ts
logline=ds ts logargs
If Arg(2,'E') & Arg(2)\='' Then Do
Parse Value Arg(2) With his_sigl him
logline=logline '>' him '@' his_sigl
End
logfile=mypath||Lower(sme)'.log'
If oorexx? Then Do
-- .stream~new(logfile)~~lineout(logline)~close
writeline='.stream~new("'logfile'")~~lineout("'logline'")~close'
Interpret writeline
End
Else Do
Call stream logfile, 'C', 'OPEN WRITE APPEND'
Call lineout logfile,logline
Call stream logfile,'C', 'CLOSE'
End
Return
ERROR:
--trace r
/*
If rc\=69 Then Do
Say me 'Oops! It appears that EXTRACT.REX wasn''t intalled along'
Say me 'with' fullme'. Please do so and retry.'
End
*/
--say trapped error 'RC='rc
error?=1
Return
/* --- End of skeleton code --- Put subroutines below: */
/* Notice:
This program is free software: you can redistribute it and/or modify
it under the terms of the EPL (Eclipse Public License) as published by
the Open Source Initiative, either version 1.0 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
EPL for more details.
You should have received a copy of the EPL along with this program.
If not, see:
http://www.opensource.org/licenses/eclipse-1.0.php
*/
::requires whocalledme.cls