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