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