home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / wps / editor / epmtools / epmmac / e3emul.e < prev    next >
Text File  |  1993-08-04  |  62KB  |  1,888 lines
  1. /**************************************************************************/
  2. /*  E3EMUL             Version  ==>    3.12/4.13/5.18         90/09/14    */
  3. /**************************************************************************/
  4.  
  5. ; Note:  The following constants should not be changed here.  Instead, anything
  6. ; you want different should be copied to your MYCNF.E and modified there.  That
  7. ; way, there's no need to merge in your changes when this file is updated.
  8.  
  9. /* Recommended for OS/2 Comm. Manager:  Copy next 3 or 4 lines to your MYCNF.E:
  10. const                  -- Configuration for E3EMUL:
  11.    HOST_SUPPORT = 'EMUL'  -- Tell E to include E3EMUL for host support.
  12.    USING = 'CM'           -- This enables multiple logical terminal support.
  13.    my_HOSTCOPY = 'AC'     -- Or whatever, *if* you renamed ALMCOS2 to something else.
  14. */
  15.  
  16. compile if not defined(SMALL)  -- Now, can be compiled stand-alone and linked in!
  17.    include 'STDCONST.E'
  18.  define INCLUDING_FILE = 'E3EMUL.E'
  19.    tryinclude 'MYCNF.E'
  20.  
  21.  compile if not defined(SITE_CONFIG)
  22.     const SITE_CONFIG = 'SITECNF.E'
  23.  compile endif
  24.  compile if SITE_CONFIG
  25.     tryinclude SITE_CONFIG
  26.  compile endif
  27. const
  28.  compile if not defined(BACKUP_PATH)
  29.    BACKUP_PATH = ''
  30.  compile endif
  31. ;compile if not defined(AUTOSAVE_PATH)  -- now use vAUTOSAVE_PATH
  32. ;  AUTOSAVE_PATH=''
  33. ;compile endif
  34.  compile if not defined(SMARTQUIT)
  35.    SMARTQUIT = 0
  36.  compile endif
  37.  compile if not defined(FILEKEY)
  38.    FILEKEY   = 'F4'  -- Note:  Must be a string (in quotes).
  39.  compile endif
  40.  compile if not defined(WANT_DBCS_SUPPORT)
  41.    WANT_DBCS_SUPPORT = 0
  42.  compile endif
  43.  compile if not defined(LINK_HOST_SUPPORT)
  44.    LINK_HOST_SUPPORT = 0
  45.  compile endif
  46.  compile if not defined(DELAY_SAVEPATH_CHECK)
  47.    DELAY_SAVEPATH_CHECK = 0
  48.  compile endif
  49.  compile if not defined(NLS_LANGUAGE)
  50.    NLS_LANGUAGE = 'ENGLISH'
  51.  compile endif
  52. include NLS_LANGUAGE'.e'
  53. compile endif  -- not defined(SMALL)
  54.  
  55.   const              -- Constants are value 0/No, 1/Yes
  56.  
  57.       -- to include VM file support
  58. compile if not defined(VM)
  59.   VM  = 1
  60. compile endif
  61.       -- to include MVS file support
  62. compile if not defined(MVS)
  63.   MVS = 0
  64. compile endif
  65.       -- to include KENKAHN's MVS routines
  66. compile if not defined(E3MVS)
  67.   E3MVS = 0
  68. compile endif
  69.       -- RUNTIME governs whether one can configure E3EMUL when editing
  70. compile if not defined(RUNTIME)
  71.   RUNTIME = 0
  72. compile endif
  73.       -- USING could be: MYTE, BOND, E78, CP78, IBM, CM, CM+IBM, or CM+CP78
  74.       -- IBM => SEND/RECEIVE protocol, e.g.
  75.       --        OS/2 EE Communications Manager
  76.       --        3270 Control Program
  77.       --        3270 Emulation Program
  78.       --        3278/79 Emulation Program
  79.       --        INPCS(X)
  80.       --        apparently, FTTERM
  81.       -- CM  => OS/2 EE Communications Manager, using ALMCOPY instead of SEND/RECEIVE
  82.       -- CM+IBM => Multiple protocols; like CM for VM files, IBM for MVS.
  83.       -- CM+CP78 => Multiple adapters; use CM for H:xxx and CP78 for 2:xxx
  84. compile if not defined(USING)
  85.   USING = 'IBM'
  86. compile endif
  87.       -- CM Send & Receive don't work from inside a PM program, so we call them
  88.       -- via EHLLAPI if we're using EPM.  The FTTERM and PMFTERM versions do
  89.       -- work (and EHLLAPI does not), so we let the user override the default.
  90. compile if not defined(USE_EHLLAPI)
  91.  compile if EPM
  92.   USE_EHLLAPI = 1
  93.  compile else
  94.   USE_EHLLAPI = 0
  95.  compile endif
  96. compile endif
  97.       -- if you want to be allowed duplicate copies (not views) of files
  98. compile if not defined(DUPLICATES_ALLOWED)
  99.   DUPLICATES_ALLOWED = 1
  100. compile endif
  101.       -- for debug purposes, not normally changed
  102. compile if not defined(DEBUG)
  103.   DEBUG = 0
  104. compile endif
  105.       -- The following is for if you are affected by the ALMCOPY bug that leaves
  106.       -- the cursor the wrong shape:
  107. compile if not defined(FIX_CURSOR)
  108.   FIX_CURSOR = 0
  109. compile endif
  110.       -- Default file mode, if not specified, is 'A'.  Some users might prefer
  111.       -- '*'.  Caution - do not change unless you know what this will do to your
  112.       -- file transfer program.
  113. compile if not defined(DEFAULT_FILEMODE)
  114.   DEFAULT_FILEMODE = 'A'
  115. compile endif
  116.       -- This is the drive letter used on the HOSTCOPY command.
  117.       -- Distinct from HOSTDRIVE, for users who have a real H: drive on the PC.
  118. compile if not defined(HOSTCOPYDRIVE)
  119.    HOSTCOPYDRIVE= 'H'
  120. compile endif
  121.       -- If you want a USER_FTO routine to get called when files are being saved.
  122.       -- This lets you change the default FTO for special cases
  123.       -- (e.g., files that must be RECFM F LRECL 80).
  124. compile if not defined(CALL_USER_FTO)
  125.   CALL_USER_FTO = 0
  126. compile endif
  127.  
  128. /* A sample user_FTO might be:
  129.    defproc user_FTO(hostfile, var fto, verb)
  130.       universal emulator, hostcopy
  131.       universal hname, htype, hmode
  132.       if verb='SAVE' & htype='ASSEMBLE' then
  133.          if emulator = 'IBM' or emulator = 'CP78' then
  134.             fto = 'LRECL 80 RECFM V ASCII CRLF'     -- For SEND command.
  135.          elseif upcase(substr(hostcopy,1,3))='ALM' then
  136.             fto = '/f=80 /ascii /q'                 -- For ALMCOPY command.
  137.          elseif emulator = 'MYTE' then
  138.             fto = '/f=80 /ascii'                    -- For MYTECOPY command.
  139.          endif  -- (You only need support the HOSTCOPY method(s) you use.)
  140.       endif
  141. */
  142. compile if E3MVS & EVERSION >= 4
  143.  *** Error - E3MVS should only be specified for E3, not EOS2 or EPM.
  144. compile endif
  145.       -- The default is implicit host support.  If you want:  Edit TEMP FILE A
  146.       -- to load 3 PC files instead of a host file, set the following to 1.
  147. compile if not defined(HOSTDRIVE_REQUIRED)
  148.    HOSTDRIVE_REQUIRED = 0
  149. compile endif
  150.       -- Users who are used to H: as the host drive, but have a real H: drive,
  151.       -- might want to use HA:, HB:, etc. to refer to the host, while just H:
  152.       -- will refer to the workstation.  (This is an alternative to setting
  153.       -- HOSTDRIVE to 'V' or something like that.)  This implies HOSTDRIVE_REQUIRED.
  154. compile if not defined(HOST_LT_REQUIRED)
  155.    HOST_LT_REQUIRED = 0
  156. compile endif
  157.       -- ELEP78 users will want to change the commands used for SEND and RECEIVE.
  158.       -- This isn't used for USING='CP78'
  159. compile if not defined(RECEIVE_CMD)
  160.    RECEIVE_CMD = 'receive'
  161. compile endif
  162. compile if not defined(SEND_CMD)
  163.    SEND_CMD = 'send'
  164. compile endif
  165.  
  166. definit
  167.   universal emulator, hostcopy, hostcmd, LT, hostdrive, savepath, ftoptions
  168.   universal keep_temp_files, binoptions, vAUTOSAVE_PATH
  169.  
  170.   emulator = upcase(USING)
  171.  
  172. compile if defined(my_LT)
  173.   LT = my_LT
  174. compile else
  175.   LT = 'A'
  176. compile endif
  177.                           -- for MYTE with multiple logical terminals
  178.                           -- or IBM (3270CP, OS/2 EE) to indicate a
  179.                           -- default LT or window...
  180.  
  181. compile if defined(my_hostdrive)
  182.   hostdrive = my_HOSTDRIVE
  183. compile else
  184.   hostdrive = 'H'
  185. compile endif
  186.                           -- should be 'h' for myte, e38 and bond -
  187.                           -- you may attempt to use others for IBM
  188.                           -- emulators, or your own purposes...
  189.  
  190.  
  191. compile if defined(my_hostcopy)
  192.   hostcopy= my_hostcopy
  193. compile else
  194.  compile if USING = 'IBM' | USING = 'CP78'  -- 89/10/19 - CP78 now has its own Send/Receive
  195.   hostcopy = ''
  196.  compile elseif USING = 'CM' | USING = 'CM+IBM' | USING = 'CM+CP78'
  197.   hostcopy = 'almcopy'
  198.  compile else
  199.   hostcopy = USING||'copy'
  200.  compile endif
  201. compile endif
  202.  
  203.                           -- could be mytecopy, e78copy, bondcopy or
  204.                           -- any other command with a similar command
  205.                           -- line syntax, such as almcopy.
  206.                           -- (almcopy multi file capability not yet
  207.                           -- supported)
  208.                           -- Not necessary to specify for emulator =
  209.                           -- 'IBM'
  210.  
  211. compile if defined(my_hostcmd)
  212.   hostcmd= my_hostcmd
  213. compile else
  214.  compile if USING = 'IBM' | USING = 'CP78'
  215.   compile if USE_EHLLAPI
  216.      hostcmd = 'EHLLAPI'
  217.   compile elseif EOS2
  218.      hostcmd = 'OS2CMD'
  219.   compile else
  220.      hostcmd = 'HOSTSYS'
  221.   compile endif
  222.  compile elseif USING = 'CM' | USING = 'CM+IBM' | USING = 'CM+CP78'
  223.   hostcmd = 'OS2CMD'
  224.  compile elseif USING = 'BOND'
  225.   hostcmd = 'VM'
  226.  compile else
  227.   hostcmd = USING||'cmd'
  228.  compile endif
  229. compile endif
  230.                           -- could be MYTECMD, E78CMD, VM (pcvmbond)
  231.                           -- or HOSTSYS.
  232.                           -- If emulator = 'IBM', then must be
  233.                           -- 'HOSTSYS', and the hostsys device driver
  234.                           -- must be installed for applications like
  235.                           -- E3NOTE to work
  236.  
  237. compile if defined(my_FTOPTIONS)
  238.   ftoptions = my_FTOPTIONS
  239. compile else
  240.  compile if USING = 'IBM'
  241.   compile if USE_EHLLAPI
  242.   ftoptions = 'ASCII CRLF'            -- Omit redirection if EPM (uses EHLLAPI)
  243.   compile else
  244.   ftoptions = 'ASCII CRLF >nul'       -- The minimum for IBM emulators
  245.   compile endif
  246. ;  ftoptions = '(ASCII CRLF)'       -- The noisy minimum for IBM emulators
  247.  compile elseif USING = 'MYTE'
  248.   ftoptions = '/ascii'                  -- The minimum for MYTE
  249.  compile elseif USING = 'E78' or USING = 'BOND'
  250.   ftoptions = '/q'
  251.  compile elseif USING = 'CM'  | USING = 'CM+IBM' | USING = 'CM+CP78'
  252.   ftoptions = '/q /ascii'
  253.  compile elseif USING = 'CP78'
  254.     ftoptions = 'ASC Q'
  255.  compile else
  256.   ftoptions = ''
  257.  compile endif
  258. compile endif
  259.                           -- Should you desire to add any options to
  260.                           -- the invocation of your hostcopy command,
  261.                           -- you may add a default set here, and/or
  262.                           -- change them with the FTO command   --
  263.                           -- Use the proper syntax; add slashes as
  264.                           -- necessary - E3EMUL does absolutely NO
  265.                           -- syntax checking on this one!
  266.  
  267. compile if defined(my_BINOPTIONS)
  268.   binoptions = my_BINOPTIONS
  269. compile else
  270.  compile if USING = 'IBM'
  271.   compile if USE_EHLLAPI
  272.   binoptions = ''                     -- Omit redirection if EPM (uses EHLLAPI)
  273.   compile else
  274.   binoptions = '() >nul'
  275.   compile endif
  276.  compile elseif USING = 'MYTE'
  277.   binoptions = '/b'
  278.  compile elseif USING = 'E78' or USING = 'BOND' or USING = 'CM'  | USING = 'CM+IBM' | USING = 'CM+CP78'
  279.   binoptions = '/b /q'
  280.  compile elseif USING = 'CP78'
  281.     binoptions = 'BIN Q'
  282.  compile else
  283.   binoptions = ''
  284.  compile endif
  285. compile endif
  286.                           -- These options will be used if E3EMUL
  287.                           -- detects the suffix BIN on a VM host file
  288.                           -- This should make it unnecessary for you
  289.                           -- to add /fto to edit most of 'our' VM
  290.                           -- binary files.
  291.  
  292. compile if defined(my_SAVEPATH)
  293.   SAVEPATH = my_SAVEPATH
  294. compile else
  295.   SAVEPATH = vAUTOSAVE_PATH     -- Default is user's AUTOSAVE path.
  296. compile endif
  297.                           -- If you wish temporary files to be saved
  298.                           -- to a specific subdirectory, name it here
  299.                           -- NOTE: this is different from the
  300.                           -- Temp_Path used in Autosave!  This is for
  301.                           -- the files created in up/downloading your
  302.                           -- host files.
  303.                           -- The syntax is: d:\path\
  304.                           -- DON'T FORGET THE TRAILING BACKSLASH
  305.  
  306. compile if defined(my_KEEP_TEMP_FILES)
  307.   KEEP_TEMP_FILES = MY_KEEP_TEMP_FILES
  308. compile else
  309.   KEEP_TEMP_FILES = 0
  310. compile endif
  311.                           -- If you wish temporary files to be saved
  312.                           -- even after the editing session is done,
  313.                           -- this should be set to 1.  This is good
  314.                           -- for those of us with recurring file
  315.                           -- transfer problems, or just paranoia :-)
  316.  
  317. /* definit code */
  318.  
  319. compile if (not EPM or defined(my_SAVEPATH)) and not DELAY_SAVEPATH_CHECK
  320.   call check_savepath()                 -- EPM does it in MAIN.E if no savepath defined, to pick up autosave path saved from Settings dialog.
  321. compile endif
  322.   LT = strip(LT,'b',':')
  323.  
  324.  
  325. /**************************************************************************/
  326. /*                                                                        */
  327. /*   PROCS - procedures for host file support                             */
  328. /*                                                                        */
  329. /**************************************************************************/
  330.  
  331.  
  332. defproc loadfile(file,options)
  333.  
  334.   universal hostdrive, savepath, fto
  335.  
  336. ;  Sneaky use of fto here - Larry made it universal, so the EDIT command could
  337. ;  pass fto outside the argument list.  From here on in, fto is passed via
  338. ;  argument list, and is not global.
  339.  
  340.   file=strip(file,'B')
  341.   fto=strip(fto,'B')
  342.   hostfileid=''
  343.  
  344.                           -- sets hostfile, tempfile, thisLT, bin
  345.   hosttype = ishost(file, 'EDIT', hostfile, tempfile, thisLT, bin)
  346.   if hosttype then
  347.      hostfilename = hostdrive||thisLT||hostfile
  348.      create_flag = isoption(options,'C')
  349.      if isoption(options,'N') | create_flag then
  350.         if already_in_ring(file, hostfileid) and not create_flag then
  351.            activatefile hostfileid
  352.         else
  353. compile if EVERSION >= '4.10'
  354.            'xcom e /c' options tempfile    -- 'E /C' forces creation of a new file
  355. compile else
  356.            'xcom e' options tempfile
  357. compile endif
  358.           .filename=hostfilename
  359.            getfileid hostfileid
  360.            rc = -282  -- sayerror('New file')
  361.         endif
  362. compile if not DUPLICATES_ALLOWED
  363.      elseif already_in_ring(hostfilename, hostfileid) then
  364.         activatefile hostfileid
  365. compile endif
  366.      else
  367.         set_FTO(hostfilename, bin, fto)
  368.         call load_host_file(hostfile, hostfileid,
  369.                                 tempfile, thisLT, fto, bin, options)
  370.         if rc then
  371.            activatefile hostfileid     -- make hidden ring active if hidden
  372.         endif
  373.      endif
  374.      call hidden_info(hostfileid, .filename, tempfile, fto, 'EDIT', bin, hosttype)
  375.   else
  376.      'xcom e 'options file             -- vanilla PC file - complex, eh?
  377.   endif
  378.  
  379.  
  380. defproc load_host_file(hostfile, var hostfileid, tempfile,
  381.                                thisLT, fto, bin, options)
  382.  
  383.   universal hostcopy, hostdrive
  384.   universal emulator, keep_temp_files
  385. compile if WANT_DBCS_SUPPORT
  386.   universal country, codepage, ondbcs
  387. compile endif
  388.  
  389. ; LAM:  Check internal flag before doing more expensive call to OS routine:
  390.   if not keep_temp_files then          -- saving tempfiles? overwrite at will
  391.      if exist(tempfile) then           -- Check for existence of prior PC file
  392.         if askyesno(OVERLAY_TEMP1__MSG,1)<>YES_CHAR then
  393.            return 0
  394.         endif
  395.      endif
  396.   endif
  397.  
  398.   hostfilename = hostdrive||thisLT||hostfile
  399. compile if EVERSION < 5           -- Avoid trivial SAYERRORs in EPM
  400.   call message(LOADING_PROMPT__MSG hostfilename WITH__MSG fto)
  401. compile endif
  402.                                                      -- build download command
  403.   if emulator = 'IBM' | emulator = 'CP78' then
  404. compile if WANT_DBCS_SUPPORT
  405.     p = lastpos('ASCII', fto)
  406.     if p and lastpos(codepage, 932 942) then
  407.        fto = substr(fto, 1, p - 1)'JI'substr(fto, p + 1)
  408.     endif
  409. compile endif
  410.     if emulator<>'IBM' then
  411.        rcv = RECEIVE_CMD
  412.     else
  413.        rcv = 'receive'
  414.     endif
  415.     if thisLT=':' then
  416.       line = 'xcom' rcv tempfile hostfile fto
  417.     else
  418.       line = 'xcom' rcv tempfile thisLT||hostfile fto
  419.     endif
  420.   else
  421.     line = hostcopy HOSTCOPYDRIVE||thisLT||hostfile tempfile fto
  422.   endif
  423. compile if DEBUG
  424.   messagenwait(line)
  425. compile endif
  426.  
  427. compile if USE_EHLLAPI
  428.   if emulator = 'IBM' then
  429.      rc = EHLLAPI_SEND_RECEIVE(91, substr(line,14))  -- RECEIVE = 91
  430.   else
  431. compile endif
  432.   quiet_shell line                                -- do the download
  433. compile if FIX_CURSOR
  434.   insert_toggle; insert_toggle
  435. compile endif
  436. compile if EPM
  437.    endif
  438. compile endif
  439. compile if E3  -- Only E3 generates an "Insufficient memory" error.
  440.    if rc=sayerror("Insufficient memory") then     --LAM:  Not transfer error
  441.       stop
  442.    endif
  443. compile endif
  444.  
  445. compile if E3MVS
  446.   rc = isa_E3mvs_filename(rc,Error_msg,'RESET',rc,rc,rc,rc)
  447. compile endif
  448.  
  449.   getfileid startid
  450.   if rc then                                   -- assume host file not found
  451.      hostrc = rc
  452.      'xcom e 'options' /n .newfile'
  453.      if not isoption(options,'Q') then
  454.         call message(FILE_TRANSFER_ERROR__MSG hostrc'.  'HOST_NOT_FOUND__MSG)
  455.      endif
  456.      rc=-282  -- sayerror('New file')
  457.   else                                                -- good download occurred
  458.      'xcom e /d /q 'options tempfile
  459.      erc = rc
  460.      if keep_temp_files then
  461.         message(SAVED_LOCALLY_AS__MSG upcase(tempfile))
  462.      else
  463.         call erasetemp(tempfile)
  464.      endif
  465.      if erc then
  466.         call message(rc)
  467.      endif
  468.   endif
  469.  
  470.   getfileid hostfileid                               -- set pertinent file data
  471.   if hostfileid=startid then stop; endif    -- Uh oh - new file wasn't loaded.
  472.   if thisLT then
  473.     .filename=hostdrive||thisLT||hostfile
  474.   else
  475.     .filename=hostdrive':'hostfile
  476.   endif
  477.  
  478.  
  479. defproc savefile(given_name)
  480.   universal hostdrive, LT
  481. compile if BACKUP_PATH <> '' & BACKUP_PATH <> '='
  482.    universal backup_path_ok
  483. compile endif
  484.                                              -- prepare given arguments for use
  485.    parse value given_name with name '[' fto ']'
  486.    options=arg(2)
  487.  
  488.                           -- sets hostfile, tempfile, thisLT, bin
  489.   hosttype = ishost(name, 'SAVE', hostfile, tempfile, thisLT, bin)
  490.   if hosttype then
  491.      hostfilename = hostdrive||thisLT||hostfile
  492.      if .filename=hostfilename then  --assume saving this copy
  493.         getfileid hostfileid
  494.      else
  495.         getfileid hostfileid, hostfilename  --could be saving non-current file
  496.      endif
  497.      call hidden_info(hostfileid, hostfilename, tempfile, fto, 'SAVE', bin, hosttype)
  498.      src=save_host_file(hostfile, tempfile, thisLT, fto, hostfileid, options)  --LAM
  499.      if src then         -- if host error, offer to save on PC
  500.         if askyesno(SAVE_LOCALLY__MSG,1) = YES_CHAR then
  501.            dot = pos('.',tempfile,max(lastpos('\',tempfile),1))  -- Handle '.' in path
  502.            if dot then tempfile=substr(tempfile,1,dot-1); endif
  503.            if exist(tempfile'.TMP') then
  504. compile if EVERSION < 5
  505.               if askyesno(FILE__MSG tempfile'.TMP' OVERLAY_TEMP2__MSG,1) = 'N' then
  506. compile else
  507.               if winmessagebox('', FILE__MSG tempfile'.TMP' OVERLAY_TEMP3__MSG, 16449)=2 then
  508. compile endif
  509.                  stop
  510.               endif
  511.            endif
  512.            'xcom s 'tempfile'.TMP'
  513.            if rc then return rc; endif
  514.            messageNwait(SAVED_LOCALLY_AS__MSG tempfile'.TMP' PRESS_A_KEY__MSG)  --LAM
  515.         endif
  516.      endif
  517.      call message(1)
  518.      return src
  519.   endif                   --LAM: Don't need ELSE since THEN does a RETURN.
  520.    name=strip(given_name)  -- Allow for brackets in PC names
  521. compile if EVERSION >= '5.50'  --@HPFS
  522.    name_same = (name = .filename)
  523.    if pos(' ',name) & leftstr(name,1)<>'"' then
  524.       name = '"'name'"'
  525.    endif
  526. compile endif
  527. compile if BACKUP_PATH
  528.        -- jbl 1/89 new feature.  Editors in the real marketplace keep at least
  529.        -- one backup copy when a file is written.
  530.  compile if BACKUP_PATH <> '='
  531.    if backup_path_ok then
  532.  compile endif
  533.  compile if EVERSION >= '4.10'    -- OS/2 - redirect STDOUT & STDERR
  534.       quietshell 'copy' name MakeBakName() '1>nul 2>nul'
  535.  compile else
  536.       quietshell 'copy' name MakeBakName() '>nul'
  537.  compile endif
  538.  compile if BACKUP_PATH <> '='
  539.    endif
  540.  compile endif
  541. compile endif
  542.    'xcom s 'options name; src=rc    -- the save code for a vanilla PC file...
  543. compile if EVERSION >= '5.50'  --@HPFS
  544.    if not rc and name_same then
  545. compile else
  546.    if not rc and name=.filename then
  547. compile endif
  548.       .modify=0
  549.       'deleteautosavefile'
  550.    endif
  551.    return src
  552.  
  553.  
  554. defproc save_host_file(hostfile, tempfile, thisLT, fto, hostfileid, options)
  555.  
  556.   universal hostcopy, hostdrive
  557.   universal LT, emulator, keep_temp_files
  558. compile if WANT_DBCS_SUPPORT
  559.   universal country, codepage, ondbcs
  560. compile endif
  561.  
  562.   getfileid hostfileid
  563.   'xcom save 'tempfile
  564.   if rc then stop endif
  565.  
  566.   hostfilename = hostdrive||thisLT||hostfile
  567.  
  568.   if not isoption(options,'Q') then
  569. compile if EPM & EVERSION < '5.50'
  570.      call sayatbox(SAVING_PROMPT__MSG hostfilename WITH__MSG fto)
  571. compile else
  572.      call message(SAVING_PROMPT__MSG hostfilename WITH__MSG fto)
  573. compile endif
  574.    endif
  575.                                      -- build command line
  576.   if emulator = 'IBM' | emulator = 'CP78' then
  577. compile if WANT_DBCS_SUPPORT
  578.      p = lastpos('ASCII', fto)
  579.      if p and lastpos(codepage, 932 942) then
  580.         fto = substr(fto, 1, p - 1)'JI'substr(fto, p + 1)
  581.      endif
  582. compile endif
  583.      if emulator<>'IBM' then
  584.         send = SEND_CMD
  585.      else
  586.         send = 'send'
  587.      endif
  588.      if thisLT=':' then
  589.        line = 'xcom' send tempfile hostfile fto
  590.      else
  591.        line = 'xcom' send tempfile thisLT||hostfile fto
  592.      endif
  593.   else
  594.      line = hostcopy tempfile HOSTCOPYDRIVE||thisLT||hostfile fto
  595.   endif
  596. compile if DEBUG
  597.   messagenwait(line)
  598. compile endif
  599.  
  600. compile if USE_EHLLAPI
  601.   if emulator = 'IBM' then
  602.      rc = EHLLAPI_SEND_RECEIVE(90,substr(line,11))  -- SEND = 90
  603.   else
  604. compile endif
  605.   quiet_shell line
  606. compile if FIX_CURSOR
  607.   insert_toggle; insert_toggle
  608. compile endif
  609. compile if EPM
  610.    endif
  611. compile endif
  612.  
  613. compile if E3MVS
  614.   rc = isa_E3mvs_filename(rc,Error_msg,'RESET',rc,rc,rc,rc)
  615. compile endif
  616.  
  617.   if rc then
  618. compile if E3  -- Only E3 generates an "Insufficient memory" error.
  619.       if rc=sayerror('Insufficient memory') then       --LAM
  620.          emsg = 'Insufficient memory to call 'hostcopy
  621.       else
  622.          emsg = 'Host error 'rc' - no save'
  623.       endif
  624.       messagenwait(emsg'.  File saved on PC in 'tempfile)
  625. compile else
  626.       messagenwait(HOST_ERROR__MSG rc'; 'HOST_CANCEL__MSG tempfile)
  627. compile endif
  628.      return 1
  629.   else
  630.      if .filename=hostfilename then
  631.         hostfileid.modify=0                    -- reset 'modify since saved' switch
  632.      endif
  633.      if keep_temp_files then
  634.         message(SAVED_LOCALLY_AS__MSG upcase(tempfile))
  635.      else
  636.         call erasetemp(tempfile)
  637.      endif
  638.   endif
  639.   return 0
  640.  
  641.  
  642. defproc namefile(newname)
  643.   universal hostdrive
  644.  
  645.   hostfileid=''
  646.   parse value upcase(newname) with name '[' fto ']'
  647.  
  648.                        -- sets hostfile, tempfile, thisLT, bin
  649.   hosttype = ishost(name, 'NAME', hostfile, tempfile, thisLT, bin)
  650.   if hosttype then
  651.      hostfilename = hostdrive||thisLT||hostfile
  652. compile if DUPLICATES_ALLOWED
  653.      getfileid hostfileid
  654. compile else
  655.      if already_in_ring(hostfilename, hostfileid) then -- is file being edited?
  656.         message(ALREADY_EDITING_MSG)
  657.         return 1                          -- then error - two files one name
  658.      endif
  659. compile endif
  660.      call hidden_info(hostfileid, hostfilename, tempfile, fto, 'NAME', bin, hosttype)
  661.      .filename=hostfilename
  662.   elseif parse_filename(newname,.filename) then
  663.      sayerror INVALID_FILENAME__MSG
  664.   else
  665. compile if EVERSION >= '5.50'  --@HPFS
  666.       if pos(' ',newname) & leftstr(newname,1)<>'"' then
  667.          newname = '"'newname'"'
  668.       endif
  669. compile endif
  670.      'xcom n 'newname  --  for a vanilla PC name
  671.   endif
  672.  
  673.  
  674. defproc quitfile()
  675.   universal keep_temp_files
  676.  
  677. compile if EVERSION < 5
  678.    if .windowoverlap then
  679.       modify=(.modify and .views=1)
  680.    else
  681.       modify=.modify
  682.    endif
  683.    k='Y'
  684.    if modify then
  685.  compile if SMARTQUIT
  686.       call message(QUIT_PROMPT1__MSG '('FILEKEY')')
  687.  compile else
  688.       call message(QUIT_PROMPT2__MSG)
  689.  compile endif
  690.       loop
  691.          k=upcase(getkey())
  692.  compile if SMARTQUIT
  693.          if k=$FILEKEY then 'File'; return 1              endif
  694.  compile endif
  695.          if k=YES_CHAR or k=NO_CHAR or k=esc then leave;  endif
  696.       endloop
  697.       call message(1)
  698.    endif
  699.    if k<>YES_CHAR then
  700.       return 1
  701.    endif
  702.    if not .windowoverlap or .views=1 then
  703.       .modify=0
  704.    endif
  705. compile endif
  706.  
  707.    'deleteautosavefile'
  708. ;  if not pos('.DIR',.filename) and substr(.filename,1,1) <> '.' then
  709.    if substr(.filename,1,1) <> '.' then
  710. ;;    if check_for_host_file(.filename) then
  711.       hosttype = ishost(.filename, 'CHECK', hostfile, tempfile, thisLT, bin)
  712.       if hosttype then
  713.          getfileid quitfileid
  714.          call hidden_info(quitfileid, .filename, tempfile, fto, 'QUIT', bin, hosttype)
  715.          if not keep_temp_files then
  716.             call erasetemp(tempfile)
  717.          endif
  718.       endif
  719.    endif
  720.    'xcom_quit'
  721.  
  722. /*
  723. defproc check_for_host_file(arg1)
  724.   return ishost(arg1, 'CHECK', hostfile, tempfile, thisLT, bin)
  725. */
  726.  
  727. defproc ishost(candidate, verb, var hostfile, var tempfile, var thisLT, var bin)
  728.  
  729.    universal hostdrive, LT, binoptions, ftoptions, emulator
  730.  
  731.  -- also returns a numeric value:
  732.  --  0 -- PC  filename
  733.  --  1 -- VM  filename
  734.  --  2 -- MVS filename
  735.  
  736. compile if DEBUG
  737. ;   messagenwait('ishost sees: 'candidate verb hostfile tempfile thisLT bin)
  738. compile endif
  739.  
  740.    cand = upcase(candidate)
  741.    verb = upcase(verb)
  742.    hostfile = ''
  743.    tempfile = ''
  744.    whynot = ''
  745.    thisLT = ''
  746.    bin = 0
  747.  
  748.   /* first, find out what sort of file we got here...*/
  749.  
  750.    parse value cand with '/Q' candidate                --  PRINT command does
  751.    if not candidate then                               -- 'save /q', we strip
  752.      candidate = cand                                  -- this when checking
  753.    endif                                               -- for host file
  754.  
  755.    if candidate='' then  -- the null filename - PC file
  756.       return 0
  757.    endif
  758.    candidate = strip(candidate)
  759.  
  760. compile if VM
  761.  compile if EVERSION >= '5.50'
  762.    if verify(candidate,' ','m') & leftstr(candidate,1)<>'"' then
  763.  compile else
  764.    if verify(candidate,' ','m') then          -- space => VM filename or error
  765.  compile endif
  766.       if verb = 'CHECK' then  -- don't care about syntax, etc
  767.          return 1
  768.       endif      --LAM:  Don't use ELSEIF if THEN ended w/ RETURN.
  769.       if isa_vm_filename(candidate, hostfile, tempfile, thisLT, bin, whynot) then
  770.          setLT(thisLT)
  771.          return 1
  772.       endif
  773.  compile if HOST_LT_REQUIRED
  774.       if upcase(substr(candidate,1,1))=hostdrive & substr(candidate,3,1)=':' then
  775.  compile elseif HOSTDRIVE_REQUIRED
  776.       if upcase(substr(candidate,1,1))=hostdrive & pos(':', substr(candidate,2,3)) then
  777.  compile endif
  778.          message(candidate LOOKS_VM__MSG whynot)
  779.  compile if HOST_LT_REQUIRED | HOSTDRIVE_REQUIRED
  780.   compile if EVERSION < '5.50'
  781.       else
  782.          message(NO_SPACES__MSG)
  783.   compile endif
  784.       endif
  785.  compile endif
  786.       return 0
  787.    endif
  788. compile endif
  789.  
  790. compile if (MVS | E3MVS)
  791.    posp1 = pos('.',candidate)
  792.    posl  = pos(':',candidate)
  793.    posp2 = lastpos('.',candidate)
  794.  
  795.    test1= pos('''',candidate)   |              /* Fully qualified MVS name ?    */
  796.           pos('(',candidate)    |              /* PDS member specified ?        */
  797.  compile if HOST_LT_REQUIRED
  798.           (posl=3 &                            /* If 'Hx:' then ...             */
  799.  compile else
  800.           (posl   &                            /* If 'H:' or 'Hx:' then ...     */
  801.  compile endif
  802.           substr(candidate,1,1) = hostdrive)   /*   it must be a HOST file      */
  803.  
  804.  compile if E3          -- E3:  can assume FAT
  805.    test2=posp1 &                       /* 2nd qualifier is >3 bytes and */
  806.         (length(candidate)-posp1) > 3  /*   cannot be a valid PC Extent */
  807.  compile endif
  808.  
  809.    if not pos('\',candidate)  &                /* MVS name cannot contain '\'   */
  810.  compile if E3          -- E3:  can assume FAT
  811.       (test1                                 | /* Fully qualified MVS name ?    */
  812.        (posp1 <> posp2)                      | /* Multiple qualifiers ?         */
  813.         test2) then                            /* 2nd qualifier is >3 bytes ... */
  814.  compile else           -- OS/2; last two tests don't disqualify an HPFS filename.
  815.       test1 then                               /* Fully qualified MVS name ?    */
  816.  compile endif
  817.  compile if E3MVS
  818.       if isa_E3MVS_filename(candidate, hostfile, verb, tempfile, thisLT, bin, whynot) then
  819.  compile else
  820.       if isa_mvs_filename(candidate, hostfile, verb, tempfile, thisLT, bin, whynot) then
  821.  compile endif
  822.          setLT(thisLT)
  823.          return 2
  824.       else
  825.  compile if E3MVS
  826.          call free()
  827.  compile endif
  828.          sayerror(MVS_Error__MSG whynot)
  829.          stop
  830.       endif
  831.    endif
  832. compile endif -- (MVS | E3MVS)
  833.  
  834.   /* assume PC filename by now... */
  835.  
  836.    if verb = 'CHECK' then
  837.       return 0
  838.    endif
  839.    if verb = 'NAME' & pos('=',candidate) then
  840.       call parse_filename(candidate,.filename)
  841.    endif
  842.    if isa_pc_filename(candidate, tempfile, whynot) then
  843.       return 0
  844.    endif
  845.    message(candidate LOOKS_PC__MSG whynot)
  846.    return 0
  847.  
  848.  
  849. /**************************************************************************/
  850. /*****************************************************************************/
  851.  
  852. defproc isa_pc_filename(candidate, var tempfile, var error_msg)
  853. compile if EVERSION >= '5.50'  --@HPFS
  854.    if leftstr(candidate,1)='"' & rightstr(candidate,1)='"' then
  855.       candidate=substr(candidate,2,length(candidate)-2)
  856.    endif
  857. compile endif
  858.    parse value upcase(candidate) with drive ':' pathfile
  859.    if not pathfile then
  860.       pathfile = drive
  861.       drive = ''
  862.    endif
  863.    if length(drive) > 1 then
  864.       error_msg = PC_DRIVESPEC__MSG drive LONGER_THAN_ONE__MSG
  865.       return 0
  866.    endif
  867.    if length(drive) and verify(drive,'ABCDEFGHIJKLMNOPQRSTUVWXYZ') then
  868.       error_msg = PC_DRIVESPEC__MSG drive IS_NOT_ALPHA__MSG
  869.       return 0
  870.    endif
  871.    if substr(pathfile,1,2)='..' then  -- allow shortening path by '..'
  872.       pathfile = substr(pathfile,3)    -- strip it, check the rest of path
  873.    endif
  874.    if lastpos('\',pathfile) > 1 and pos('\',pathfile) <> 1 then
  875.                             -- We have a path, but it doesn't start with a \
  876.       pathfile = '\'pathfile
  877.    endif
  878. compile if E3
  879.    bad_chars = '."/\[]:|<>+=;,'            --LAM
  880. compile else                                          -- Don't limit to 8 chars; HPFS
  881.    bad_chars = '"/\:|<>'            --LAM
  882. compile endif
  883.    if substr(pathfile,1,1)='\' then
  884.      parse value pathfile with +1 pathpiece '\' restofname
  885.      while restofname do
  886. compile if E3
  887.        parse value pathpiece with first '.' last
  888.        if length(first) > 8 or verify(first,bad_chars,'m') then
  889.          error_msg = INVALID_PATH__MSG candidate
  890.          return 0
  891.        endif
  892.        if length(last) > 3 or verify(last,bad_chars,'m') then
  893. compile else                                          -- Don't limit to 8 chars; HPFS
  894.        if verify(pathpiece,bad_chars,'m') then
  895. compile endif
  896.          error_msg = INVALID_PATH__MSG candidate
  897.          return 0
  898.        endif
  899.        parse value restofname with pathpiece '\' restofname
  900.      endwhile
  901.      name = pathpiece
  902.    else
  903.      name=pathfile
  904.    endif
  905.    parse value name with fname '.' ext
  906. compile if E3
  907.    if length(fname) > 8 or verify(fname,bad_chars,'m') then
  908. compile else                                          -- Don't limit to 8 chars; HPFS
  909.    if verify(fname,bad_chars, 'm') then
  910. compile endif
  911.      error_msg = INVALID_FNAME__MSG fname
  912.      return 0
  913.    endif
  914.    if ext then
  915. compile if E3
  916.      if length(ext) > 3 or verify(ext,bad_chars,'m') then
  917. compile else                                          -- Don't limit to 8 chars; HPFS
  918.      if verify(ext,bad_chars,'m') then
  919. compile endif
  920.        error_msg = INVALID_EXT__MSG ext
  921.        return 0
  922.      endif
  923.    endif
  924.  
  925.    tempfile=''
  926.    return 1
  927.  
  928. compile if not defined(VALID_LTS)
  929.  compile if USING='CM+CP78'
  930. define VALID_LTS = 'ABCDEFGH12345'
  931.  compile elseif USING='CP78'
  932. define VALID_LTS = 'ABCDE12345'
  933.  compile else
  934. define VALID_LTS = 'ABCDEFGH'
  935.  compile endif
  936. compile endif
  937.  
  938. --  VM support routines  -----------------------------------------------
  939.  
  940. compile if VM
  941. defproc isa_vm_filename(candidate,
  942.                         var hostfile, var tempfile, var thisLT, var bin,
  943.                         var error_msg)
  944.  
  945.    universal hostdrive, LT, savepath, emulator
  946.    universal hname, htype, hmode
  947.  
  948.    parse value upcase(candidate) with drive ':' hname htype hmode rest
  949.  
  950.    thisLT = LT
  951.    if not hname then
  952.  compile if HOST_LT_REQUIRED | HOSTDRIVE_REQUIRED
  953.       error_msg = NO_HOST_DRIVE__MSG
  954.       return 0
  955.  compile else
  956.       parse value drive with hname htype hmode rest
  957.       drive = hostdrive||LT
  958.  compile endif
  959.    else
  960.       if length(drive)>2 then
  961.          error_msg = HOST_DRIVELETTER__MSG drive IS_TOO_LONG__MSG
  962.          return 0
  963.       endif
  964.       if substr(drive,1,1)<>hostdrive then
  965.          error_msg = HOST_DRIVELETTER__MSG substr(drive,1,1) INVALID__MSG
  966.          return 0
  967.       endif
  968.       if length(drive)>1 then
  969.          thisLT = substr(drive,2)
  970.          if verify(thisLT,VALID_LTS) then
  971.             error_msg = HOST_LT__MSG thisLT INVALID__MSG
  972.             return 0
  973.          endif
  974.  compile if HOST_LT_REQUIRED
  975.       else
  976.          error_msg = NO_LT__MSG
  977.          return 0
  978.  compile endif
  979.       endif
  980.    endif
  981. compile if USING='CM+CP78'
  982.    if isnum(thisLT) then
  983.       emulator = 'CP78'
  984.    else
  985.       emulator = 'CM'
  986.    endif
  987. compile endif
  988.  
  989.    if not hmode then                     -- assuming host filename -
  990.       hmode=DEFAULT_FILEMODE             -- will default to your A disk
  991.    elseif hmode<>'*' then
  992.       if length(hmode)>2 then
  993.          error_msg = FM__MSG hmode IS_TOO_LONG__MSG
  994.          return 0
  995.       endif
  996.       if verify(substr(hmode,1,1),'ABCDEFGHIJKLMNOPQRSTUVWXYZ') then
  997.          error_msg = FM1_BAD__MSG
  998.          return 0
  999.       endif
  1000.       if length(hmode)>1 and verify(substr(hmode,2,1),'1234567890')  then
  1001.          error_msg = FM2_BAD__MSG
  1002.          return 0
  1003.       endif
  1004.    endif
  1005.  
  1006.    if not htype then
  1007.       error_msg = NO_FT__MSG
  1008.       return 0
  1009.    endif
  1010.    if length(htype)>8 then
  1011.       error_msg = FT__MSG htype IS_TOO_LONG__MSG
  1012.       return 0
  1013.    endif
  1014.    bad_chars = ':*~`!%^&()|\{[}];"<,>.?/'
  1015.    if verify(htype, bad_chars, 'm') then
  1016.       error_msg = BAD_FT__MSG htype
  1017.       return 0
  1018.    endif
  1019.  
  1020. ;  if not hname then  -- then htype would already have been reported missing.
  1021. ;     error_msg = 'fn missing'
  1022. ;     return 0
  1023. ;  endif
  1024.    if length(hname)>8 then
  1025.       error_msg = FN__MSG hname IS_TOO_LONG__MSG
  1026.       return 0
  1027.    endif
  1028.    if verify(hname, bad_chars, 'm') then
  1029.       error_msg = BAD_FN__MSG htype
  1030.       return 0
  1031.    endif
  1032.  
  1033.    binpos=lastpos('BIN',htype)
  1034.  
  1035.    bin = binpos and (binpos = (length(htype) - 2))
  1036.  
  1037.    hostfile=hname htype hmode                   -- remove extra spaces
  1038.    tempfile=savepath||pc_chars(hname)'.'pc_chars(substr(htype,1,3))
  1039.  
  1040. compile if USING='CM+IBM'
  1041.    emulator = 'CM'
  1042. compile endif
  1043.  
  1044.    return 1
  1045. compile endif
  1046.  
  1047. --  MVS support routines -----------------------------------------
  1048.  
  1049. compile if E3MVS
  1050.    include 'e3mvsisa.e'  -- include Ken Kahn's isa-E3mvs-filename routine
  1051. compile endif
  1052.  
  1053. compile if MVS
  1054.  
  1055. defproc isa_mvs_filename(candidate,
  1056.                          var hostfile, MVSfunction, var tempfile,
  1057.                          var thisLT, var bin,
  1058.                          var error_msg)
  1059.  
  1060.    universal hostdrive, LT, savepath, emulator
  1061.  
  1062.    parse value upcase(candidate) with drive ':' datasetname rest
  1063.  
  1064. ;; MVSfunction = Upcase(MVSfunction)
  1065.    If (MVSfunction = 'QUIT') or (MVSfunction = 'CHECK') then
  1066.       return 2
  1067.    EndIf
  1068.    If (MVSfunction = 'RESET') then
  1069.       return candidate
  1070.    EndIf
  1071.  
  1072.    ThisLT=LT
  1073.    if datasetname='' then
  1074.  compile if HOST_LT_REQUIRED | HOSTDRIVE_REQUIRED
  1075.       error_msg = NO_HOST_DRIVE__MSG
  1076.       return 0
  1077.  compile else
  1078.       parse value drive with datasetname rest
  1079.  compile endif
  1080.    else
  1081.       if substr(drive,1,1)<>hostdrive then
  1082.          error_msg = HOST_DRIVELETTER__MSG substr(drive,1,1) INVALID__MSG
  1083.          return 0
  1084.       endif
  1085.       if length(drive)>2 then
  1086.          error_msg = HOST_DRIVELETTER__MSG drive IS_TOO_LONG__MSG
  1087.          return 0
  1088.       endif
  1089.       if length(drive)>1 then
  1090.          thisLT = substr(drive,2)
  1091.          if verify(thisLT,VALID_LTS) then
  1092.             error_msg = HOST_LT__MSG thisLT INVALID__MSG
  1093.             return 0
  1094.          endif
  1095.  compile if HOST_LT_REQUIRED
  1096.       else
  1097.          error_msg = NO_LT__MSG
  1098.          return 0
  1099.  compile endif
  1100.       endif
  1101.    endif
  1102. compile if USING='CM+CP78'
  1103.    if isnum(thisLT) then
  1104.       emulator = 'CP78'
  1105.    else
  1106.       emulator = 'CM'
  1107.    endif
  1108. compile endif
  1109.  
  1110.    if pos("'",datasetname) then
  1111.       datasetname = substr(datasetname,2,length(datasetname)-2)
  1112.       quotes = "'"
  1113.    else
  1114.       quotes = ''
  1115.    endif
  1116.  
  1117.    if (length(datasetname) > 44) then
  1118.       error_msg = DSN_TOO_LONG__MSG
  1119.       return 0
  1120.    endif
  1121.  
  1122.    if verify(datasetname,'(','m') and
  1123. compile if EVERSION >= '5.17'
  1124.         rightstr(datasetname,1) <> ')' then
  1125. compile else
  1126.         substr(datasetname,length(datasetname),1) <> ')' then
  1127. compile endif
  1128.       datasetname = datasetname')'
  1129.    endif
  1130.  
  1131.    parse value datasetname with DsnName '(' member ')' rest
  1132.  
  1133.    HostFile = ''
  1134.    Qualifiers = 0
  1135.    Qual1 = ''
  1136.    Qual2 = ''
  1137.    Qual3 = ''
  1138.    LastQualifier = ''
  1139.    Restof_Dsn = DsnName
  1140.    do forever
  1141.       parse value Restof_Dsn with Qualifier '.' Restof_Dsn
  1142.       if Qualifier = '' then leave; endif
  1143.       Qualifiers = Qualifiers + 1
  1144.       LastQualifier = Qualifier
  1145.       if length(Qualifier) > 8 then
  1146.          error_msg = QUAL_NUM__MSG Qualifiers '('Qualifier')' QUAL_TOO_LONG__MSG
  1147.          return 0
  1148.       endif
  1149.       if verify(qualifier, ':*~`!%^&()_-+=|\{[}];"<,>.?/', 'm') then
  1150.          error_msg = QUAL_NUM__MSG Qualifiers '('Qualifier')' QUAL_INVALID__MSG
  1151.          return 0
  1152.       endif
  1153.       if Qualifiers>1 then
  1154.          HostFile = HostFile||'.'||Qualifier
  1155.       else
  1156.          HostFile = Qualifier
  1157.       endif
  1158.       if     Qualifiers = 1 then
  1159.          Qual1 = Qualifier
  1160.       elseif Qualifiers = 2 then
  1161.          Qual2 = Qualifier
  1162.       elseif Qualifiers = 3 then
  1163.          Qual3 = Qualifier
  1164.       endif
  1165.    enddo
  1166.  
  1167.    if member <> '' then
  1168.       if substr(member,1,1) = '+' then
  1169.          if substr(member,2,1) <> '0' then
  1170.             error_msg = GENERATION_NAME__MSG member INVALID__MSG
  1171.             return 0
  1172.          endif
  1173.       elseif substr(member,1,1) = '-' then
  1174.          if verify(substr(member,2,1),'123456789') then
  1175.             error_msg = GENERATION_NAME__MSG member INVALID__MSG
  1176.             return 0
  1177.          endif
  1178.       elseif length(member) > 8 then
  1179.          error_msg = MEMBER__MSG member IS_TOO_LONG__MSG
  1180.          return 0
  1181.       elseif verify(member, ':*~`!%^&()_-+=|\{[}];"<,>.?/', 'm') then
  1182.          error_msg = INVALID_MEMBER__MSG member
  1183.          return 0
  1184.       endif
  1185.    elseif verify(datasetname,'()','m') then
  1186.       error_msg = DSN_PARENS__MSG
  1187.       return 0
  1188.    endif
  1189.  
  1190.    if member = '' then
  1191.       HostFile = quotes||HostFile||quotes
  1192.    else
  1193.       HostFile = quotes||HostFile'('member')'quotes
  1194.    endif
  1195.  
  1196.    if member = '' then
  1197.       if Qual3 = '' then
  1198.          tempFile = savepath||Qual1'.'substr(LastQualifier,1,3)
  1199.       else
  1200.          tempFile = savepath||Qual2'.'substr(LastQualifier,1,3)
  1201.       endif
  1202.    else
  1203.       tempFile = savepath||pc_chars(member)'.'substr(LastQualifier,1,3)
  1204.    endif
  1205.  
  1206. compile if USING='CM+IBM'
  1207.    emulator = 'IBM'
  1208. compile endif
  1209.  
  1210.    return (2)
  1211.  
  1212. compile endif
  1213.  
  1214.  
  1215. -- COMMON ROUTINES, ETC.  --
  1216.  
  1217. defproc pc_chars(str) -- Translate invalid PC chars to $
  1218.    do forever
  1219.       v = verify(str, '+,"/\[]:|<>=;.', 'M')
  1220.       if not v then leave; endif
  1221. compile if E3
  1222.       str = substr(str,1,v-1)'$'substr(str,v+1)
  1223. compile else
  1224.       str = overlay('$',str,v)
  1225. compile endif
  1226.    enddo
  1227.    return str
  1228.  
  1229. defproc already_in_ring(filename, var tryid)
  1230.  
  1231.   getfileid tryid, filename
  1232.   return tryid<>''            --LAM
  1233.  
  1234.  
  1235. defproc hidden_info(hostfileid, hostfilename, var tempfile, var fto, verb, bin, hosttype)
  1236.  
  1237.  /* using a hidden file, we keep track of the host files and any special  */
  1238.  /* file transfer options associated with each.                           */
  1239.  
  1240.  /* get the hidden file for the information we're keeping                 */
  1241.  
  1242.   save_rc = rc
  1243.   if verb='NAME' then
  1244.      newname=hostfilename
  1245.      hostfilename = .filename
  1246.   endif
  1247.  
  1248.   getfileid savefileid
  1249. compile if EVERSION < 5
  1250.   'xcom e /h /q /n fto.e'
  1251. compile else
  1252.    'xcom e /n fto.e'
  1253.    .visible = 0
  1254. compile endif
  1255.   '0'
  1256. compile if EVERSION >= '4.10'
  1257.   GETSEARCH search_command -- Save user's search command.
  1258.  compile if EVERSION >= 5
  1259.       display -2              -- disable display of nonfatal error messages
  1260.  compile endif
  1261. compile endif
  1262.   if hostfileid then
  1263.      'xcom l ?'hostfileid' /?'
  1264.   else
  1265.      'xcom l /'hostfilename
  1266.   endif
  1267.   found = rc<> -273 -- sayerror('String not found')        --LAM
  1268. compile if EVERSION >= '4.10'
  1269.  compile if EVERSION >= 5
  1270.       display 2               -- reenable display of nonfatal error messages
  1271.  compile endif
  1272.   SETSEARCH search_command -- Restores user's command so Ctrl-F works.
  1273. compile endif
  1274. compile if DEBUG
  1275.   if found then
  1276.      getline line
  1277.      messagenwait('hidden info>>> 'line)
  1278.   endif
  1279. compile endif
  1280.  
  1281.  
  1282.  /* now see what we're supposed to do      */
  1283.  /* verbs are EDIT, NAME, QUIT, SAVE       */
  1284.  
  1285.   if verb='QUIT' then
  1286.      if found then
  1287.         getline line
  1288.         parse value line with . '/' . '/' tempfile .
  1289.         deleteline
  1290.      else
  1291.         tempfile = ''
  1292.      endif
  1293.   elseif verb='EDIT'  then
  1294.      if found then
  1295.         replaceline hostfileid' /'hostfilename' /'tempfile' /'hosttype' /'fto
  1296.      else
  1297.         top
  1298.         insertline  hostfileid' /'hostfilename' /'tempfile' /'hosttype' /'fto
  1299.      endif
  1300.      set_FTO(hostfilename, bin, fto)
  1301.   elseif verb='NAME' then
  1302.      if found then
  1303.         getline line                                 -- use file transfer opts
  1304.         parse value line with . '/' . '/' . '/' oldhosttype '/' hidden_fto       -- kept in entry.
  1305.         if not fto then
  1306. compile if USING='CM+IBM'
  1307.            if hosttype<>oldhosttype then  -- Old ft options no good;
  1308.               set_FTO(newname, bin, fto)    -- set to default.
  1309.            else
  1310. compile endif -- USING='CM+IBM'
  1311.               fto=hidden_fto                -- Use the FTO from the hidden file.
  1312. compile if USING='CM+IBM'
  1313.            endif
  1314. compile endif -- USING='CM+IBM'
  1315.         endif
  1316.         replaceline hostfileid' /'newname' /'tempfile' /'hosttype' /'fto
  1317.      else
  1318.         top
  1319.         insertline  hostfileid' /'newname' /'tempfile' /'hosttype' /'fto
  1320.      endif
  1321. ;;   set_FTO(hostfilename, bin, fto)  -- 93/08: No reason for this when 'NAME'.
  1322.   elseif verb='SAVE' then
  1323.      if found then
  1324.         getline line                                 -- use file transfer opts
  1325.         parse value line with . '/' . '/' . '/' . '/' hidden_fto       -- kept in entry.
  1326.         if not fto then fto=hidden_fto endif
  1327.      else
  1328.         top
  1329.         insertline  hostfileid' /'hostfilename' /'tempfile' /'hosttype' /'fto
  1330.      endif
  1331.      set_FTO(hostfilename, bin, fto, savefileid)
  1332.   endif
  1333.  
  1334. compile if DEBUG
  1335.    messagenwait('hid says: 'hostfileid hostfilename tempfile fto hosttype verb bin)
  1336. compile endif
  1337.  
  1338.   activatefile savefileid
  1339. compile if EVERSION < 5
  1340.   sayerror 0
  1341. compile endif
  1342.   rc = save_rc
  1343.  
  1344.  
  1345. defproc set_FTO(hostfile, bin, var fto)  -- called by hidden_info, loadfile
  1346.   universal emulator, ftoptions, binoptions
  1347. compile if WANT_DBCS_SUPPORT
  1348.   universal country, codepage, ondbcs
  1349. compile endif
  1350.  
  1351.   fto = strip(fto)
  1352.   if not fto then
  1353. compile if USING='CM+CP78' | USING='CM+IBM'
  1354.      if bin then
  1355.         if emulator='CM' then
  1356.            fto='/q /b'
  1357.         else
  1358.  compile if USING='CM+IBM'
  1359.   compile if USE_EHLLAPI
  1360.            fto = ''                     -- Omit redirection if EPM (uses EHLLAPI)
  1361.   compile else
  1362.            fto = '() >nul'
  1363.   compile endif
  1364.  compile else  -- else USING='CM+CP78'
  1365.            fto='BIN Q'
  1366.  compile endif
  1367.         endif
  1368.      else
  1369.         if emulator='CM' then
  1370.            fto='/q /ascii'
  1371.         else
  1372.  compile if USING='CM+IBM'
  1373.   compile if USE_EHLLAPI
  1374.           fto = 'ASCII CRLF'            -- Omit redirection if EPM (uses EHLLAPI)
  1375.   compile else
  1376.           fto = 'ASCII CRLF >nul'       -- The minimum for IBM emulators
  1377.   compile endif
  1378.  compile else  -- else USING='CM+CP78'
  1379.            fto='ASC Q'
  1380.  compile endif
  1381.         endif
  1382.      endif
  1383. compile else
  1384.      if bin then
  1385.         fto=binoptions
  1386.      else
  1387.         fto=ftoptions
  1388.      endif
  1389. compile endif
  1390.   endif
  1391.  
  1392. compile if CALL_USER_FTO
  1393.    if arg(4) then
  1394.       call user_FTO(hostfile, fto, 'SAVE')
  1395.    endif
  1396. compile endif
  1397.  
  1398.   if emulator='IBM' | emulator='CP78' then
  1399. compile if MVS or E3MVS
  1400.      if not pos(')', hostfile) then  -- Only add RECFM or LRECL if not a PDS member
  1401. compile endif
  1402.         -- For ASCII upload, add LRECL 255 (avoid "Some records were segmented.").
  1403.         if arg(4) & not bin & not pos('LRECL',fto) then  -- Add iff SEND (i.e., arg(4)=1)
  1404. compile if MVS or E3MVS
  1405.            if pos('.', hostfile) then     -- MVS file
  1406. ;;            fto='LRECL(255) 'strip(fto,'l','(')  -- Do nothing for MVS files.
  1407.            else
  1408. compile endif
  1409. compile if EVERSION > 5  -- Only EPM has longestline()
  1410.               getfileid fto_fid
  1411.               savefileid = arg(4)
  1412.               activatefile savefileid
  1413.               if longestline() > 80 then
  1414. compile endif
  1415.                  fto='LRECL 255 'strip(fto,'l','(')
  1416. compile if EVERSION > 5
  1417.               endif
  1418.               activatefile fto_fid
  1419. compile endif
  1420. compile if MVS or E3MVS
  1421.            endif  -- pos('.'
  1422. compile endif
  1423.         endif
  1424.         -- For binary upload, add RECFM V (avoid padding last record so CRCs will match).
  1425.         if arg(4) & bin & not pos('RECFM',fto) then     -- Add iff SEND (i.e., arg(4)=1)
  1426.            fto='RECFM V 'strip(fto,'l','(')
  1427.         endif
  1428. compile if MVS or E3MVS
  1429.      endif  -- not pos(')'
  1430.      if not pos('.', hostfile) then     -- VM file
  1431. compile endif
  1432.         if substr(fto,1,1)<>'(' then fto='('fto; endif
  1433. compile if WANT_DBCS_SUPPORT & 0  -- @DBCS_FIX
  1434.         if pos(codepage, 932 942) & not pos('[',fto) then
  1435.            fto='['fto
  1436.         endif
  1437. compile endif
  1438. compile if MVS or E3MVS
  1439.      else
  1440.         fto = strip(strip(fto,'t',')'),'l','(')  -- remove leading '(' & trailing ')'
  1441.      endif
  1442. compile endif
  1443.   endif
  1444.  
  1445. compile if DEBUG
  1446. ;  messagenwait('FTO will be: 'fto)
  1447. compile endif
  1448.  
  1449.  
  1450.  
  1451. defproc setLT(var LT_to_use)
  1452.   universal LT, emulator
  1453.  
  1454.   if not LT_to_use then
  1455.      LT_to_use = LT||':'
  1456.   else
  1457.      LT_to_use = LT_to_use||':'
  1458.   endif
  1459.  
  1460. compile if DEBUG
  1461.   messagenwait('LT set to: 'LT_to_use)
  1462. compile endif
  1463.  
  1464.  
  1465.  
  1466. defproc check_savepath()     -- Larry Margolis - MARGOLI at YORKTOWN
  1467.    universal savepath
  1468.  
  1469. compile if BACKUP_PATH <> '' & BACKUP_PATH <> '='
  1470.    universal backup_path_ok
  1471.  compile if EVERSION >= '5.17'
  1472.    if rightstr(BACKUP_PATH,1)<>'\' then
  1473.  compile else
  1474.    if substr(BACKUP_PATH,length(BACKUP_PATH),1)<>'\' then
  1475.  compile endif
  1476.       messageNwait(BACKUP_PATH_INVALID_NO_BACKSLASH__MSG'  'NO_BACKUPS__MSG)
  1477.    else
  1478.       curpath=directory()                                     -- get current disk
  1479.       rc = 0
  1480.       call directory(substr(BACKUP_PATH,1,length(BACKUP_PATH)-1))    -- set to BACKUP_PATH
  1481.       if rc=-15 then  -- sayerror('Invalid drive')
  1482.          bad=DRIVE__MSG                                            -- did we set?
  1483.       elseif rc=-3 then  -- sayerror('Path not found')
  1484.          bad=PATH__MSG
  1485.       endif
  1486.       if rc then                                 -- didn't set - BACKUP_PATH invalid
  1487.          messageNwait(BACKUP_PATH_INVALID1__MSG bad'.  'NO_BACKUPS__MSG)
  1488.       else
  1489.          backup_path_ok = 1
  1490.       endif
  1491.       call directory(curpath)  -- Restore original directory
  1492.    endif
  1493. compile endif  -- BACKUP_PATH
  1494.  
  1495.    if savepath='' then
  1496.       savepath=directory()
  1497.       if length(savepath)>3 then savepath=savepath'\'; endif   -- if not 'C:\'
  1498. ;     sayerror SAVEPATH_NULL__MSG
  1499.       return 0
  1500.    endif
  1501.  
  1502. compile if EVERSION >= '5.17'
  1503.    if rightstr(savepath,1)<>'\' then
  1504. compile else
  1505.    if substr(savepath,length(savepath),1)<>'\' then
  1506. compile endif
  1507.       savepath = savepath'\'
  1508.    endif
  1509.  
  1510.    curpath=directory()                                     -- get current disk
  1511.    rc = 0
  1512.    call directory(substr(savepath,1,length(savepath)-1))    -- set to savepath
  1513.    if rc=-15 then  -- sayerror('Invalid drive')
  1514.       bad=DRIVE__MSG                                            -- did we set?
  1515.    elseif rc=-3 then  -- sayerror('Path not found')
  1516.       bad=PATH__MSG
  1517.    endif
  1518.    if rc then                                 -- didn't set - savepath invalid
  1519.       sayerror(SAVEPATH_INVALID1__MSG bad SAVEPATH_INVALID2__MSG)
  1520.       savepath = substr(curpath,1,3)  -- 'C:\'
  1521.    endif
  1522.    call directory(curpath)  -- Restore original directory
  1523.  
  1524.  
  1525. ; This procedure referenced only in SELECT.E - this one works with E3REXKEY
  1526. ; to allow syntax directed editing for EXEC or XEDIT files.
  1527. ;
  1528. ; Gracias, Ken Kahn for the updated code for MVS users
  1529. ;
  1530. ; Also works without E3REXKEY to provide syntax directed editing for files
  1531. ; that have the filetype EBIN, CBIN or PASBIN
  1532.  
  1533. defproc filetype()
  1534.    universal hostdrive
  1535.  
  1536.    filename=arg(1)
  1537.    if filename='' then filename=.filename; endif
  1538.    filename = upcase(filename)
  1539. compile if (MVS | E3MVS)
  1540.  compile if HOST_LT_REQUIRED
  1541.    isa_host_file = substr(filename,1,1)=hostdrive & substr(filename,3,1)=':'
  1542.  compile elseif HOSTDRIVE_REQUIRED
  1543.    isa_host_file = substr(filename,1,1)=hostdrive & pos(':', substr(filename,2,3))
  1544.  compile endif
  1545. compile endif
  1546. ;        -- LAM - '.' is allowed in PC path name.  Not sure how this affects
  1547. ;                 MVS check.
  1548.    i=lastpos('\',filename)
  1549.    if i then
  1550.       filename=substr(filename,i+1)
  1551.    endif
  1552. ;         -- LAM - end
  1553.    i=lastpos('.',filename)
  1554.    j=pos('.', filename)
  1555.    if i then                             -- PC or MVS
  1556.       PCext = substr(filename,i+1)
  1557. compile if (MVS | E3MVS)
  1558.  compile if HOST_LT_REQUIRED | HOSTDRIVE_REQUIRED
  1559.       if isa_host_file then
  1560.  compile else
  1561.       if (i>j)            |
  1562.          (Pos('(',PCext)) |
  1563.          (Pos("'",PCext)) |
  1564.          (Length(PCext) > 3) then
  1565.  compile endif
  1566.         return breakout_mvs(filename,PCext)     -- MVS
  1567.       endif
  1568. compile endif
  1569.       return PCext                       -- PC
  1570.    else                                  -- PC (no ext) or VM
  1571.       return breakout_vm(filename)        -- handles both
  1572.    endif
  1573.  
  1574.  
  1575. compile if (MVS | E3MVS)
  1576. DefProc breakout_mvs(filename,LastQual)
  1577.    i = Pos('(',LastQual)
  1578.    If i then
  1579.       LastQual = SubStr(LastQual,1,i-1)
  1580.    EndIf
  1581.  
  1582.    if lastqual='PASCAL' then
  1583.       return 'PAS'
  1584.    endif
  1585.    if lastqual='C' then
  1586.       return 'C'
  1587.    endif
  1588. compile endif
  1589.  
  1590.  
  1591. defproc breakout_vm(filename)
  1592.    if verify(filename,' ','m') then
  1593.       parse value filename with . ftype .
  1594.       i = lastpos('BIN',ftype)
  1595.       if i then
  1596.          return substr(ftype,1,i-1)
  1597.       endif
  1598.       return ftype
  1599.    endif
  1600.  
  1601.  
  1602. defproc vmfile(var name, var cmdline)
  1603. compile if VM  -- procedure defined even if no VM - makes defc EDIT simpler.
  1604.    universal hostdrive
  1605.  
  1606.  compile if HOST_LT_REQUIRED
  1607.    if upcase(substr(name,1,1))<>hostdrive | substr(name,3,1)<>':' then return 0; endif
  1608.  compile elseif HOSTDRIVE_REQUIRED
  1609.    if upcase(substr(name,1,1))<>hostdrive | pos(':',substr(name,2,2))=0 then return 0; endif
  1610.  compile endif
  1611.  
  1612.    parse value name with fn ft fm cmdline
  1613.    if fn='' or ft='' or length(fn)>11 or pos('\',fn) or pos('.',fn) or
  1614.       length(ft)>8 or pos(':',ft) or pos('\',ft) or pos('.',ft) then
  1615.      return 0
  1616.    endif
  1617.  
  1618.    if (not fm) or length(fm)>2 or
  1619.       pos(':',fm) or pos('\',fm) or pos('.',fm) then
  1620.      cmdline = fm cmdline               -- assumption here:  VM if two
  1621.      name = fn ft
  1622.      return 1
  1623.    endif
  1624.  
  1625.    name = fn ft fm
  1626.    return 1                              --better be VM at this point
  1627. compile else
  1628.    return 0
  1629. compile endif
  1630.  
  1631. /**************************************************************************/
  1632. /*                                                                        */
  1633. /*   commands for changing variable values                                */
  1634. /*                                                                        */
  1635. /**************************************************************************/
  1636.  
  1637. compile if RUNTIME
  1638.  
  1639. defc em, emulator=
  1640.   universal hostcopy, LT, hostcmd, emulator
  1641.  
  1642.   uparg = upcase(arg(1))
  1643.   if uparg = 'IBM' then
  1644.      emulator = 'IBM'
  1645.      hostcopy = ''
  1646. compile if EPM
  1647.      hostcmd = 'EHLLAPI'
  1648. compile elseif EOS2
  1649.      hostcmd = 'os2cmd'
  1650. compile else
  1651.      hostcmd = 'hostsys'
  1652. compile endif
  1653.      sayerror EMULATOR_SET_TO__MSG uparg LT_NOW__MSG LT')'
  1654. compile if EVERSION >= 4      -- OS/2-only emulators
  1655.   elseif uparg = 'CP78' then
  1656.      emulator = 'CP78'
  1657. ;    hostcopy = 'cp78copy'
  1658. ;    hostcmd = 'cp78cmd'
  1659.      hostcopy = ''
  1660. compile if EVERSION >= 4
  1661.      hostcmd = 'os2cmd'
  1662. compile else
  1663.      hostcmd = 'hostsys'
  1664. compile endif
  1665.      LT = ''
  1666.      sayerror EMULATOR_SET_TO__MSG uparg
  1667.   elseif uparg = 'CM' then
  1668.      emulator = 'CM'
  1669.      hostcopy = 'almcopy'
  1670.      hostcmd = 'os2cmd'
  1671.      sayerror EMULATOR_SET_TO__MSG uparg LT_NOW__MSG LT')'
  1672. compile else                  -- DOS-only emulators
  1673.   elseif uparg='BOND' then
  1674.      emulator = 'BOND'
  1675.      hostcopy = 'bondcopy'
  1676.      hostcmd = 'bondcmd'
  1677.      LT = ''
  1678.      sayerror EMULATOR_SET_TO__MSG uparg
  1679.   elseif uparg = 'MYTE' then
  1680.      emulator = 'MYTE'
  1681.      hostcopy = 'mytecopy'
  1682.      hostcmd = 'mytecmd'
  1683.      sayerror EMULATOR_SET_TO__MSG uparg LT_NOW__MSG LT')'
  1684.   elseif uparg = 'E78' then
  1685.      emulator = 'E78'
  1686.      hostcopy = 'e78copy'
  1687.      hostcmd = 'e78cmd'
  1688.      LT = ''
  1689.      sayerror EMULATOR_SET_TO__MSG uparg
  1690. compile endif                 -- End of OS-specific emulators
  1691.   elseif not uparg then
  1692. compile if EVERSION < 5
  1693.      setcommand EMULATOR__MSG emulator,10,1         --LAM
  1694. compile else
  1695.      'commandline' EMULATOR__MSG emulator
  1696. compile endif
  1697.   else
  1698. compile if EVERSION >= 4      -- OS/2-only emulators
  1699.      sayerror '('uparg')' IS_INVALID_OPTS_ARE__MSG 'IBM, CM, CP78'
  1700. compile else                  -- DOS-only emulators
  1701.      sayerror '('uparg')' IS_INVALID_OPTS_ARE__MSG 'BOND, MYTE, E78, IBM'
  1702. compile endif                 -- End of OS-specific emulators
  1703.      stop
  1704.   endif
  1705.  
  1706.  
  1707. defc lt=
  1708.   universal LT
  1709.  
  1710.   uparg = upcase(arg(1))
  1711.   if verify(uparg,'ABCDEFGH','M',1) and length(uparg) = 1 then
  1712.     LT = uparg
  1713.     sayerror LT_SET_TO__MSG LT
  1714.   elseif uparg = 'NO_LT' or uparg = 'NONE' or uparg = 'NULL' then
  1715.     LT = ''
  1716.     sayerror LT_SET_NULL__MSG
  1717.   elseif not uparg then
  1718. compile if EVERSION < 5
  1719.     message('LT used only for CM, MYTE and IBM with >1 host session...')
  1720. compile endif
  1721.     if not LT then   --changed for space
  1722. compile if EVERSION < 5
  1723.        setcommand 'LT No_LT',4,1
  1724. compile else
  1725.        'commandline LT No_LT'
  1726. compile endif
  1727.     else
  1728. compile if EVERSION < 5
  1729.        setcommand 'LT 'LT,4,1
  1730. compile else
  1731.        'commandline LT 'LT
  1732. compile endif
  1733.     endif
  1734.   else
  1735.     sayerror '('uparg')' LT_INVALID__MSG
  1736.     stop
  1737.   endif
  1738.  
  1739.  
  1740. defc hd, hostdrive=
  1741.   universal hostdrive
  1742.  
  1743.   uparg = upcase(arg(1))
  1744.   if verify(uparg,'ABCDEFGHIJKLMNOPQRSTUVWXYZ','M',1) and length(uparg)=1 then
  1745.     hostdrive = uparg
  1746.     sayerror HOSTDRIVE_NOW__MSG hostdrive
  1747.   elseif not uparg then  -- changed for space
  1748. compile if EVERSION < 5
  1749.     setcommand 'HD 'hostdrive,4,1
  1750. compile else
  1751.     'commandline HD 'hostdrive
  1752. compile endif
  1753.   else
  1754.     sayerror '('uparg')' IS_INVALID_OPTS_ARE__MSG 'A - Z'
  1755.     stop
  1756.   endif
  1757.  
  1758.  
  1759. defc savepath =
  1760.   universal savepath
  1761.  
  1762.   uparg = upcase(arg(1))
  1763.   if not uparg  then  -- changed for space
  1764. compile if EVERSION < 5
  1765.     setcommand 'SAVEPATH 'savepath,10,1
  1766. compile else
  1767.     'commandline SAVEPATH 'savepath
  1768. compile endif
  1769.   else
  1770.     savepath = uparg
  1771.     call check_savepath(TRY_AGAIN__MSG)
  1772.   endif
  1773.  
  1774. compile endif  -- RUNTIME
  1775.  
  1776. defc fto=
  1777.   universal ftoptions
  1778.  
  1779.   uparg = upcase(arg(1))
  1780.   if not uparg then -- changed for space         -- tell 'em the default
  1781. compile if EVERSION < 5
  1782.     setcommand 'FTO 'ftoptions,5,1
  1783. compile else
  1784.     'commandline FTO 'ftoptions
  1785. compile endif
  1786.   else
  1787.     ftoptions = uparg
  1788.     sayerror FTO_WARN__MSG
  1789.   endif
  1790.  
  1791. defc bin=
  1792.   universal binoptions
  1793.  
  1794.   uparg = upcase(arg(1))
  1795.   if uparg=='' then                             -- tell 'em the default
  1796. compile if EVERSION < 5
  1797.     setcommand 'BIN 'binoptions,5,1
  1798. compile else
  1799.     'commandline BIN 'binoptions
  1800. compile endif
  1801.   else
  1802.     binoptions = uparg
  1803.     sayerror BIN_WARN__MSG
  1804.   endif
  1805.  
  1806. compile if EPM  -- SEND & RECEIVE don't work from a PM window, so call via EHLLAPI.
  1807. ; Following is a common call for Send or Receive.  It does a Set Session Parms
  1808. ; to 'QUIET', sets up the parameters the way EMUL_HLLAPI wants (VAR parameters)
  1809. ; and issues the call.
  1810. defproc EHLLAPI_SEND_RECEIVE(function, parms)
  1811. universal ondbcs                              -- @DBCS_FIX
  1812.    if ondbcs then
  1813.        parse value parms with f '(' o
  1814.        parms = f '[(' o
  1815.    endif                                      -- end DBCS_FIX
  1816.    if function=90 or function=91 then
  1817.       call EHLLAPI_SEND_RECEIVE(9, 'QUIET TIMEOUT=2')
  1818. compile if DEBUG
  1819.       messagenwait('Calling function' function' "'parms'"')
  1820. compile endif
  1821.    endif
  1822. compile if not DEBUG
  1823.    if echo() then  -- Since user wouldn't see this echoed, let's say it explicitly...
  1824.       messagenwait('EHLLAPI_SEND_RECEIVE('function', "'parms'")')
  1825.    endif
  1826. compile endif
  1827.    EHLLAPI_data_string_length = atoi(length(parms)) -- Data string length
  1828.    EHLLAPI_host_PS_position = atoi(0)
  1829.    result=HLLAPI_call(atoi(function), selector(parms), offset(parms),
  1830.                  EHLLAPI_data_string_length, EHLLAPI_host_PS_position)
  1831.    if result=3 | result=4 then return 0; endif  -- 3=File Transfer complete;
  1832.    return result                                -- 4= Complete with segmented records.
  1833.  
  1834. ; HLLAPI_call is our general interface for calling the EHLLAPI dynalink.
  1835. ; Parameters are always the same - an EHLLAPI function number, selector of
  1836. ; the data string, offset of the data string, the data string length, and
  1837. ; the host presentation space position.  They might not be used in all calls,
  1838. ; but EHLLAPI requires that they all be present.
  1839. ;
  1840. ; The data string is passed via selector and offset rather than as a VAR string,
  1841. ; since some calls (e.g., copying the entire host screen) require a string
  1842. ; larger than 255 bytes, and so we must allocate a buffer and pass that.
  1843. ; Note:  This is not taken advantage of in E3EMUL.E, but it's a small cost to
  1844. ; make it available to others, instead of having to duplicate the whole function.
  1845. defproc HLLAPI_call(EHLLAPI_function_number,
  1846.                     sel_EHLLAPI_data_string, ofs_EHLLAPI_data_string,
  1847.                 var EHLLAPI_data_string_length, -- Data str. len. or buffer size
  1848.                 var EHLLAPI_host_PS_position)   -- Host presentation space posn.
  1849.                                                 -- (on return, RC)
  1850.    rc = 0        -- Prepare for missing DLL library
  1851.  compile if EPM32
  1852.    result=dynalink('ACS3EHAP',                  -- dynamic link library name
  1853.                    'HLLAPI',                    -- HLLAPI direct call
  1854.                     Thunk(offset(EHLLAPI_function_number)    || selector(EHLLAPI_function_number))    ||
  1855.                     Thunk(ofs_EHLLAPI_data_string            || sel_EHLLAPI_data_string)              ||
  1856.                     Thunk(offset(EHLLAPI_data_string_length) || selector(EHLLAPI_data_string_length)) ||
  1857.                     Thunk(offset(EHLLAPI_host_PS_position)   || selector(EHLLAPI_host_PS_position)) )
  1858.  compile else
  1859.    result=dynalink('ACS3EHAP',                  -- dynamic link library name
  1860.                    'HLLAPI',                    -- HLLAPI direct call
  1861.                    address(EHLLAPI_function_number)     ||
  1862.                    sel_EHLLAPI_data_string              ||
  1863.                    ofs_EHLLAPI_data_string              ||
  1864.                    address(EHLLAPI_data_string_length)  ||
  1865.                    address(EHLLAPI_host_PS_position))
  1866.  compile endif
  1867.    if rc then sayerror ERROR__MSG rc FROM_HLLAPI__MSG; stop; endif
  1868.    return result
  1869.  
  1870. ; A simpler EHLLAPI interface - just pass a function number and data string.
  1871. ; The third and fourth parameters are optional.  Can not be used for calls
  1872. ; which return data in the data string.
  1873. defproc simple_HLLAPI_call(EHLLAPI_function_number, EHLLAPI_data_string)
  1874.    if arg(3)='' then
  1875.       EHLLAPI_data_string_length = atoi(length(EHLLAPI_data_string))
  1876.    else
  1877.       EHLLAPI_data_string_length = atoi(arg(3))
  1878.    endif
  1879.    if arg(4)='' then
  1880.       EHLLAPI_host_PS_position = atoi(0)
  1881.    else
  1882.       EHLLAPI_host_PS_position = atoi(arg(4))
  1883.    endif
  1884.    return HLLAPI_call(atoi(EHLLAPI_function_number),
  1885.                       selector(EHLLAPI_data_string), offset(EHLLAPI_data_string),
  1886.                       EHLLAPI_data_string_length, EHLLAPI_host_PS_position)
  1887. compile endif -- EPM
  1888.