/* Profile for XEDIT */
 
Arg fn ft fm '(' other
load = 1 /* perform the LOAD command */
If fn = '' Then Do /* must be from the command line */
   load = 0
   'EXTRACT /FNAME/FTYPE/FMODE'
   fn = fname.1
   ft = ftype.1
   fm = fmode.1
End
search.0 = 5
search.1 = 'EXEC'
search.2 = 'SCRIPT'
search.3 = 'XEDIT'
search.4 = 'REXX'
search.5 = 'SAS'
 
fm = vaddr2fm(fm)
 
If ft = '' Then Do j = 1
  do i = 1 to search.0
    ft = search.i
    Address Command 'ESTATE' fn ft '*'
    If rc = 0 Then Leave j
  End
  Say 'Missing filetype.  existing filetypes are:'
  Address Command 'LISTFILE' fn '* *(STACK'
  Do i = 1 to queued()
    pull . ft fm .
    Say ft
  End
  exit
End
Address Command 'ESTATE' fn ft fm
If rc ^= 0 Then do
   Select
    When 1 = Abbrev('ASSEMBLE',ft,1) Then Ft = 'ASSEMBLE'
    When 1 = Abbrev('LISTING',ft,1) Then Ft = 'LISTING'
    When 1 = Abbrev('EXEC',ft,1) Then Ft = 'EXEC'
    When 1 = Abbrev('FILELIST',ft,1) Then Ft = 'FILELIST'
    When 1 = Abbrev('SCRIPT',ft,1) Then Ft = 'SCRIPT'
    When 1 = Abbrev('SAS',ft,2) Then Ft = 'SAS'
    When 1 = Abbrev('XEDIT',ft,1) Then Ft = 'XEDIT'
    When 1 = Abbrev('JCL',ft,1) Then Ft = 'JCL'
    Otherwise nop
   end
end
Address Command 'ESTATE' fn ft fm
If rc = 0 Then new = 0; Else new = 1
If load Then Do
  'LOAD' fn ft fm other
  If rc <> 0 & rc <> 3 Then exit rc
End
If new = 1 Then Address Xedit 'MSG Creating new file'
'EXTRACT /NBFILE/FTYPE/'
If 'UPDATE' = Ftype.1 Then 'SET SERIAL ALL'
/*
*        DEFINE SYNONYM TO GET ABBREVIATIONS FOR MACROS.  NOTE
*        THAT  SYNONYMS ARE VALID FOR ENTIRE EDIT SESSION, NOT
*        PER FILE
*/
If NBFILE.1 = 1 Then do
/*THE 10 FOLLOWING SYNONYMS LET YOU ENTER THE LINE NUMBER DIRECTLY*/
 'SET SYNONYM 0 1 L :0'
 'SET SYNONYM 1 1 L :1'
 'SET SYNONYM 2 1 L :2'
 'SET SYNONYM 3 1 L :3'
 'SET SYNONYM 4 1 L :4'
 'SET SYNONYM 5 1 L :5'
 'SET SYNONYM 6 1 L :6'
 'SET SYNONYM 7 1 L :7'
 'SET SYNONYM 8 1 L :8'
 'SET SYNONYM 9 1 L :9'
 'SET SYNONYM ALTER    2  ALTER'
 'SET SYNONYM CAPPEND  2  CAPPEND'
 'SET SYNONYM HEXTYPE  4  HEXTYPE'
 'SET SYNONYM JOIN     1  JOIN'
 'SET SYNONYM MODIFY   3  MODIFY'
 'SET SYNONYM SPLIT    2  SPLIT'
 'SET SYNONYM STATUS   4  STATUS'
end
'SET NULLS ON'
'SET NUM OFF'
'SET PREFIX ON LEFT'
'SET SCALE ON'
 
Select
  When ft = 'ASSEMBLE' Then do
   'SET TRUNC 72'
   'SET TABS 1 10 16 40 72'
   'SET NULLS OFF'
   End
  When ft = 'SCRIPT' Then do
   'SET CASE MIXED IGNORE'
   End
  When ft = 'JOB' Then do
   'SET CASE MIXED IGNORE'
   End
  When ft = 'LISTING' Then do
   'SET CASE MIXED IGNORE'
   End
  When ft = 'LIST' Then do
   'SET CASE MIXED IGNORE'
   End
  When ft = 'EXEC' Then do
   Call RexxTst
   End
  When ft = 'XEDIT' Then do
   Call RexxTst
   End
  When ft = 'MEMO' Then do
   'SET CASE MIXED IGNORE'
   End
  When ft = 'MAIL' Then do
   'SET CASE MIXED IGNORE'
   End
  When ft = 'FILELIST' Then do
   'SET CASE MIXED IGNORE'
   End
  When ft = 'NOTEBOOK' Then do
   'SET CASE MIXED IGNORE'
   End
  When ft = 'MARIST' & 0 = pos('-',fn) Then do
   'SET CASE MIXED IGNORE'
   'SET VERIFY 10 18 36 98'
   End
  Otherwise nop
End
 
'EXTRACT/LINE/CASE'
If case.1 = 'UPPER' Then Do i = 1 to 50
  ':'i
  'EXTRACT/CURLINE'
  If curline.3 <> translate(curline.3) Then Do
    Address Xedit 'MSG Found mixed case'
    'SET CASE MIXED IGNORE'
    Leave
  End
End /* do i */
':'line.1
 
If 'VMSHARE' = fn & datatype(ft,'N') Then Do
  'SET PF8 NEXTITEM'
End
'SET AUTOSAVE 10'
exit
 
RexxTst:
 If new Then Do
   'SET CASE MIXED IGNORE'
    return
 end
 ':1'
 'EXTRACT /CURLINE'
 line = Strip(Curline.3)
 Line = Substr(Line,1,2)
 If line = '/*' Then 'SET CASE MIXED IGNORE'
 'TOP'
 return
 
Vaddr2fm:
  procedure
 
  Arg fm .
  mode = 'G'
  fm = strip(fm)
 
  vaddr = fm
  If length(fm) > 2 Then Do 1
    Address CMS 'PIPE CMS Q SEARCH |' ,
       'locate (8-12) /'vaddr'/ |' ,
       'sort 22 d |' ,
       'spec word 3 1 |' ,
       'var fm'
      If fm <> 'FM' Then leave
        Address CMS 'PIPE CMS Q SEARCH |' ,
         'locate (26-80) /'vaddr'/ |' ,
         'sort 22 d |' ,
         'spec word 3 1 |' ,
       'var fm'
    If fm <> 'FM' Then leave
    Address CMS 'ACCESS' vaddr mode
    fm = mode
  end
 
return fm