/* MAILABLE EXEC -- See HELP at bottom (or issue MAILABLE ?)
   Copyright (c) Phil Smith III, 1995-2000.
   May be redistributed freely with this copyright message intact.
*/
/* Version history:
   1.00 -- Primitive version
   2.00 -- June 16, 1995 -- Rewritten, smarter (original dates, etc.)
   2.01 -- July 11, 1995 -- Eliminate OR bars and NOT signs
   2.02 -- September 5, 1995 -- Handle RECFM F output files properly
   2.03 -- September 15, 1995 -- Fmode problem with previous update
   2.04 -- October 3, 1995 -- Fileid conflicts with 2.02 update
   2.05 -- May 1, 1997 -- Handle even more restrictive line lengths
   3.00 -- June 1, 1997 -- Handle multiple files, using VMFPLCD
   3.01 -- Sept 24, 1998 -- Fix some nits, handle non-SHORTDATE
   3.10 -- Sept 28, 1998 -- Shorten lines (avoid probs with mailers)
   3.11 -- November 30 1998 -- Drop blank lines (more mailer problems)
   3.12 -- November 8 1999 -- Improve warnings when file already exists
   4.00 -- January 2000 -- Make self-extracting MAILABLEs
   4.10 -- June 2002 -- Add FILELIST, README options; avoid use of "@"
   4.11 -- August 2002 -- Improve some error handling; PACK the VMFPLCD
   4.12 -- August 2002 -- Handle different output blocksize better
   4.13 -- September 2002 -- Remove any use of OR bar
   4.14 -- September 2002 -- Fix problem with datestamps
   4.15 -- October 31, 2002 -- Fix syntax error on bad command
 
The characters to avoid are:
    and  &  X'50'
    or   |  X'4F'
    not  ^  X'5F'
    cent "  X'4A'
*/
 
   address command        /* Make sure this is first line of EXEC!!! */
   signal on NoValue                                      /* Hygiene */
   signal on Syntax                                       /* Hygiene */
 
   version = '4.15'                       /* Version of this program */
   vdate   = 'October 31, 2002'              /* Date of this version */
 
   pipecmd = 'PIPE'                 /* Default to PIPE, not PIPEDEMO */
   replace = 0                           /* Don't replace by default */
   quiet = 0                            /* Don't be quiet by default */
   stack = 0                               /* Don't stack by default */
   filelist = 0                     /* Input not filelist by default */
   doreadme = 1                 /* Do README if specified by default */
   if symbol('README') <> 'VAR' then   /* If this isn't set yet... */
   readme = ''      /* ...then clear it (may be set in EXTRACT mode) */
 
   'EXECSTAT VMFPLCD EXEC'
   if rc > 4 then signal NoPLCD
 
   parse source . . ename etype emode .              /* Get our info */
   if emode = '*' then signal Loaded
   parse version rexxversion .
   if rexxversion <> 'REXX370' then signal Compiled
 
   if symbol('FUNCTION') = 'VAR' then do    /* Set if self-extractor */
      parse value ename etype emode with ifn ift ifm ofn oft
      arg rc ofm extra '(' options ')'
      if rc <> '' then function = rc    /* Overrode default function */
      if abbrev('EXTRACT', function, 2) then function = 'UNDO'
   end
   else do
      function = 'MAKE'
      arg ifn ift ifm ofn oft ofm extra '(' options ')'
      if ift = '' then signal Help
      if ifn = '?' then signal Help
   end
   if function = '?' then signal Help
 
   if extra <> '' then signal Extra
 
   if ifm = '' then ifm = 'A'
   if ofn = '=' then ofn = ''
   if oft = '=' then oft = ''
   if ofm = '=' then ofm = ''
   if (ofn oft ofm) = (ifn ift ifm) then signal Same
 
   'ESTATE' ifn ift ifm                    /* Input file even exist? */
   if rc <> 0 then signal BadFile                  /* Nope, bad news */
 
   'PIPE (name MailableQCMSLvl stagesep +)' ,
     'command QUERY CMSLEVEL +' ,
     'specs w3 1 +' ,
     'specs ws , w1 1 +' ,
     'var dateformat'
   if datatype(dateformat, 'W') & dateformat > 12 then
   dateformat = 'SHORTDATE' /* Recipient might not have DATEFORMAT */
   else dateformat = ''
 
   do while options <> ''
      parse var options option options
      select
         when abbrev('UNMAILABLE', option, 2) then function = 'UNDO'
         when abbrev('EXTRACT', option, 2) then function = 'UNDO'
         when abbrev('MAILABLE', option, 2) then function = 'MAKE'
         when abbrev('LISTFILES', option, 1) then function = 'LIST'
         when abbrev('REPLACE', option, 3) then replace = 1
         when abbrev('NOREPLACE', option, 5) then replace = 0
         when abbrev('QUIET', option, 3) then quiet = 1
         when abbrev('STACK', option, 3) then stack = 1
         when abbrev('DEBUG', option, 3) then pipecmd = 'EXEC PIPEDEMO'
         when abbrev('NODEBUG', option, 5) then pipecmd = 'PIPE'
         when abbrev('FILELIST', option, 5) then filelist = 1
         when abbrev('NOREADME', option, 6) then doreadme = 0
         when abbrev('README', option, 4) then do
            parse var options readme rc options
            if rc = '' then rc = 'FILE'
            readme = readme rc
         end
         otherwise
         signal BadOption
      end
   end
   if function <> 'MAKE' & filelist then signal BadOption
 
   multiple = translate(ifn ift, '  ', '*%') <> (ifn ift)  /* Multi? */
   if multiple & function <> 'MAKE' then signal Multiple    /* Error */
   if wordpos(function, 'MAKE UNDO') = 0 then signal Listfiles
 
   ofnx = ofn                   /* Save output filename as specified */
   oftx = oft                   /* Save output filetype as specified */
   ofmx = ofm                   /* Save output filemode as specified */
   if ofn = '' then do                   /* If no output fn, default */
      if translate(ifn, '  ', '%*') <> ifn then ofn = 'MAILABLE'
      else ofn = ifn                   /* No wildcards, use input fn */
   end
   if oft = '' then select     /* No output ft, default per function */
      when function = 'MAKE' then oft = 'MAILABLE'      /* If making */
      otherwise oft = 'CMSUT1'               /* If unmaking MAILable */
   end
 
   if pipecmd = 'EXEC PIPEDEMO' then do                  /* If DEBUG */
      'EXECSTAT PIPEDEMO EXEC'     /* Make sure PIPEDEMO EXEC exists */
      if rc > 4 then signal NoDebug            /* If not, error time */
   end
 
   'CMDCALL VALIDATE' ofn oft ofm      /* Validate the output fileid */
   if rc <> 0 then exit rc                    /* No good, error time */
 
   'ESTATE * *' ofm                      /* See if output disk empty */
   if rc <> 28 then do        /* If disk not empty, check R/W status */
      'ESTATEW * *' ofm                    /* See if output disk R/W */
      if rc = 28 then signal NotRW                 /* Not R/W, error */
   end
 
   'PIPE (name MailableQWorkFM stagesep + endchar ?)' ,
     'command QUERY DISK R/W +' ,                  /* List R/W disks */
     'drop 1 +' ,                                 /* Lose the header */
     'specs 13.1 1 +' ,                    /* Just get the filemodes */
     'find: strfind <'left(ifm, 1)'< +' ,   /* Look for specified FM */
     'rejoin: faninany +' ,             /* Bring back in other modes */
     'take 1 +' ,   /* Take whatever the first one is (IFM or other) */
     'var wfm' ,                                      /* And save it */
     '?' ,
     'find: +' ,                            /* All but IFM come here */
     'rejoin:'                  /* And go back in, perhaps after IFM */
   if symbol('WFM') <> 'VAR' then signal NoRW
   if ofm = '' then ofm = wfm    /* If no output fm, default to work */
 
   if function = 'MAKE' & filelist then
   'PIPE (name MailableFList stagesep + endchar ?)' ,
     '+ <' ifn ift ifm ,
     '+ strnfind <*<' ,
     '+ locate 1' ,
     '+ change /&1//' ,
     '+ change /&2//' ,
     '+ dup: fanout' ,
     '+ specs <LISTFILE< 1 w1-3 nw <(NOHEADER DATE' dateformat'< nw' ,
     '+ cms' ,
     '+ specs w1-4 1 w5 nw.6 right w6 nw.6 right w7 nw.7 right' ,
     '  w8 nw.8 right w9 nw.8 right +' ,
     'nlocate 1.19 <MAILABLE CMSUT1  ' left(ofm, 1)'< +' ,
     'nlocate 1.19 <MAILABLE CMSUT2  ' left(wfm, 1)'< +' ,
     'nlocate 1.19 <'left(ofn, 8) left(oft, 8) left(ofm, 1)'< +' ,
     'stem file.' ,                           /* Save entire fileids */
     '?' ,
     'dup:' ,
     '+ stem in.'
   else
   'PIPE (name MailableListIn stagesep +)' ,
     'command LISTFILE' ifn ift ifm '(NOHEADER DATE' dateformat '+' ,
     'specs w1-4 1 w5 nw.6 right w6 nw.6 right w7 nw.7 right' ,
     '  w8 nw.8 right w9 nw.8 right +' ,
     'nlocate 1.19 <MAILABLE CMSUT1  ' left(ofm, 1)'< +' ,
     'nlocate 1.19 <MAILABLE CMSUT2  ' left(wfm, 1)'< +' ,
     'nlocate 1.19 <'left(ofn, 8) left(oft, 8) left(ofm, 1)'< +' ,
     'stem file.'                             /* Save entire fileids */
   if rc <> 0 then signal BadFile
   if file.0 = 0 then signal BadFile
 
   pfile = ifn ift ifm           /* Remember input fileid for piping */
 
   if function = 'MAKE' then do
      'ESTATEW' ofn oft ofm      /* See if the output already exists */
      if rc = 0 & replace = 0 then signal Already /* Error if no REP */
      'ERASE MAILABLE CMSUT2' wfm
      'ERASE' ofn oft ofm
      'EXEC VMFPLCD RST ENV= MAILABLE CMSUT2' wfm           /* Reset */
      if rc <> 0 then signal BadPLCD
      'PIPE (name MailablePlDump stagesep +)' ,
        'stem file. +' ,
        'specs <EXEC VMFPLCD DUMP< 1 w1-3 nw +' ,
        'command +' ,
        'stem dump.'
      if rc <> 0 then signal BadPLCD
 
      pfile = 'MAILABLE CMSUT2' wfm      /* Remember that for piping */
      'PIPE (name MailableMakeLM stagesep +)' ,
        'stem dump. +' ,
        'specs <LISTFILE< 1 w1-3 nw' ,
        '  <(NOHEADER DATE' dateformat'< nw +' ,
        'command +' ,
        'specs w1-4 1 w5 nw.6 right w6 nw.6 right w7 nw.7 right' ,
        '  w8 nw.8 right w9 nw.8 right +' ,
        'stem dump.'
   end
 
   versionheader = copies('-', 8)'M-A-I-L-A-B-L-E--'version'--'vdate
   versionheader = left(versionheader, 64, '-')      /* Finish it up */
 
   hdr.1 = versionheader
   hdr.2 = 'This file was created by MAILABLE EXEC version' version
   hdr.3 = ' '
   hdr.4 = 'If file was sent in pieces, collect all pieces in a single'
   hdr.5 = ' file. Then RENAME the file to filetype EXEC and run it to'
   hdr.6 = ' extract the' file.0 'encoded files.  Other than the EXEC'
   hdr.7 = ' code, the order of the pieces does NOT matter.'
   hdr.8 = ' '
   hdr.9 = 'If this is a DB service bucket, use DBUPDATE to install it.'
   hdr.10 = ' '
   hdr.11 = 'Original file information from LISTFILE:'
   hdr.12 = copies('-', 64)
   do i = 13 for file.0
      hdr.i = '>>'value('FILE.'i-12)
   end
   hdr.i = copies('--* ', 16)
   hdr.0 = i          /* And that's the count of header lines, folks */
 
   tlr.0 = 4
   tlr.1 = copies('**- ', 16)
   tlr.2 = 'End of' ofn oft
   tlr.3 = 'Do NOT remove these trailer lines before undoing it!'
   tlr.4 = copies('*- ', 21)'-'
 
   autox = copies('60', 10)
   autox = '615c'autox'5CA295899740888599855C'autox'5C61'
   makemagic = '615C5C6186A49583A38996957E7DD3C9E2E37D'
   if function = 'MAKE' & readme <> '' then do      /* Do README ... */
      'PIPE (name MailableQReadme stagesep +)' ,
        '+ stem dump.' ,
        '+ spec w1 1 w2 nw' ,
        '+ pick 1-* == <'readme'<' ,
        '+ count lines' ,
        '+ var found'
      if found = 0 then signal NoReadme
      makemagic = makemagic''c2x(';readme='readme)         /* Add it */
   end
 
   cmd.make = '(endchar ? stagesep + name Mailable)' ,
     '<' ename 'EXEC * +' ,
     'header: frtarget locate <address command< +' ,
     'split before string x615C +' ,
     'strnfind x615C +' ,
     'normal: strfind x5C61 +' ,
     'nlocate x5C61 +' ,
     'preface strliteral x'autox '+' ,
     'rejoin: faninany +' ,
     'strip +' ,
     'locate 1 +' ,
     'data: fanin +' ,
     '> MAILABLE CMSUT1' left(ofm, 1),
     '?' ,
     'normal: +' ,
     'rejoin:' ,
     '?' ,
     'header: +' ,
     'preface strliteral x'makemagic '+' ,
     'rejoin:' ,
     '?' ,
     '<' pfile '+' ,
     'pack +' ,             /* PACK the mailable before hexifying it */
     'specs 1-* c2x 1 +' ,
     'block 64 string <??< +' ,
     'preface stem hdr. +' ,                      /* Get header info */
     'append stem tlr. +' ,                  /* And the trailer info */
     'specs <==< 1 recno 3.8 1-* 12 +' , /* Add linebreak indicators */
     'change 3.8 / /0/ +' ,      /* Change blanks in recno to zeroes */
     'preface strliteral x615c +' ,  /* Leading comment start please */
     'append strliteral x5c61 +' ,    /* Trailing comment end please */
     'data:'
 
   cmd.undo = '(stagesep + endchar ? name UnMailable)',
     '<' pfile '+' ,
     'frtarget locate <'copies('-', 8)'M-A-I-L-A-B-L-E--< +' ,
     'fstart: fanout +' ,    /* Send away to verify that start found */
     'strip +' ,
     'specs 1-* 1 / / n +' , /* Make sure trailing blank for deblock */
     'deblock string <==< +' ,       /* Undo any damage from mailers */
     'strip +' ,
     'buffer +' ,
     'sort 1-8 +' ,                             /* Reorder the lines */
     'specs 10-* 1 +' ,                 /* And lose the line numbers */
     'a: inside /'copies('--* ', 10)'/ /'copies('**- ', 10)'/ +' ,
     'fbody: fanout +' ,      /* Send away to verify that body found */
     'deblock string <??< +' ,        /* Recover original linebreaks */
     'specs 1-* x2c 1 +' ,                 /* Convert back to EBCDIC */
     'unpack +' ,              /* UNPACK the mailable as appropriate */
     '> MAILABLE CMSUT1' left(ofm, 1),     /* Write VMFPLCD file out */
     '?',
     'a: +' ,           /* Envelope (headers and trailers) come here */
     'fenv: fanout +' ,   /* Send away to verify that envelope found */
     'b: strfind <>>< +' ,                     /* Extract file lines */
     'ffiles: fanout +' ,    /* Send away to verify that files found */
     'specs 3-* 1 +' ,
     'stem file.',
     '?',
     'b: +' ,
     'c: strfind <'copies('-', 8)'M-A-I-L-A-B-L-E--< +' ,
     'take 1 +' ,
     'specs 26-* 1 +' ,
     'var oversion' ,
     '?',
     'c: +' ,                  /* Come here to look for trailer line */
     'strfind <'copies('*- ', 10)'< +' ,
     'count lines +' ,
     'var tlr' ,               /* Remember whether we got any or not */
     '?',
     'fstart: +' ,
     'count lines +' ,
     'var fstart' ,
     '?',
     'fbody: +' ,
     'count lines +' ,
     'var fbody' ,
     '?',
     'fenv: +' ,
     'count lines +' ,
     'var fenv' ,
     '?',
     'ffiles: +' ,
     'count lines +' ,
     'var ffiles'
 
   'ERASE MAILABLE CMSUT1' ofm     /* Delete any possible old output */
 
   pipecmd cmd.function                       /* Do the PIPE command */
   if rc <> 0 then signal Badpipe                            /* Ouch */
 
   if function = 'UNDO' then do
      if symbol('OVERSION') <> 'VAR' then signal NoVersion
      if tlr = 0 then signal NoTrailer
      oversion = translate(oversion, ' ', '-')
      parse var oversion oversion ovdate
      if oversion < oversion then signal OldVersion
      ovdate = strip(ovdate)
      if (version vdate) <> (oversion ovdate) then do
         say '** Warning! ** Mailable created with MAILABLE',
           'version' oversion 'dated' ovdate';'
         say '               You are using version' version 'dated',
           vdate'.'
         say '               An output file was created, but may be',
           'incorrect.'
      end
      if symbol('FSTART') <> 'VAR' then signal NoStart
      if symbol('FBODY') <> 'VAR' then signal NoBody
      if symbol('FENV') <> 'VAR' then signal NoEnv
      if symbol('FFILES') <> 'VAR' then signal NoFiles
   end
 
   'ESTATEW MAILABLE CMSUT1' ofm
   if rc <> 0 then signal Nofile
 
   if function = 'MAKE' then do
      'RENAME MAILABLE CMSUT1' ofm ofn oft ofm
      if rc <> 0 then signal BadRename
      'ERASE' pfile                                 /* PLCD envelope */
      if quiet = 0 then do
         if filelist then
         say file.0 'files listed in' ifn ift ifm ,
           'made MAILable as self-extracting MAILABLE' ofn oft ofm'.'
         else say file.0 'files matching' ifn ift ifm ,
           'made MAILable as self-extracting MAILABLE' ofn oft ofm'.'
         say 'Rename this to filetype EXEC and run it for a file' ,
           'list and instructions.'
      end
   end
   else do
      if replace = 0 then do i = 1 to file.0
         'ESTATE' subword(file.i, 1, 2) ofm
         if rc = 0 then signal Already
      end
      'EXEC VMFPLCD RST ENV= MAILABLE CMSUT1' left(ofm, 1)
      if rc <> 0 then signal BadPLCD
      'EXEC VMFPLCD LOAD * *' left(ofm, 1) '(NOPRINT'
      if rc <> 0 then signal BadPLCD
      'ERASE MAILABLE CMSUT1' ofm
      'PIPE (name MailableUndoLM stagesep +)' ,
        'stem file. +' ,
        'specs <LISTFILE< 1 w1-2 nw <'left(ofm, 1)'< nw' ,
        '  <(NOHEADER DATE' dateformat'< nw +' ,
        'command +' ,
        'specs w1-4 1 w5 nw.6 right w6 nw.6 right w7 nw.7 right' ,
        '  w8 nw.8 right w9 nw.8 right +' ,
        'stem dump.'
      'PIPE (name MailableVerifyF stagesep + endchar ?)' ,
        'stem file. +' ,                    /* Get the list we built */
        'specs w3 1 w7 nw w1-2 nw w4-6 nw w8-* nw +' ,  /* Rearrange */
        'l: lookup w3-* w3-* master +' ,   /* Compare the file lists */
        'specs w3-4 1 w1 19 w5-7 nw w2 nw.7 right w8-* nw +' ,
        'stem file.' , /* Write back -- block count might be changed */
        '?' ,
        'stem dump. +' ,              /* Get VMFPLCD's list of files */
        'specs w3 1 w7 nw w1-2 nw w4-6 nw w8-* nw +' ,  /* Rearrange */
        'l: +' ,                                /* Send it to LOOKUP */
        'specs w3-4 1 w1 19 w5-7 nw w2 nw.7 right w8-* nw +' ,
        'stem filex.' ,   /* Unmatched files from LISTFILE come here */
        '?' ,
        'l: +' ,
        'specs w3-4 1 w1 19 w5-7 nw w2 nw.7 right w8-* nw +' ,
        'stem dumpx.'      /* Unmatched files from VMFPLCD come here */
      if filex.0 > 0 then signal Different             /* Two IFs... */
      if dumpx.0 > 0 then signal Different        /* ...avoid OR bar */
      if quiet = 0 then do
         say file.0 'file(s) extracted from' ,
           ifn ift ifm 'to disk' left(ofm, 1)':'
         say 'Filename Filetype Fm' ,
           'Format Lrecl Recs  Blocks Date    Time'
         do i = 1 to file.0
            say overlay(left(ofm, 1), file.i, 19)
         end
      end
      if stack then do i = 1 to file.0
         push overlay(left(ofm, 1), file.i, 19)
      end
      if readme <> '' & doreadme then do
         say ''
         say 'Displaying "'readme'" as specified by README option...'
         'PIPE (name MailableReadme stagesep +)' ,
           '+ <' readme ofm ,
           '+ console'
         say ''
         say 'To display this information again, enter "TYPE' ,
           readme ofm'"'
      end
   end
   exit
ListFiles:
   pipecmd '(stagesep + endchar ? name UnMailable)',
     '<' ifn ift ifm '+' ,
     'frtarget locate <'copies('-', 8)'M-A-I-L-A-B-L-E--< +' ,
     'fstart: fanout +' ,    /* Send away to verify that start found */
     'strip +' ,
     'specs 1-* 1 / / n +' , /* Make sure trailing blank for deblock */
     'deblock string <==< +' ,       /* Undo any damage from mailers */
     'strip +' ,
     'buffer +' ,
     'sort 1-8 +' ,                             /* Reorder the lines */
     'specs 10-* 1 +' ,                 /* And lose the line numbers */
     'strtolab /'copies('--* ', 10)'/ +' ,
     'strfind <>>< +' ,                     /* Extract file lines */
     'specs 3-* 1 +' ,
     'stem file.'
   if rc <> 0 then signal BadPipe
 
   if file.0 = 0 then signal NoList
 
   if quiet = 0 then do
   say ifn ift ifm 'contains' file.0 'file(s):'
   say 'Filename Filetype Fm Format Lrecl Recs  Blocks Date    Time'
   do i=1 to file.0
     say file.i
   end
   say ''
   say 'Issue "'ifn 'EXTRACT"    to extract to the A-disk; issue'
   say '      "'ifn 'EXTRACT fm" to extract to the "fm" disk.'
   end
   if stack then do i=1 to file.0
     push file.i
   end
   exit
NoReadme:
   say 'File "'readme'" specified as README but not included in' ,
     'files to be dumped.'
   exit 28
NoList:
   say 'No files found -- file may not be a MAILABLE, or may be' ,
     'damaged.'
   exit 100
NoFile:
   say 'Return code 0 from PIPE command, but no output file found!'
   exit 100
NoPLCD:
   say 'VMFPLCD EXEC does not exist. This IBM utility is usually on' ,
     'the S-disk.'
   exit rc
BadPLCD:
   say 'Error' rc 'from VMFPLCD EXEC.'
   exit rc
Multiple:
   say 'Wildcards invalid on input for unMAILABLE call.'
   exit 32
BadRename:
   if function = 'MAKE' then
   say 'Error' rc 'from RENAME MAILABLE CMSUT1' ofm ofn oft ofm
   else say 'Error' rc 'from RENAME MAILABLE CMSUT1' ofm ofnx oftx ofmx
   exit rc
BadRewrite:
   say 'Error' rc 'converting output file to RECFM F from RECFM V.'
   exit rc
BadFile:
   select
      when filelist then do
         r = rc
         'PIPE (name MailableBadFL stagesep +)' ,
           '+ stem file.' ,
           '+ specs recno 1 w4 12 1-* 200' ,
           '+ pick 13.1 ^== / /' ,
           '+ specs w1 1 200-* 12' ,
           '+ stem file.'
         do i = 1 to file.0
            parse var file.i n file.i
            say 'Error processing file "'space(in.n)'":' strip(file.i)
         end
         rc = r
      end
      when rc <> 28 then exit rc           /* Message already issued */
      otherwise say 'Input file "'ifn ift ifm'" does not exist.'
   end
   exit rc
Already:
   if function = 'MAKE' then file.i = ofn oft ofm
   else file.i = space(subword(file.i, 1, 2)) ofm
   say 'Output file "'file.i'" already exists -- specify REPlace.'
   exit 28
NotRW:
   say 'Output filemode' substr(ofm, 1, 1) 'not accessed R/W.'
   exit rc
NoRW:
   say 'No R/W disks accessed.'
   exit 36
BadPipe:
   say 'Error' rc 'from "PIPE command.'
   exit rc
NoDebug:
   say 'DEBUG option not valid, PIPEDEMO EXEC not found.'
   exit 28
Same:
   say 'Input and output files may not be the same.'
   exit 28
Different:
   say 'Input and output file list or attributes do not match!' ,
     'Contact support.'
   if filex.0 > 0 then say 'Unmatched input files:'
   do i = 1 to filex.0
      say filex.i
   end
   if dumpx.0 > 0 then say 'Unmatched output files:'
   do i = 1 to dumpx.0
      say dumpx.i
   end
   exit 1
Loaded:
   say ename 'cannot be invoked as an EXECLOADed or DCSS-resident' ,
     'program because'
   say 'it requires access to program source.'
   exit 100
Compiled:
   say ename 'cannot be invoked as a compiled REXX program because' ,
     'it requires'
   say 'access to program source.'
   exit 100
Extra:
   say 'Invalid parameter "'extra'".'
   exit 24
NoBody:
   say 'Error -- MAILABLE body not found. File may be MIME-encoded.'
   exit 99
NoEnv:
   say 'Error -- MAILABLE envelope not found. File may be MIME-encoded.'
   exit 99
NoFiles:
   say 'Error -- MAILABLE input file list not found.' ,
     'File may be MIME-encoded.'
   exit 99
NoStart:
   say 'Error -- MAILABLE start indicator not found.' ,
     'File may be MIME-encoded.'
   exit 99
NoTrailer:
   say 'Error -- MAILABLE trailer record not found.' ,
     'File truncated; no files extracted.'
   exit 99
NoVersion:
   say 'Error -- MAILABLE version record not found.' ,
     'File may be MIME-encoded.'
   exit 99
BadOption:
   say 'Invalid option "'option'"'
   exit 24
OldVersion:
   say 'Error -- file was encoded using MAILABLE version'
   oversion 'dated' ovdate';'
   say 'This version of MAILABLE cannot decode these old files.'
   exit 99
Syntax:
   signal off syntax
   badline = sigl
   sourcel = GetSourceLine(badline)
   msg = 'SYNTAX ERROR' rc':' errortext(rc)
   signal DebugLoop
NoValue:
   signal off NoValue
   badline = sigl
   varname = condition('D')
   sourcel = GetSourceLine(badline)
   msg = 'NOVALUE of "'varname'"'
   signal DebugLoop
DebugLoop:
   say msg; say 'Line' badline':' sourcel
   say 'SLEEPing, hit ENTER to continue'
   address command 'CP SLEEP'
   say msg; say sourcel
   say 'Entering interactive trace, type EXIT to end'
   trace ?r; do forever; nop; end
   exit 20040
 
GetSourceLine:
   arg l
   line = ''
   do forever
      temp = sourceline(l)
      line = line temp
      if right(strip(temp), 2) = '5C61'x then
      if index(temp, '615C'x) > 0 then
      parse var temp temp '615C'x
      if right(strip(temp), 1) <> ',' then return line
      l = l + 1
   end
Help:
   say 'MAILABLE Version' version '('vdate')'
   say ''
   say 'MAILABLE converts a file to/from a format suitable for',
     'sending in email.'
   say ''
   say 'Format is: ' ,
     'MAILABLE ifn ift <ifm <ofn <oft <ofm>>>> <( <options> <)> >'
   say ''
   say 'where: ifn ift ifm -- Input filespec;',
     'default fm = A'
   say '       ofn oft ofm -- Output fileid (only ofm used',
     'if UNMAILABLEing)'
   say 'Default for output when making MAILABLE is',
     '"fn MAILABLE fm"; when undoing'
   say 'a MAILABLE, the fileids are always as sent.'
   say ''
   say 'Options are:'
   say ' Listfiles   -- List files bundled in a MAILable (default' ,
     'for self-extractors)'
   say ' UNmailable  -- Undo effects of making file MAILable'
   say ' EXtract     -- Same as UNMAILABLE'
   say ' MAilable    -- (Usual default, see below) Make file MAILable'
   say ' REPlace     -- Replace any existing output file'
   say ' NOREPlace   -- (Default) Do not replace existing output file'
   say ' DEBug       -- Use PIPEDEMO to show execution'
   say ' NODEBug     -- (Default) Use PIPEs (no PIPEDEMO)'
   say ' QUIET       -- Suppress informational messages'
   say ' STACK       -- Stack fileids on EXTRACT, UNMAILABLE, or LIST'
   say ' FILEList    -- Input is a file containing fileids, not a' ,
     'file specification'
   say ' READme fn ft -- Specify a file (which must be part of the' ,
     'MAILABLE) to be'
   say '                displayed after an EXTRACT as a guide for' ,
     'the recipient. This'
   say '                file is plain text.  Fname is required;' ,
     'ftype default=FILE;'
   say '                fmode=EXTRACT disk and thus' ,
     'may not be specified.'
   say ' NOREADme    -- Suppress display of any README information'
   say ''
   say 'An input file specification can use LISTFILE-style wildcards' ,
     'to indicate'
   say 'that multiple files are to be dumped.  With the FILELIST' ,
     'option, the'
   say 'input is a list of files; this can be in CMS EXEC format' ,
     '(with &1 &2'
   say 'preceding each fileid), or just bare fileids; comments ("*")' ,
     'are allowed.'
   say ''
   say 'To undo a MAILABLE, save the mail message in a disk file and' ,
     'issue:'
   say '"MAILABLE fn ft fm (UNMAILABLE" against that file.'
   say ''
   say 'Alternatively, just strip headers/trailers and name the file' ,
     'with a filetype'
   say 'of EXEC and invoke it to undo the files.'
   say ''
   say 'If a MAILABLE file is sent in several MAIL files, they' ,
     'can be collected'
   say 'in a single disk file and MAILABLE will reassemble the pieces.'
   say 'Other than the EXEC code at the start, they need not be' ,
     'collected in order.'
   say ''
   say 'MAILABLE requires VMFPLCD EXEC and CMS Pipelines (both are' ,
     'standard with VM).'
   say ''
   say 'Problems/suggestions/cash to mailable@akphs.com'
