-- Em3270UserInputPack: 3270 Emulation Window
-- Revised for Star 3.2IKlamath by Irani: 20-Dec-83 10:46:19
-- Owner: Lui
-- Overview:
-- This module handles all user initiated actions coming into the Emulator from the Notifier.
DIRECTORY
AreaDefs USING [Posn],
CharDefs USING [Char, Roman],
Em3270CmdProcessDefs USING [setBufferAddress],
Em3270ComDefs USING [DoStreamPut],
Em3270Defs,
Em3270PrivDefs,
Em3270BufferDefs USING [
BackSpaceKey, BackTabKey, ClearBuffer, DeleteKey, DisplayBuffer, DuplicateKey,
EnumFields, EraseEOFKey, EraseInputKey, FieldMarkKey, GetCursor, HomeKey,
NewLineKey, Release, Reserve, PutChar, SetCursor, TabKey, WriteError],
Em3270CharTransDefs USING [EBCDICFromOISChar, ExpandLegalDeadchar],
Em3270UserInputDefs,
Em3270StatusDefs USING [ClearStatusArea, DisplayCode],
GateStream USING [readModified3270, testRequest3270],
MessageSwnDefs USING [DisplayMessage],
McDefs USING [SetDefaultShape, SetStandardShape],
NfrDefs USING [CancelMCS],
NtDefs,
RgnDefs USING [Aqrgn, FreeRest, Rgn, Sc],
SchemaDefs USING [
AqrgnBkgdUtilStd, CancelMCS, GetRootCs, Lschema,
lschemaNil, NewTrackUtilStd, PBRequest, ProcessButNopAbortMCSOnButtonUpStd,
Pvprocessbut, Resolveresult, ResolveToChildExactly, Sel],
SchemaUtilDefs USING [AddScs, AddScToPosn, ScInRgn],
SelectionDefs USING [DeselectCs, selNil, SetCs],
StandardDefs USING [Bv, Ch, Cv, String],
Stream,
TraitDefs USING [MyData],
TreeEltDefs USING [ctxtNil],
TxtDefs USING [Flow, flowNil, seldescNil, TextSegment, textSegmentNil],
TxtEditDefs USING [
AdjustDeleteSpan, AlterCurrentSelection, Aqrehilitespec, AqTxtCtxt, BeginEdit,
CopyTextSegment, Delete, DestroyTextSegment, EndEdit, LptSelDescription, Rehilite,
SelectionDescription, Seldesc, seltypeText, TxtCtxt],
TxtFlowDefs USING [AdvanceCharacter, CharacterCurrent, Create, Destroy],
VDTDefs USING [
CharPos, GetCursorShape, LschemaVDT, SetCursorShape, TrackButton],
WSCharDefs USING [Character],
WSStringDefs USING [
Aqscanctxt, BeginForwardScan, CharCur, EndScan, ScanForward, Substring],
ZoneMgrDefs USING [GetPredefinedZone];
Em3270UserInputPack: PROGRAM
IMPORTS
CharDefs, Em3270BufferDefs, Em3270CharTransDefs, Em3270ComDefs,
Em3270PrivDefs, Em3270StatusDefs, McDefs, MessageSwnDefs, NfrDefs, RgnDefs, SchemaDefs,
SchemaUtilDefs, SelectionDefs, TraitDefs, TxtEditDefs, TxtFlowDefs, VDTDefs, WSStringDefs,
ZoneMgrDefs
EXPORTS Em3270UserInputDefs
SHARES SchemaDefs =
BEGIN OPEN Em3270Defs, Em3270PrivDefs, Em3270UserInputDefs, StandardDefs;
--===================
-- Types
--===================
--===================
-- Signals and Errors
--===================
--===================
-- Constants
--===================
--===================
-- Global Variables
--===================
bvStreamOn: Bv ← TRUE; -- for testing purposes without a stream connection +++
spredefinedZone: UNCOUNTED ZONE ← ZoneMgrDefs.GetPredefinedZone[short];
-- Set up 3270-unique key processor for all instances of the 3270 Emulator
keyProcessor: KeyProcessor ← [
special3270Alpha: NoImpl, special3270AltCursor: AltCursor,
special3270BackSpace: MoveCursor, special3270BackTab: MoveCursor,
special3270Click: NoImpl, special3270Clear: Aid, special3270Copy: NoImpl,
special3270CursorBlink: NoImpl, special3270CursorSel: Aid,
special3270Delete: Delete, special3270Duplicate: Duplicate,
special3270Enter: Aid, special3270EraseEOF: EraseEOF,
special3270EraseInput: EraseInput, special3270FieldMark: FieldMark,
special3270Home: MoveCursor, special3270Ident: NoImpl,
special3270InsertMode: InsertMode, special3270NewLine: MoveCursor,
special3270NumericDown: NoImpl, special3270NumericLockDown: NoImpl,
special3270NumericLockUp: NoImpl, special3270NumericUp: NoImpl,
special3270PA1: Aid, special3270PA2: Aid, special3270PF1: Aid,
special3270PF2: Aid, special3270PF3: Aid, special3270PF4: Aid,
special3270PF5: Aid, special3270PF6: Aid, special3270PF7: Aid,
special3270PF8: Aid, special3270PF9: Aid, special3270PF10: Aid,
special3270PF11: Aid, special3270PF12: Aid, special3270Reset: Reset,
special3270ShiftDown: EnableShift, special3270ShiftLockDown: EnableShift,
special3270ShiftLockUp: DisableShift, special3270ShiftUp: DisableShift,
special3270SysReq: Aid, special3270Tab: MoveCursor, special3270TestReq: Aid];
-- Binary to EBCDIC Buffer address conversion table
convertAddr: PACKED ARRAY [0..64) OF CHARACTER ← [
100C, -- 40 Hex
301C, 302C, 303C, 304C, 305C, 306C, 307C, 310C, 311C, -- C1 to C9 Hex
112C, 113C, 114C, 115C, 116C, 117C, 120C, -- 4A to 4F, 50 Hex
321C, 322C, 323C, 324C, 325C, 326C, 327C, 330C, 331C, -- D1 to D9 Hex
132C, 133C, 134C, 135C, 136C, 137C, 140C, 141C, -- 5A to 5F, 60, 61 Hex
342C, 343C, 344C, 345C, 346C, 347C, 350C, 351C, -- E2 to E9 Hex
152C, 153C, 154C, 155C, 156C, 157C, -- 6A to 6F, Hex
360C, 361C, 362C, 363C, 364C, 365C, 366C, 367C, 370C, 371C, -- F0 to F9 Hex
172C, 173C, 174C, 175C, 176C, 177C]; -- 7A to 7F, Hex
--===================
-- Private Procedures Define all the types of key processors here
--===================
Aid: KeyProc = -- set up AID stream, inhibit input, send stream to host
-- PROC[lschema:SchemaDefs.Lschema, key:NtDefs.Special3270Key];
BEGIN
lptPutBuf: LptBufOfChar ← GetMDTStream[lschema].lptbuf;
buffer: LptBufferData ← GetBufferHandle[lschema];
SetInputStatus[lschema, inputInhibited]; -- all AID keyes (except CLEAR) lock up the emulator
Em3270StatusDefs.DisplayCode[lschema: lschema, code: time, bvOn: TRUE]; -- turn on wait status
SELECT key FROM
--special3270CursorSel=> DoCursorSel[lschema, buffer, lptPutBuf];
special3270Enter => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[enter]];
special3270PA1 => DoShortRd[lschema, lptPutBuf, AIDCodes[PA1]];
special3270PA2 => DoShortRd[lschema, lptPutBuf, AIDCodes[PA2]];
special3270PF1 => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[PF1]];
special3270PF2 => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[PF2]];
special3270PF3 => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[PF3]];
special3270PF4 => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[PF4]];
special3270PF5 => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[PF5]];
special3270PF6 => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[PF6]];
special3270PF7 => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[PF7]];
special3270PF8 => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[PF8]];
special3270PF9 => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[PF9]];
special3270PF10 => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[PF10]];
special3270PF11 => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[PF11]];
special3270PF12 => DoReadMod[lschema, buffer, lptPutBuf, AIDCodes[PF12]];
special3270SysReq => DoTestReq[lschema, buffer, lptPutBuf];
special3270TestReq => DoTestReq[lschema, buffer, lptPutBuf];
special3270Clear => {
Em3270BufferDefs.ClearBuffer[buffer];
Em3270BufferDefs.DisplayBuffer[buffer];
DoShortRd[lschema, lptPutBuf, AIDCodes[clear]];
};
ENDCASE => ERROR; -- should never get here; this is a non-AID key
SetAIDStatus[lschema, FALSE]; -- set the AID. Can only be reset if the next WCC byte from host is unlock keyboard, or when user hit the RESET key. (use for Read modified commnads)
-- Note that we do NOT clear input inhibited here because we assume the host will respond to the AID with a WCC bit set to clear it.
Em3270StatusDefs.DisplayCode[lschema: lschema, code: insert, bvOn: FALSE]; -- turn off insert status (if present)
END; -- of Aid
AltCursor: KeyProc = -- toggles cursor between rectangle and underscore
BEGIN
display: VDTDefs.LschemaVDT ← GetDisplayHandle[lschema];
VDTDefs.SetCursorShape[display,
(SELECT VDTDefs.GetCursorShape[display] FROM
underscore => box,
box => underscore,
ghostunderscore => ghostbox,
ghostbox => ghostunderscore,
invisible => invisible,
blinkunderscore => blinkbox,
blinkbox => blinkunderscore,
ENDCASE => box)]; -- toggle shape
END; -- of AltCursor
Delete: KeyProc =
-- Delete the character pointed to by the cursor.
-- If cursor is on an unprotected character
-- THEN delete char, shifts left, fills with nulls, sets MDT, cursor does not move
-- ELSE inhibit keyboard and issue message
BEGIN
bufstatus: Em3270BufferDefs.WriteError ← Em3270BufferDefs.DeleteKey[GetBufferHandle[lschema]]; -- do Delete
IF bufstatus # okay THEN {SetInputInhibited[lschema]; DisplayBufferError[lschema, bufstatus]; };
END; -- of Delete
Duplicate: KeyProc =
-- puts a "unique code" into buffer at current cursor, performs Tab, sets MDT.
-- Dup char displays as "*" (with an overscore if 3278 is dual-case).
-- If cursor in protected field or attribute char, THEN inhibit keyboard and issue message
BEGIN
bufstatus: Em3270BufferDefs.WriteError ← Em3270BufferDefs.DuplicateKey[GetBufferHandle[lschema]]; -- do Dup Key
IF bufstatus # okay THEN {SetInputInhibited[lschema]; DisplayBufferError[lschema, bufstatus]; };
END; -- of Duplicate
EraseEOF: KeyProc =
-- if cursor is on an unprotected character
-- THEN clear from cursor to end of field, cursor doesn't move, MDT is set
-- ELSE inhibit keyboard and issue message
BEGIN
bufstatus: Em3270BufferDefs.WriteError ← Em3270BufferDefs.EraseEOFKey[GetBufferHandle[lschema]]; -- do Erase Field
IF bufstatus # okay THEN {SetInputInhibited[lschema]; DisplayBufferError[lschema, bufstatus]; };
END; -- of EraseEOF
EraseInput: KeyProc =
-- If formatted buffer
-- THEN IF all protected fields,
-- THEN only put cursor in home position
-- ELSE clear ALL unprotected fields, reset all MDTs, put cursor in 1st unprotected location
-- ELSE (unformatted) clear all buffer, put cursor in home position
BEGIN Em3270BufferDefs.EraseInputKey[GetBufferHandle[lschema]]; END; -- of EraseInput
FieldMark: KeyProc =
-- puts a "unique code" into buffer at current cursor, sets MDT.
-- FM char displays as ";" (with an overscore if 3278 is dual-case).
-- If cursor in protected field or attribute char, THEN inhibit keyboard and issue message
BEGIN
bufstatus: Em3270BufferDefs.WriteError ← Em3270BufferDefs.FieldMarkKey[GetBufferHandle[lschema]]; -- do Field Mark Key
IF bufstatus # okay THEN {SetInputInhibited[lschema]; DisplayBufferError[lschema, bufstatus]; };
END; -- of FieldMark
InsertMode: KeyProc =
-- Sets Insert mode.
-- IF cursor is in a field with at least one null in it,
-- THEN pressing any subsequent alphanumeric key inserts that character at the cursor and sets the MDT. Chars at cursor are shifted to the right one place and the field's ending null is removed.
-- ELSE (no nulls or on a attribute) inhibit keyboard and issue message.
-- Reset or any AID key exits insert mode.
BEGIN
SetInputStatus[lschema, insertMode]; -- set global emulator status to Insert Mode on
Em3270StatusDefs.DisplayCode[lschema: lschema, code: insert, bvOn: TRUE]; -- turn on insert status
END; -- of InsertMode
MoveCursor: KeyProc =
-- This routine is resonsible for positioning the cursor on the display according to the key value.
-- Note that backspace, newline,and tab will not really come through MoveCursor but will given to 3270 through SkipCursor ala ProcessFunRepeat. They are left here for safety sake in case the keyboard interrupter decids to give us these notification thru Process3270Keyes
BEGIN
SELECT key FROM
special3270BackSpace =>
Em3270BufferDefs.BackSpaceKey[my: GetBufferHandle[lschema]]; -- process BACKSPACE
special3270BackTab =>
Em3270BufferDefs.BackTabKey[my: GetBufferHandle[lschema]]; -- process BACKTAB
special3270Home => Em3270BufferDefs.HomeKey[my: GetBufferHandle[lschema]]; -- process HOME
special3270NewLine =>
Em3270BufferDefs.NewLineKey[my: GetBufferHandle[lschema]]; -- process NEWLINE
special3270Tab => Em3270BufferDefs.TabKey[my: GetBufferHandle[lschema]]; -- process TAB
ENDCASE;
END; -- of MoveCursor
NoImpl: KeyProc = -- This key value is not currently supported
BEGIN MessageSwnDefs.DisplayMessage[keyNotImplemented]; END; -- of NoImpl
Reset: PUBLIC KeyProc =
-- Resets Input Inhibited. Won't execute if:
-- 1. polled AID till poll is done. Otherwise cancels AID.
-- 2. a command is being executed.
BEGIN
SetInputStatus[lschema, systemAvailable]; -- set emulator globle status to available
-- Reset the status area normal symbols Ready, Online, and MyJob
Em3270StatusDefs.ClearStatusArea[lschema]; -- clear any status which could Inhibit Input
Em3270StatusDefs.DisplayCode[lschema, Ready3276];
Em3270StatusDefs.DisplayCode[lschema, onlineA];
Em3270StatusDefs.DisplayCode[lschema, myJob];
-- Reset the AID status. (use for Read Modified)
ResetAIDStatus[lschema]; -- => reset AID and free block
END; -- of Reset
EnableShift: KeyProc = -- Enters upper case mode. Clears shift lock.
BEGIN
Em3270StatusDefs.DisplayCode[lschema: lschema, code: upshift, bvOn: TRUE]; -- turn on shift status
END; -- of Shift
DisableShift: KeyProc = -- Sets shift lock.
BEGIN
Em3270StatusDefs.DisplayCode[lschema: lschema, code: upshift, bvOn: FALSE]; -- turn off shift status
END; -- of ShiftLock
--===================
-- Private Procedures Define all the indivigual "Do" processors here
--===================
DoReadMod: PUBLIC PROCEDURE [
lschema: SchemaDefs.Lschema, buffer: LptBufferData, lptPutBuf: LptBufOfChar,
aidCode: Ch, accessMode: AccessMode ← keyMode] =
-- This routine will enumerate through all the modified fields in the 3270 Buffer and build the output stream in lptPutBuf. It first puts the given AID code in followed by the current cursor address into the stream, then proceeds to enumerate all the modified fields. It assumes the Buffer has been Reserved previously.
BEGIN
putBuf: MDTStream ← [lptPutBuf, 0]; -- initialize output stream block descriptor
curAddr: VDTDefs.CharPos ← Em3270BufferDefs.GetCursor[buffer]; -- current cursor address
-- First put the AID code for ENTER followed by the current cursor address into the output stream
putBuf ← StoreByte[putBuf, aidCode]; -- EBCDIC AID header code
putBuf ← StoreByte[putBuf, convertAddr[curAddr/64]]; -- convert and store cursor high-order address
putBuf ← StoreByte[putBuf, convertAddr[curAddr MOD 64]]; -- convert and store cursor low-order address
-- Enumerate through all the modified fields
putBuf ← Em3270BufferDefs.EnumFields[
my: buffer, pvFieldHit: BuildFieldStream, clientData: putBuf, bvAll: FALSE, accessMode: accessMode];
-- enumerate all modified fields only
-- Send entire "Read Modified" stream to host
IF bvStreamOn THEN Em3270ComDefs.DoStreamPut[
my: GetComHandle[lschema], mdtStream: [lptPutBuf, putBuf.blkIx],
sstType: GateStream.readModified3270];
SetMDTStream[lschema, [lptPutBuf, putBuf.blkIx]];
END; -- of DoReadMod
DoShortRd: PROCEDURE [
lschema: SchemaDefs.Lschema, lptPutBuf: LptBufOfChar, aidCode: Ch] =
-- This routine will perform a "Short Read", which means it will sent just the AID to the host.
BEGIN
putBuf: MDTStream ← [lptPutBuf, 0]; -- initialize output stream block descriptor
-- Put given AID in stream buffer
putBuf ← StoreByte[putBuf, aidCode]; -- EBCDIC AID header code
IF bvStreamOn THEN Em3270ComDefs.DoStreamPut[
my: GetComHandle[lschema], mdtStream: [lptPutBuf, putBuf.blkIx],
sstType: GateStream.readModified3270];
SetMDTStream[lschema, [lptPutBuf, putBuf.blkIx]];
END; -- of DoShortRd
DoTestReq: PROCEDURE [
lschema: SchemaDefs.Lschema, buffer: LptBufferData, lptPutBuf: LptBufOfChar] =
-- This routine will perform a "Test Request Read", which means it will sent just the modified data fields excluding the three-byte header (AID + cursor address)
BEGIN
putBuf: MDTStream ← [lptPutBuf, 0]; -- initialize output stream block descriptor
Em3270StatusDefs.DisplayCode[lschema: lschema, code: test, bvOn: TRUE]; -- turn on wait status (WCC to turn it off)
-- Enumerate through all the modified fields
putBuf ← Em3270BufferDefs.EnumFields[
my: buffer, pvFieldHit: BuildFieldStream, clientData: putBuf, bvAll: FALSE];
-- enumerate all modified fields only
-- Send entire "Read Modified" stream to host
IF bvStreamOn THEN Em3270ComDefs.DoStreamPut[
my: GetComHandle[lschema], mdtStream: [lptPutBuf, putBuf.blkIx],
sstType: GateStream.testRequest3270];
SetMDTStream[lschema, [lptPutBuf, putBuf.blkIx]];
END; -- of DoTestReq
--===================
-- Utility Procedures
--===================
BuildFieldStream: PvFieldHit =
-- PROCEDURE[mainBuffer:VDTDefs.LptCharSeq, startPos:VDTDefs.CharPos, fLength:CARDINAL, clientData:MDTStream, bvIsNewField:Bv, lptToTransFile: BaseOISToEFile]
-- RETURNS[MDTStream];
-- This routine is called once for each "run" of text in a modified field. A "run" is all text between two attributes and/or nulls. Therefore, it may take several calles to BuildFieldStream to aquire one modified field, depending on how many nulls are imbedded in it. Typically, however, the run will be all text between the attribute character and the first null. If bvIsNewField is TRUE, THEN we must put the SBA/FWA-of-field header in the stream (startPos is pointing at a attribute+1), ELSE, it points to the next non-null portion of the current field and we just keep on processing non-null text.
BEGIN
-- Process order and attribute portion of the output stream
IF bvIsNewField THEN -- if called with the start of a new field
BEGIN
clientData ← StoreByte[clientData, Em3270CmdProcessDefs.setBufferAddress]; -- store Set Buffer Address Order
clientData ← StoreByte[clientData, convertAddr[startPos/64]]; -- convert/store attribute+1 high-order address
clientData ← StoreByte[clientData, convertAddr[startPos MOD 64]]; -- convert/store attribute+1 low-order address
END;
-- Process text/field portion of the output stream
UNTIL fLength = 0 DO
clientData ← StoreByte[
clientData, Em3270CharTransDefs.EBCDICFromOISChar[lptToTransFile, mainBuffer[startPos]]];
-- store text
startPos ← startPos + 1; -- increment source pointer
fLength ← fLength - 1;
ENDLOOP;
RETURN[clientData];
END; -- of BuildFieldStream
SetInputInhibited: PROCEDURE [lschema: SchemaDefs.Lschema] =
-- This routine will set the global emulator status to inputInhibited and display the systemLock sysbol.
BEGIN
SetInputStatus[lschema, inputInhibited];
Em3270StatusDefs.DisplayCode[lschema: lschema, code: systemLock, bvOn: TRUE];
-- turn on input inhibited status
END; -- of SetInputInhibited
StoreByte: PROCEDURE [to: MDTStream, byte: Ch] RETURNS [MDTStream] =
-- This routine take care of storing the given byte into the output stream of bytes in ComBufIndexCt size chunks. When more storage is needed it calls GetNextBuf to get another ComBufIndexCt chunk and link it up.
BEGIN
IF to.blkIx >= maxComBufCt THEN {
to.lptbuf ← GetNextBuf[to.lptbuf]; to.blkIx ← 0; };
to.lptbuf.hostData[to.blkIx] ← byte; -- store the byte
to.blkIx ← to.blkIx + 1;
RETURN[to];
END; -- of StoreByte
GetNextBuf: PROCEDURE [putBufOld: LptBufOfChar]
RETURNS [putBufNew: LptBufOfChar] =
-- This rotuine will allocate another "PutBuf"'s worth of storage and link it into the given buffer chain
BEGIN
putBufNew ← spredefinedZone.NEW[BufOfChar];
putBufNew.nextBuf ← NIL; -- this new block now terminates the block chain
IF putBufOld # NIL THEN putBufOld.nextBuf ← putBufNew; --link new buffer-block at end of chain
END; -- of GetNextBuf
FreeBuf: PROCEDURE [putBuf: LptBufOfChar] =
-- This routine will free the entire Put Buffer Chain.
-- This code duplicates the routine Em3270ComDefs.FreeBuffer.
BEGIN
nextBlk: LptBufOfChar ← putBuf.nextBuf;
spredefinedZone.FREE[@putBuf]; -- free first block unconditionally
UNTIL nextBlk = NIL DO
putBuf ← nextBlk;
nextBlk ← putBuf.nextBuf;
spredefinedZone.FREE[@putBuf];
ENDLOOP;
END; -- of FreeBuf
--===================
-- Public Procedures
--===================
DoProcessBut: PUBLIC SchemaDefs.Pvprocessbut =
-- PROC[lschema:Lschema, pbrequest:PBRequest]
--Handle legal button selections
BEGIN
MYdata: Lpttrt3270schemadata ← TraitDefs.MyData[lschema, trt3270schema];
lptdata: LONG POINTER TO EmHandle ← MYdata.lptEmState;
charpos: VDTDefs.CharPos;
posnSelf: AreaDefs.Posn = pbrequest.posnSchema; -- save my own tracking region
rgnTrackSave: RgnDefs.Rgn = pbrequest.rgnTrack; -- save my own position
resolveresult: SchemaDefs.Resolveresult;
aqrgnBkgd: RgnDefs.Aqrgn ← [NIL, NIL];
bvBkgdComputed: Bv ← FALSE;
bvDoneTracking: Bv ← FALSE;
IF (pbrequest.button.buttype = butCopy OR pbrequest.button.buttype = butMove)
AND SchemaDefs.GetRootCs[].sel.seltype # TxtEditDefs.seltypeText
THEN { --we won't be able to process this ourselves
SchemaDefs.ProcessButNopAbortMCSOnButtonUpStd[lschema, pbrequest];
RETURN};
-- While the button is in my interest region send it to a child or track in background
UNTIL bvDoneTracking DO
SchemaDefs.ResolveToChildExactly[lschema, pbrequest, @resolveresult]; -- is button in my schema?
IF resolveresult.lschemaHit # SchemaDefs.lschemaNil THEN
BEGIN -- send button to children
pbrequest.rgnTrack ← @resolveresult.aqrgnTrackHit; -- tracking region for lschemaHit
SchemaUtilDefs.AddScToPosn[resolveresult.scSchemaHit, @pbrequest.posnSchema];
-- position of lschemaHit (upper left hand corner)
pbrequest.rgnTrack ← @resolveresult.aqrgnTrackHit; -- tracking region for lschemaHit
pbrequest.button.sc ← resolveresult.scBut; -- but. pos. rel to lschemaHit
IF resolveresult.lschemaHit = lptdata.display THEN
BEGIN -- handle button in VDT area. Assumes VDT is my only child - all else is background!
[charpos, pbrequest.button.sc, pbrequest.processbutctrl] ←
VDTDefs.TrackButton[
lptdata.display, pbrequest.posnSchema, pbrequest.button.sc]; -- let VDT handle button while inside it
IF pbrequest.processbutctrl = buttonup THEN
DoButUpInDataArea[lschema, pbrequest, charpos] -- handle button up within main data area
END; -- handle button in VDT area
-- restore posnSchema, rgnTrack and scBut for parent (lschema)
pbrequest.rgnTrack ← rgnTrackSave;
RgnDefs.FreeRest[resolveresult.aqrgnTrackHit.rteFirst];
pbrequest.posnSchema ← posnSelf; -- restore position of lschema
pbrequest.button.sc ← SchemaUtilDefs.AddScs[
pbrequest.button.sc, resolveresult.scSchemaHit]; -- make scBut lschema-relative
END -- of send button to children
ELSE --lschemaHit = lschemaNil; button processing in background (we're in the boarders)
BEGIN -- processing background
IF NOT bvBkgdComputed THEN
BEGIN -- need to calculate backgroung region before testing
bvBkgdComputed ← TRUE;
aqrgnBkgd ← SchemaDefs.AqrgnBkgdUtilStd[
lschema, rgnTrackSave, posnSelf];
END;
IF SchemaUtilDefs.ScInRgn[pbrequest.button.sc, @aqrgnBkgd] THEN
BEGIN -- tracking in my background
pbrequest.rgnTrack ← @aqrgnBkgd;
SchemaDefs.NewTrackUtilStd[lschema, pbrequest];
SELECT pbrequest.button.buttype FROM
butMove => SchemaDefs.CancelMCS[lschema, funMove];
butCopy => SchemaDefs.CancelMCS[lschema, funCopy];
butSameAs => SchemaDefs.CancelMCS[lschema, funSameAs];
ENDCASE => NULL; -- ignore select, adjust, convert, drawthrough
pbrequest.rgnTrack ← rgnTrackSave;
END -- of tracking in my background
ELSE bvDoneTracking ← TRUE; -- neither in child nor in background
END; -- processing background
bvDoneTracking ← (pbrequest.processbutctrl = buttonup)
OR (pbrequest.processbutctrl = cancel)
OR NOT SchemaUtilDefs.ScInRgn[pbrequest.button.sc, rgnTrackSave];
ENDLOOP;
IF bvBkgdComputed THEN RgnDefs.FreeRest[aqrgnBkgd.rteFirst];
END; -- of DoProcessBut
DoButUpInDataArea: PROCEDURE [
lschema: SchemaDefs.Lschema, pbrequest: SchemaDefs.PBRequest,
charpos: VDTDefs.CharPos] =
BEGIN
bvprocessOK: Bv ← TRUE;
SELECT pbrequest.button.buttype FROM
butSelect => {
SelectCharPos[lschema, pbrequest, charpos];
SelectionDefs.DeselectCs}; -- pop the current selection
butCopy, butMove => {
SelectCharPos[lschema, pbrequest, charpos];
bvprocessOK ← DoMoveOrCopy[lschema, pbrequest.button.buttype = butMove]};
ENDCASE; --??? do anything here ????
IF bvprocessOK THEN -- set current selection to type 3270 if button processing ok
VDTDefs.SetCursorShape[GetDisplayHandle[lschema], GetPrevCursorShape[lschema]];
SelectionDefs.SetCs[lschema, GetSelType[lschema], TreeEltDefs.ctxtNil];
END; -- of DoButUpInDataArea
SelectCharPos: PROCEDURE [
lschema: SchemaDefs.Lschema, pbrequest: SchemaDefs.PBRequest,
charpos: VDTDefs.CharPos] =
BEGIN OPEN Em3270BufferDefs;
buffer: LptBufferData ← GetBufferHandle[lschema];
Reserve[my: buffer]; -- lock for destructive function
SetCursor[my: buffer, newCursor: charpos, bvDisplayCursor: FALSE]; -- set
Release[my: buffer]; -- unlock buffer interlock
END; -- of SelectCharPos
DehiliteSeldesc: PROCEDURE [seldesc: TxtEditDefs.Seldesc] =
BEGIN
aqrehilitespec: TxtEditDefs.Aqrehilitespec;
lptSelDescription: TxtEditDefs.LptSelDescription;
[lptSelDescription: lptSelDescription] ←
TxtEditDefs.SelectionDescription[seldesc];
-- de-hilite trial selection
aqrehilitespec[primary][before] ← lptSelDescription.textSegment;
aqrehilitespec[primary][after] ← TxtDefs.textSegmentNil;
aqrehilitespec[secondary][before] ← TxtDefs.textSegmentNil;
aqrehilitespec[secondary][after] ← TxtDefs.textSegmentNil;
TxtEditDefs.Rehilite[@aqrehilitespec];
END;
DoMoveOrCopy: PROCEDURE [lschema: SchemaDefs.Lschema, bvMove: Bv]
RETURNS [ok: Bv ← TRUE] =
--process COPY and MOVE into the 3270 window. If the operation fails due to some problem with the source, the MC is cancelled, the current selection is restored to the source, and ok is returned FALSE. If the operation fails due to a problem with the 3270 buffer, input inhibited is set, the appropriate status is displayed, and ok is returned TRUE; ie, the MC is considered successful from the Star point of view.
BEGIN
bvTextSelectionExists, bvWellFormed, bvAdjustmentMade: Bv;
lschemaRoot: SchemaDefs.Lschema ← SchemaDefs.lschemaNil;
seldescCS: TxtEditDefs.Seldesc ← TxtDefs.seldescNil; --of MC selection
selRoot: SchemaDefs.Sel ← SelectionDefs.selNil;
ts: TxtDefs.TextSegment ← TxtDefs.textSegmentNil;
lptSelDescription: TxtEditDefs.LptSelDescription;
-- If inputInhibited, ignore all input characters
IF GetInputStatus[lschema] = inputInhibited THEN {
SchemaDefs.CancelMCS[lschema, funCopy];
Em3270StatusDefs.DisplayCode[lschema: lschema, code: what, bvOn: TRUE]; -- turn on WHAT "?+" status
RETURN[TRUE];
};
[lschema: lschemaRoot, sel: selRoot] ← SchemaDefs.GetRootCs[];
bvTextSelectionExists ← lschemaRoot # SchemaDefs.lschemaNil
AND selRoot.seltype = TxtEditDefs.seltypeText;
seldescCS ← LOOPHOLE[selRoot.seldesc.lptr];
IF ~bvTextSelectionExists THEN { --nothing to Copy or Move
SchemaDefs.CancelMCS[lschema, IF bvMove THEN funMove ELSE funCopy];
RETURN[FALSE]};
[lptSelDescription: lptSelDescription] ←
TxtEditDefs.SelectionDescription[seldescCS];
ts ← TxtEditDefs.CopyTextSegment[@lptSelDescription.textSegment];
McDefs.SetStandardShape[idHourGlass]; -- this may take a second or two
IF bvMove THEN
[bvWellFormed, bvAdjustmentMade] ← TxtEditDefs.AdjustDeleteSpan[ts]
ELSE {bvWellFormed ← TRUE; bvAdjustmentMade ← FALSE};
IF NOT bvWellFormed THEN
BEGIN -- cancel move or copy, restore old selection
TxtEditDefs.AlterCurrentSelection[seldescCS];
MessageSwnDefs.DisplayMessage[
IF bvMove THEN keyCSCantMove ELSE keyCSCantCopy];
SchemaDefs.CancelMCS[lschema, IF bvMove THEN funMove ELSE funCopy];
TxtEditDefs.DestroyTextSegment[@ts];
McDefs.SetDefaultShape[];
RETURN[FALSE];
END
ELSE
BEGIN --actually do the copy or move.
status: Em3270BufferDefs.WriteError ← okay;
flow: TxtDefs.Flow ← TxtFlowDefs.Create[
ts.blockaddrFirst, ts.blockaddrLast];
buffer: Em3270PrivDefs.LptBufferData ← Em3270PrivDefs.GetBufferHandle[
lschema];
lptToTransFile: BaseOISToEFile ← Em3270PrivDefs.GetTransHandle[lschema];
Em3270BufferDefs.Reserve[buffer];
IF flow = TxtDefs.flowNil THEN status ← okay
ELSE
DO
noChar: CharDefs.Char ← CharDefs.Roman[unused177B];
newChar1: CharDefs.Char ← CharDefs.Roman[unused177B];
newChar2: CharDefs.Char ← CharDefs.Roman[unused177B];
[newChar1, newChar2] ← GetNonTileCharFromFlow[lptToTransFile, flow];
IF newChar1 = noChar THEN EXIT; --no more characters
IF (status ← Em3270BufferDefs.PutChar[buffer, newChar1]) # okay THEN GOTO reject;
IF newChar2 # noChar THEN --it's the second part of a deadkey sequence
IF (status ← Em3270BufferDefs.PutChar[buffer, newChar2]) # okay THEN GOTO reject;
IF ~TxtFlowDefs.AdvanceCharacter[flow] THEN EXIT;
REPEAT
reject => DisplayBufferError[lschema, status];
ENDLOOP;
Em3270BufferDefs.Release[buffer];
-- DehiliteSeldesc[seldescCS];
SelectionDefs.DeselectCs;
TxtFlowDefs.Destroy[flow];
IF bvMove AND status = okay THEN
BEGIN OPEN TxtEditDefs; --delete the (possibly) adjusted source segment
txtCtxt: TxtCtxt ← @aqTxtCtxt;
aqTxtCtxt: AqTxtCtxt;
BeginEdit[txtCtxt, TRUE]; --consult user for things like anchors &c.
Delete[txtCtxt, ts];
EndEdit[txtCtxt];
END;
END;
TxtEditDefs.DestroyTextSegment[@ts];
McDefs.SetDefaultShape[];
END; -- of DoMoveOrCopy
GetNonTileCharFromFlow: PROCEDURE [lptToTransFile: BaseOISToEFile, flow: TxtDefs.Flow]
RETURNS [char1, char2: CharDefs.Char] =
--Returns with the next non-tile character in the flow, starting at the current position, or the news (char1 = Roman[unused177B]) that the flow is exhausted. ADD CODE to return a second CharDefs.Char # Roman[unused177B] if the character.aqplaincharacter.char is one that must decompose into a dead accent followed by a host; and to return a Roman[hyphen] if the character.aqplaincharacter.char is one that doesn't exist in the EBCDIC set under consideration at all.
BEGIN
character: WSCharDefs.Character;
DO
character ← TxtFlowDefs.CharacterCurrent[flow];
SELECT character.aqplaincharacter.representation FROM
bit16 => { --here's where we'll have to check for decomposing dead characters (whew!) and transforming unrecognized NS characters to Roman hyphens. Note that when this is done we will NOT advance the flow, as it has no idea that we might have turned one character into two.
[char1, char2] ← Em3270CharTransDefs.ExpandLegalDeadchar[lptToTransFile, character.aqplaincharacter.char];
RETURN[char1, char2]; };
ENDCASE =>
IF ~TxtFlowDefs.AdvanceCharacter[flow] THEN
RETURN[CharDefs.Roman[unused177B], CharDefs.Roman[unused177B]];
ENDLOOP;
END; --of GetCharFromFlow
DisplayBufferError: PROCEDURE [lschema: SchemaDefs.Lschema, error:Em3270BufferDefs.WriteError] =
-- This routine will take the given buffer error and translate it into a meaningful status character to be displayed in the lower Status area of the 3270 window.
BEGIN
Em3270StatusDefs.DisplayCode[lschema: lschema, bvOn: TRUE, code:
SELECT error FROM
attribute, protected => goElsewhere,
noRoomInField => moreThan,
alphaInNumericField => nonNumeric,
ENDCASE => what];
END; -- of DisplayBufferError
ProcessInputChar: PUBLIC PROCEDURE [
lschema: SchemaDefs.Lschema, string: String] =
-- Process a normal alphanumeric characters from the main keyboard array.
BEGIN
aqscanctxt: WSStringDefs.Aqscanctxt; -- scan context for reading string
bufstatus: Em3270BufferDefs.WriteError; -- buffer status returned while putting a char into the buffer
BEGIN -- just needed for scope-of-definition on aqscanctxt/bufstatus
status: InputStatus ← GetInputStatus[lschema]; -- get current emulator status
-- If inputInhibited, ignore all input characters
IF status = inputInhibited THEN {
Em3270StatusDefs.DisplayCode[lschema: lschema, code: what, bvOn: TRUE]; -- turn on WHAT "?+" status
RETURN;};
-- Initialize the scanctxt. Will then point to first character
IF WSStringDefs.BeginForwardScan[
WSStringDefs.Substring[string], @aqscanctxt, characters] THEN -- string is not empty
BEGIN
buffer: LptBufferData ← GetBufferHandle[lschema];
-- Start reading characters for input and putting them into the buffer (usually this is only one character long)
bufstatus ← Em3270BufferDefs.PutChar[my: buffer, -- display first char. unconditionally
aChar: WSStringDefs.CharCur[@aqscanctxt], inputMode: status];
IF bufstatus # okay THEN GOTO buffererrors; -- handle any buffer errors
WHILE WSStringDefs.ScanForward[@aqscanctxt] -- advance to next char
DO
bufstatus ← Em3270BufferDefs.PutChar[my: buffer, -- display all subsequent characters
aChar: WSStringDefs.CharCur[@aqscanctxt], inputMode: status];
IF bufstatus # okay THEN GOTO buffererrors; -- handle any buffer errors
ENDLOOP;
END;
WSStringDefs.EndScan[@aqscanctxt]; -- clean up scanctxt house
EXITS
buffererrors => {SetInputInhibited[lschema];
WSStringDefs.EndScan[@aqscanctxt];
DisplayBufferError[lschema, bufstatus]; };
END; -- scope-of-definition on aqscanctxt
END; -- of ProcessInputChar
Process3270Keyes: PUBLIC PROCEDURE [
lschema: SchemaDefs.Lschema, key: NtDefs.Special3270Key] =
-- Process a 3270-unique character fron the virtual keyboard
BEGIN
-- If inputInhibited, only look at the RESET key, ignore all others
IF GetInputStatus[lschema] = inputInhibited
AND key # special3270Reset THEN {
Em3270StatusDefs.DisplayCode[lschema: lschema, code: what, bvOn: TRUE]; -- turn on WHAT "?+" status
RETURN;
};
keyProcessor[key][lschema, key]; -- call 3270 key processing routine
END; -- of Process3270Keyes
ProcessFuntion: PUBLIC PROCEDURE [
lschema: SchemaDefs.Lschema, fun: NtDefs.Fun] =
-- Process Star function keyes
BEGIN
SELECT fun FROM
funCopy, funMove, funSameAs => {
NfrDefs.CancelMCS[];
MessageSwnDefs.DisplayMessage[keyNotImplemented];
};
funHelp => MessageSwnDefs.DisplayMessage[keyNotImplemented];
ENDCASE => NULL; -- ignore all other function keyes
END; -- of ProcessFuntion
ProcessFunRepeat: PUBLIC PROCEDURE [
lschema: SchemaDefs.Lschema, cvFunrepeat: Cv, funrepeat: NtDefs.Funrepeat] =
-- Process Function keyes which can repeat
BEGIN
THROUGH [1..cvFunrepeat] DO
SELECT funrepeat FROM
funTAB => MoveCursor[lschema: lschema, key: special3270Tab]; -- process TAB
funBS, funBW => MoveCursor[lschema: lschema, key: special3270BackSpace]; -- process BACKSPACE
funNewLine => MoveCursor[lschema: lschema, key: special3270NewLine]; -- process NEWLINE
ENDCASE => EXIT; -- ignore all other repeat function keyes
ENDLOOP;
END; -- of ProcessFunRepeat
Create: PUBLIC PROCEDURE [lschema: SchemaDefs.Lschema] =
BEGIN
MYdata: Lpttrt3270schemadata ← TraitDefs.MyData[lschema, trt3270schema];
emdata: LONG POINTER TO EmHandle ← MYdata.lptEmState;
emdata.putMDTStream.lptbuf ← spredefinedZone.NEW[BufOfChar];
emdata.putMDTStream.blkIx ← 0;
END;
Destroy: PUBLIC PROCEDURE [lschema: SchemaDefs.Lschema] =
BEGIN
MYdata: Lpttrt3270schemadata ← TraitDefs.MyData[lschema, trt3270schema];
emdata: LONG POINTER TO EmHandle ← MYdata.lptEmState;
firstPutBuf: LptBufOfChar ← emdata.putMDTStream.lptbuf;
IF firstPutBuf.nextBuf = NIL THEN
spredefinedZone.FREE[@firstPutBuf] -- free the first block only
ELSE
FreeBuf[firstPutBuf]; -- free all blocks
emdata.putMDTStream ← [NIL, 0];
END;
ResetAIDStatus: PUBLIC PROCEDURE [lschema: SchemaDefs.Lschema] =
BEGIN
-- reset the AID and free all blocks except for first block which is permanent till end of session.
MYdata: Lpttrt3270schemadata ← TraitDefs.MyData[lschema, trt3270schema];
emdata: LONG POINTER TO EmHandle ← MYdata.lptEmState;
firstPutBuf: LptBufOfChar ← emdata.putMDTStream.lptbuf.nextBuf;
IF firstPutBuf # NIL THEN
FreeBuf[firstPutBuf]; -- free all but the first block.
emdata.putMDTStream.lptbuf.nextBuf ← NIL;
SetAIDStatus[lschema,TRUE]; -- no-AID-generated
RETURN;
END;
END. -- of Em3270UserInputPack
LOG
March 14, 1982 - Kernaghan - Created Em3270UserInputPack.
March 20, 1982 - Kernaghan - Fix bug in BuildFieldStream whch was storing the attribute address instead of the attribute+1.
March 26,1982 - Kernaghan - Removed keyboard interrputation stubs now that the actual 3270 virtual keyboards & Code are available.
March 30 - Kernaghan - Rplaced SchemaDefs.CancelMCS with NfrDefs.CancelMCS inside of ProcessFuntion to properly handle the "ignoring" of *funCopy, funMove, funSameAs*.
March 30 - Kernaghan - Added DisplayBufferError to handle buffer errors better and replaced code in various places that gets Em3270BufferDefs.WriteError returned to it.
23-Jun-82 18:11:50 - Lui - fixed abug in DoReadMod, was calling Em3270ComDefs.DoStreamPut with last buffer instead of pointer to head of chain.
24-Jun-82 9:47:50 - Lui - Added SchemaUtilDefs.
13-Jul-82 13:08:40 - Lui - removed TextHiliteDefs.
4-Aug-82 15:16:41 - Lui - fix buffer not reserved/released bug. removed Em3270BufferDefs.Reserve/Release from AID PROC.
4-Aug-82 15:30:11 - Lui - Added dded codes to DoButUpInDataArea for implementing ghost cursor. changed ALTCursor to incorporate all various cursor shape.
31-Aug-82 15:15:46 - Lui - Modified DoMoveOrCopy, and PvFieldHit to provide support multiNational.
9-Sep-82 17:53:11 - Lui - changed hostLang to lptToTransFile
29-Sep-82 15:08:32 - Lui - replaced seltype3270 with GetSelType.
14-Dec-82 17:05:24 - Lui - replaced NfrDefs.CancelMCS with SchemaDefs.CancelMCS
16-Dec-82 11:40:53 - Lui - undo previous action
18-Feb-83 12:19:55 - Lui - moved posting of message after called to NfrDefs.CancelMCS instead of before.
22-Feb-83 13:27:58 - Lui - removed called to DehiliteSeldesc in DoMoveOrCopy. AR 10780
9-Mar-83 11:06:19 - Lui - edited DoMoveOrCopy. AR #1354
30-Jun-83 14:09:16 - Lui - support for Read Modified.
5-Oct-83 16:52:02 - Lui - replace session zone with short zone.