/***********************************************************************/
/* WMX: Window Manager - Extreme */
/* -------------------------------- */
/* */
/* This exec creates a sophisticated fullscreen CMS environment and */
/* provides several auxiliary functions that can be used to help */
/* integrate other programs into the provided framework. */
/* */
/* WMX provides 4 basic functions: */
/* a) Set up the environment */
/* b) Making PF3 do the intelligent thing */
/* c) Smart scrolling */
/* d) Toggle a window on/off */
/* */
/* (b) and (c) can also be used in XEDIT. */
/* */
/* WMX operates best in a 160-character wide 3270 window. This */
/* provides enough room to see both a file and the other windows that */
/* pop up from time to time. */
/* */
/* It also operates in TEXT mode. That is TERMINAL TEXT ON. XEDIT */
/* uses this value, also. I developed this program using code page */
/* 924 with TEXT ON. */
/* */
/* Alan Altmark Orgininal written in 1986, and slowly */
/* IBM Endicott, NY updated over time. Overhaul in 2015. */
/* February 2015 */
/* */
/***********************************************************************/
/* PART A: Syntax */
/* */
/* WMX INIT (or no parameters) */
/* Creates the fullscreen CMS environment described in Part B. */
/* You can customize the appearance by the use of a WMX profile. */
/* */
/* WMX integrates 4 different sources for altering the default */
/* settings: */
/* 1. WMX SYSTEM These profiles will be read in the */
/* 2. WMX <nodeid> order shown. All that exist will */
/* 3. WMX PROFILE be used, and the last one to change */
/* 4. WMX <userid> particular setting "wins". */
/* */
/* See WMX PROFILE for details on changing the appearance of WMX. */
/* */
/* WMX CLOSE (Smart CLOSE) */
/* Move the topmost window down one position in the 'z' order, */
/* making it invisible. If that window is XEDIT, then perform */
/* a standard XEDIT QUIT (synonym for PQUIT) instead. */
/* */
/* E.g. SET PF3 EXEC WMX CLOSE (in XEDIT) */
/* E.g. SET PF3 EXEC WMX CLOSE QQUIT (in PROFFLST XEDIT) */
/* */
/* WMX FORWARD | BACKWARD | LEFT | RIGHT <n> (Smart Scroll) */
/* Scroll the topmost window in the direction and amount given. */
/* If that window is XEDIT, scroll the file per instructions. */
/* */
/* E.g. SET PF8 EXEC WMX FORWARD */
/* */
/* WMX RGTLEFT <n> (Smart Shift) */
/* Works like the RGTLEFT XEDIT macro. */
/* */
/* E.g. SET PF10 EXEC WMX RGTLEFT */
/* */
/* WMX BLINK window */
/* If the window is visible, hide it. If it's not visible, show */
/* it. (Based on a macro written by Jay Curtiss in Nov. 1987.) */
/* */
/* E.g. SET PF9 EXEC WMX BLINK CMSOUT */
/* */
/* WMX ENDCMD */
/* Used by the WMXPFUPD module to indicate that CMS end-of-command */
/* (the Ready message) has been reached. At this point in time, */
/* all it does is update the PF key scriptions. */
/* */
/* WMX RESET */
/* Used by the WMXPFUPD module to indicate that it has been */
/* NUCXDROPed. */
/* */
/* WMX QUERY */
/* Tell me more about WMX. */
/* */
/***********************************************************************/
/* PART B - Appearance */
/* */
/* ._________________________________________________________________. */
/* | CPU ID and VM Release date | */
/* | LPAR config data userid time | */
/* | ------------------------------------------------------------- | */
/* | : | */
/* | : | */
/* | | */
/* | ------------------------------------------------------------- | */
/* | pfkey descriptions row 1 | */
/* | pfkey descriptions row 2 | */
/* |====> | */
/* | vm status | */
/* '_________________________________________________________________' */
/* */
/* There's a reserved area at the top for some environmental data */
/* and another reserved space near the bottom to hold the PF key */
/* defintiions. I use a 45-line display, so I scoff at such copious */
/* use of space for trivia. Trivia is what makes life worth living! */
/* */
/***********************************************************************/
/* PART C - History */
/* */
/* Note the date. 1986. That was VM/SP Release 5. I was still a */
/* CMS developer back then and while I wasn't working on that part of */
/* the system, I knew those who were: Christine Casey and Mary Sue */
/* (Ianello) Record. I used to go and sit in their office, quiver my */
/* lower lip, and let the tear well up until they agreed to add the */
/* little things that made an exec writer's life much much easier. */
/* */
/* Basically, I got the TOP/NOTOP attribute added and I got the '=' */
/* added to many of the windowing commands. The '=' represents the */
/* window with the TOP attribute that is highest in the z order. */
/* All of the sudden the #WM commands got more powerful! */
/* */
/* Chris and Mary Sue helped me make Fullscreen CMS *usable* as */
/* opposed to simply *functional*. At one time I thought about */
/* submitting a patent application for the ideas set forth here, and */
/* I still have the filled-out form from the late 80s, but if I hadk */
/* submitted it, perhaps Microsoft would have had a harder time, or */
/* perhaps I would simply be "rich beyond the dreams of avarice!" */
/* */
/* In the beginning, the "smart close" and the scrolling functions */
/* were in their own XEDIT macros. It was only recently that I */
/* rolled everyting into this one exec to make it easier for me */
/* to send the exec to my various user IDs. */
/* */
/***********************************************************************/
/*---------------------------Preamble---------------------------------*/
address COMMAND
arg wmxcmd wmxparms
/**********************************************************************/
/* Get 3270 display dimensions */
/**********************************************************************/
"QUERY DISPLAY (LIFO"
pull . scrH scrW . /* Get terminal dimentions */
scrM = scrW % 2 /* Midpoint on screen */
/**********************************************************************/
/* Find out which window is at the top of the z order. */
/**********************************************************************/
"SET WINDOW XEDIT TOP" /* Let XEDIT float to the top */
"SET WINDOW HELPWIN TOP"
/*
"PIPE CMS QUERY WINDOW * | append literal --^^--" time() "--",
"| stem winlist. | >> WINDOW LIST A"
*/
"PIPE command QUERY WINDOW =", /* Get the name of top window */
"| spec w2",
"| var wintop"
"SET WINDOW XEDIT NOTOP" /* Suppress XEDIT again */
"SET WINDOW HELPWIN NOTOP"
if wintop = "HELPWIN" then wintop = "XEDIT"
/*---------------------------Mainline---------------------------------*/
GlobalV = "Global WMX"
GlobalVS = "Session WMX"
JustInit? = Value("JUSTINIT", , GlobalV)
Init? = 0
/* Why were we called? */
Select
When word(wmxcmd "INIT", 1) = "INIT" then /* Lock and load.... */
Init? = 1
/* Called from XEDIT to manage scrolling and dropping of windows */
When wmxcmd wintop = "CLOSE XEDIT" & wmxparms <> "" then
address XEDIT wmxparms
When wmxcmd wintop = "CLOSE XEDIT" then
address XEDIT "QUIT"
When wmxcmd = "CLOSE" then
"WINDOW DROP" wintop
When wmxcmd wmxparms = "BLINK" wintop then
"WINDOW DROP" wintop
When wmxcmd = "BLINK" then
"WINDOW POP" wmxparms
when wmxcmd = "RGTLEFT" then
Call RGTLEFT wmxparms
When wintop = "XEDIT" then
address XEDIT wmxcmd wmxparms
when wmxcmd = "ENDCMD" & JustInit? = "YES" then
do /* Avoid double-tap invocation */
Call Value "JUSTINIT" , "", GlobalV
Exit
end
when wmxcmd = "ENDCMD" then
Call End_of_Command
when wmxcmd = "DROPWARN" then
say "Warning: WMX will no longer track CMSPF key changes"
otherwise
"WINDOW" wmxcmd "=" wmxparms
End
if Init? = 0 then exit 0
Call Value "JUSTINIT", "YES", GlobalV
/**********************************************************************/
/* Save message-related settings. At the end of every command, they */
/* are compared to then-current values and corrected automatically. */
/**********************************************************************/
parse value translate(", "diag(8,'Q SET'), ' ', '15'x) ,
with ', MSG ' msgset . ', WNG ' wngset . ', EMSG ' emsgset . ',' ,
' IMSG ' imsgset . ','
wanted = "MSG" msgset "WNG" wngset "EMSG" emsgset "IMSG" imsgset
Call Value "SET_WANTED", wanted, GlobalVS
Keep_MSG = 100
Keep_CMS = 2048
Color_CMS = "TURQ"
Color_MSG = "YELLOW"
Color_Bar = "RED"
Color_LPAR = "YELLOW"
Color_SYSTEM = "WHITE"
Color_USER = "PINK"
Color_PFNUM = "BLUE"
Color_PFDESC = "WHITE"
Color_Scheme = "STANDARD"
/* Ordinal position is VSCREEN color mask code */
/* Also allows resolution of abbreviations */
Valid_Colors = " BLUE RED PINK GREEN TURQOISE YELLOW WHITE"
/*-- CMS Defaults shown here for reference -------------
- PF01 Help ECHO HELP -
- PF02 Pop_Msg NOECHO #WM WINDOW POP MESSAGE * -
- PF03 Quit NOECHO SET FULLSCREEN SUSPEND -
- PF04 Clear_Top NOECHO #WM WINDOW CLEAR = -
- PF05 Filelist ECHO EXEC FILELIST -
- PF06 Retrieve RETRIEVE -
- PF07 Backward NOECHO #WM WINDOW BACKWARD CMS 1 -
- PF08 Forward NOECHO #WM WINDOW FORWARD CMS 1 -
- PF09 Rdrlist ECHO EXEC RDRLIST -
- PF10 Left NOECHO #WM WINDOW LEFT CMS 10 -
- PF11 Right NOECHO #WM WINDOW RIGHT CMS 10 -
- PF12 Cmdline NOECHO VSCREEN CURSOR CMS -2 8 (RES -
-------------------------------------------------------*/
/* 123456789 */
PF03 = "|Close | EXEC WMX CLOSE "
PF06 = "| ? | RETRIEVE "
PF07 = "|Top Page-| #WM WINDOW BACKWARD = 1 "
PF08 = "|Top Page+| #WM WINDOW FORWARD = 1 "
PF10 = "|<×Top×> | EXEC WMX RGTLEFT = "
PF11 = "|Clear Top| #WM WINDOW CLEAR = "
PF13 = "|Suspend | SET FULLSCREEN SUSPEND "
PF15 = "|Drop top | #WM WINDOW DROP = "
PF18 = PF06
PF19 = "|CMS Page-| #WM WINDOW BACKWARD CMS 1 "
PF20 = "|CMS Page+| #WM WINDOW FORWARD CMS 1 "
PF21 = "|CP Disc | CP DISC HOLD "
PF22 = "|<×CMS×> | EXEC WMX RGTLEFT CMS "
PF24 = "|Clear CMS| VSCREEN CLEAR CMS "
"PIPE CP QUERY USERID | spec w1 1 /@/ nw w3 nw | var whoami?"
sysid = word(whoami?, 3)
/***********************************************************************/
/* Here we read the profiles. It works by reading ALL the valid */
/* profiles in order, from lowest precedence to highest. Each one */
/* can override any of those below it in the hierarchy: */
/* 1. WMX <userid> */
/* 2. WMX PROFILE */
/* 3. WMX <system> */
/* 4. WMX DEFAULTS */
/* */
/* No error message is generated due to the lack of a profile. If */
/* no profile is found, all of the built-in defaults are used. Yes , */
/* four profiles might be considered extravagant in some circles, */
/* but I'd rather have too many than not enough. */
/* */
/* Profiles can have comment lines that start with #, *, !, and //. */
/* Blank lines are also allowed. All other lines are keyword=value, */
/* so you cannot have line comments. */
/* */
/***********************************************************************/
"PIPE (endchar ?)", /* Go read the profiles. */
"state WMX DEFAULTS *",
"| a:faninany", /* All profiles that exist are fed to */
"| stem profiles.", /* faninany. Put list of file used */
"| getfiles", /* in 'profiles.' stem variable. */
"| spec w1-* 1", /* Start everything in column 1 */
"| nfind =" ||, /* Ignore malformed statements. */
"| nfind *" ||, /* Get rid of comment lines. */
"| nfind !" ||, /* : */
"| nfind #" ||, /* : */
"| nfind //" ||, /* : */
"| change /=/ /", /* Trash the equals sign */
"| xlate w1 upper", /* Prep to feed to VARLOAD. */
"| spec /!/ 1 w1 n /!/ n w2-* n",
"| nfind !!" ||, /* Get rid of blank lines */
"| varload",
"?",
"state WMX" sysid "*", /* WMX <sysid> overrides WMX DEFAULTS */
"| a:",
"?",
"state WMX PROFILE *", /* WMX PROFILE overrides WMX <sysid> */
"| a:",
"?",
"state WMX" userid() "*", /* WMX <userid> overrides WMX PROFILE */
"| a:" /* Whichever file is read last, wins. */
"PIPE (endchar ?)", /* Get whatever PF keys are defined. */
"| rexxvars toload", /* Can't use as-is, but need to */
"| buffer", /* reformat, so put them into the */
"| find PF" ||, /* PF. stem variable. BUFFER needed */
"| nfind PF." ||, /* to avoid infinite loop. Sort for */
"| sort 2.4", /* debugging convenience. */
"| stem pf."
color_scheme = translate(color_scheme)
em_dash = "BF"x /* Em dash from TEXT code page */
en_dash = '-' /* Regular en dash */
Select
when datatype( KEEP_MSG, "W") = 0 then
Call ErrorOut "Invalid number on Keep_MSG =" keep_MSG "in profile"
when datatype( KEEP_CMS, "W") = 0 then
Call ErrorOut "Invalid number on Keep_CMS =" keep_CMS "in profile"
otherwise nop
End
/* S P */
/* Y P F */
/* L S U F D */
/* C M B P T S N E */
/* M S A A E E U S */
/* S G R R M R M C */
Select /* | | | | | | | | */
when color_scheme = "WINTER" then scheme = "B W B W B W B W"
when color_scheme = "FALL" then scheme = "Y R Y Y Y R R Y"
when color_scheme = "KIDS" then scheme = "P T Y W B R G Y"
when color_scheme = "SPRING" then scheme = "Y G G Y G G Y Y"
when color_scheme = "SUMMER" then scheme = "Y Y Y G G G Y G"
when color_scheme = "ST.PAT" then scheme = "G G G W W W G W"
when color_scheme = "4-COLOR" then scheme = "G W R W W B B W"
when color_scheme = "USA" then scheme = "B W R W W B B W"
when color_scheme = "CANADA" then scheme = "W R R W W R R W"
when color_scheme = "STANDARD" then scheme = "T Y R Y W P B W"
when color_scheme = "CHRISTMAS" then scheme = "G R R W W W R G"
when color_scheme = "CUSTOM" then
do ;
tails = "CMS MSG BAR LPAR SYSTEM USER PFNUM PFDESC"
do i = 1 to words(tails)
cvar = "Color_" || word(tails, i)
if pos( " "value(cvar), Valid_Colors) > 0 then iterate
say "WMX: Invalid custom color" value(cvar) "ignored in profile"
Call Value cvar, "GREEN"
end
end
otherwise
say "WMX: Invalid color scheme" color_scheme "ignored in profile"
color_scheme = "STANDARD"
scheme = "T Y R Y W P B W"
End
if Color_Scheme <> "CUSTOM" then
parse var scheme Color_CMS Color_MSG Color_BAR Color_LPAR ,
Color_SYSTEM Color_USER Color_PFNUM Color_PFDESC
Call Value "Color_Scheme", Color_Scheme, GlobalV
dashtype = em_dash
Border = "TOP" dashtype "BOTTOM" dashtype "LEFT | RIGHT |"
"CONWAIT"
"SET FULLSCREEN OFF" /* Reset the Fullscreen CMS environment */
/***********************************************************************/
/* VSCREENs are logcial image buffers (presentation spaces). In order */
/* to see them you have to create a WINDOW (viewport) and place it */
/* over the part of the VSCREEN you want to see. While a WINDOW is */
/* limited to the size of your 3270 display, a VSCREEN is not. You */
/* simply scroll the window up, down, left, or right as needed. */
/* */
/* The bottom of the CMS VSCREEN is special. If you provide enough */
/* reserved lines, the PF key settings are shown. */
/* */
/* +---------- number of lines to remember */
/* | +------- number of columns */
/* | | +---- reserved rows at top */
/* | | | +--- reserved rows at bottom */
/* | | | | +----- attributes */
/* | | | | | */
/* V V V V V */
"VSCREEN DELETE CMS"
address CMS "VSCREEN DEFINE CMS" Keep_CMS scrW "3 5 (NOPROTECT" Color_CMS
"PIPE", /* Get current value of BREAK key */
"cp QUERY TERMINAL",
"| join * / /",
"| var qterm"
parse var qterm . "BRKKEY" brkkey "," .
"CONWAIT"
"SET FULLSCREEN ON (NOCLEAR"
"SET FULLSCREEN ON" /* Create remaining default VSCREENS and WINDOWS */
"SET CHARMODE ON" /* Needed to change character attributes */
"SET FULLREAD ON" /* Avoid need to hit space bar to move cursor */
"SET TEXT ON" /* I use characters from the TEXT code page */
"CP TERM TEXT ON"
"CP TERM BRKKEY" brkkey /* Turn the BREAK key back on */
"QUERY VSCREEN CMS (LIFO"
pull . . lines cols rtop rbot .
"VSCREEN DELETE MESSAGE"
"WINDOW DELETE MESSAGE"
"WINDOW DELETE CMSOUT"
"WINDOW DELETE STATUS"
"WINDOW DELETE TIME"
/***********************************************************************/
/* Start displaying CMS error messages. Use ADDRESS COMMAND for the */
/* few that we want to surpress. */
/* */
address CMS
Call ON Error
/***********************************************************************/
/* CMSOUT vscreen is created by XEDIT for CMS subset mode output. */
/* It will be the same size as the CMS vscreen. But you can seee that */
/* we're only showing the left "half" of it. */
/* */
"WINDOW DEFINE CMSOUT" scrH-rtop-rbot "75" rtop+1 scrW-77 "( VAR POP SYSTEM"
"SET BORDER CMSOUT ON (" Color_CMS border
parse var Color_MSG vcolor "/" bcolor
bcolor = word(bcolor vcolor, 1)
"VSCREEN DEFINE MESSAGE" Keep_MSG scrW "2 0 (PROTECT" vcolor
"WINDOW DEFINE MESSAGE" scrH-rtop-rbot scrM rtop+1 scrW-scrM-2 ,
"( VAR POP SYSTEM"
"WINDOW SHOW MESSAGE ON MESSAGE"
"SET BORDER MESSAGE ON (" bcolor border
"QUERY WINDOW MESSAGE (LIFO"
pull . . r w .
"WINDOW POSITION MESSAGE" rtop+1 scrW-w-2
"SET LOGFILE MESSAGE OFF" /* Don't log messages to disk */
/***********************************************************************/
/* Construct the date */
/* */
saydate = date()
datelen = length(saydate)
datepos = (scrW - datelen)
"VSCREEN WRITE CMS 1" datepos datelen "(RES" Color_SYSTEM "DATA" saydate
/***********************************************************************/
/* The STATUS vscreen contains the current time and the status of the */
/* CMS virtual console. That is, the equivalent of RUNNING or VM READ.*/
/* */
/* Display the time and console status on different places on the */
/* screen. To do that, create two windows, each positioned over a */
/* a different part of the STATUS vscreen. */
/* */
/* Create windows for the two components: */
/* */
/* +------- number of rows (size) */
/* | +----- number of columns */
/* | | +---- screen row (position) */
/* | | | +-- screen column */
/* | | | | */
/* | | | | */
/* V V V V */
"WINDOW DEFINE STATUS 1 60 -1" scrW-60 "(NOTOP NOBORDER SYSTEM"
"WINDOW SHOW STATUS ON STATUS 1" scrW-60+1 /* Overlay console status */
timeloc = (datelen + 9)% 2 /* Center it under the date */
"WINDOW DEFINE TIME 1 9 2" scrW-timeloc "(NOTOP NOBORDER SYSTEM"
"WINDOW SHOW TIME ON STATUS 1 2" /* Overlay time */
"SET LOCATION TIME OFF" /* Tiny windows don"t have room */
"SET LOCATION STATUS OFF" /* for location information. */
/***********************************************************************/
/* Use STORE SUBSYSTEM INFORMATION instruction to get details about */
/* the LPAR and the machine. */
/* */
parse value stsi(1,1,1) with 49 type +4 ,
81 seq +16 ,
101 model +16 .
parse value stsi(2,2,2) with 33 lnum +2 , /* Partition number */
39 lcpus +2 , /* # of CPUs in the LPAR */
45 lname +8 /* partition name */
parse value stsi(3,2,2) with 39 vcpus +2 , /* # of CPUs in the v.m. */
57 cp_id +16
parse value c2d(lnum) c2d(lcpus) c2d(vcpus) right(seq,5) lname model ,
with lnum lcpus vcpus ser lname model .
blist = "- 2097 z10-EC 2098 z10-BC 2817 z196 2818 z114",
" 2827 zEC12 2828 zBC12 2964 z13 2965 z13s"
brand = strip(translate( word(blist, wordpos(type, blist)+1), " ", "-"))
cfg = lname lcpus"-way" brand
parse value diag(8,"QUERY STORAGE") with . . rstor rstor? . "15"x
if rstor? <> "" then /* We have real storage */
cfg = cfg "with" rstor "memory"
"VSCREEN WRITE CMS 1 2" length(cfg) "(RES" Color_LPAR "DATA" cfg
cfg = type"-"model "Serial" ser
"PIPE cp QUERY LPARS",
"| xlate upper",
"| find ACTIVE PARTITION:",
"| spec /CSS/ 1 w5 nw /MIF ID/ nw w7 nw",
"| var css_mif"
if rc = 0 then
cfg = cfg"," css_mif
"VSCREEN WRITE CMS 2 2" length(cfg) "(RES" Color_LPAR "DATA" cfg
/***********************************************************************/
/* Get the CP level information */
/* */
sl = c2d(right(diag(0), 2))
cplevel = space(cp_id) " SL" sl
strlen = length(cplevel)
strpos = (scrW - strlen) % 4
"VSCREEN WRITE CMS 1" strpos strlen "(RES" Color_SYSTEM "DATA" cplevel
/***********************************************************************/
/* Put 'userid @ system" on screen. Occupies up to 19 bytes. */
/* */
strlen = length(whoami?) /* whoami? set up top */
strpos = (scrW - strlen) % 4
"VSCREEN WRITE CMS 2" strpos strlen "(RES" Color_USER "DATA" whoami?
/***********************************************************************/
/* Write separators */
/* */
sep = copies("BF"x, scrW-1)
"VSCREEN WRITE CMS 3 1" scrW-1 "(RES" Color_Bar "DATA" sep
"VSCREEN WRITE CMS -5 1" scrW-1 "(RES" Color_Bar "DATA" sep
/***********************************************************************/
/* The *MSG system service is being used to collect async output to */
/* the session manager. Use the VSCREEN ROUTE command to select */
/* the window they should show up in. NETWORK is a special case of */
/* MESSAGE when the message comes in from the virtual machine listed */
/* SYSTEM NETID (i.e. RSCS). */
/* */
"VSCREEN ROUTE SCIF TO CMS (NOALARM NONOTIFY"
"VSCREEN ROUTE MESSAGE TO MESSAGE ( ALARM NOTIFY"
"VSCREEN ROUTE WARNING TO MESSAGE ( ALARM NOTIFY"
"VSCREEN ROUTE NETWORK TO MESSAGE (NOALARM NOTIFY"
Call OFF Error
address COMMAND
mod = "WMXUPDT"
"PIPE command NUCXDROP" mod "| hole"
"ESTATE" mod "MODULE *"
if rc = 0 then
"NUCXLOAD" mod "(SYSTEM ENDCMD SERVICE PERMANENT"
else
do
say "WMX: Unable to load" mod "module."
say " CMSPF key descriptions will not be maintained."
end
/***********************************************************************/
/* Set up the PF keys. They are different from the PF key settings */
/* that are used in XEDIT or line mode. NOWRITE means not to change */
/* the pseudonym setting for the PF key. */
/* var= value */
do i = 1 to pf.0
parse var pf.i "/PF" pf "/" . "|" hint "|" command
if datatype(pf, "W") = 0 then
do
say "WMX: Invalid PF key definition 'PF"pf"' ignored"
iterate
end
if pf+0 < 1 | pf+0 > 24 then
do
say "WMX: Invalid PF key definition 'PF"pf"' ignored"
iterate
end
parse var command command '!' .
parse var command command '//' .
parse var command command '/*' .
command = strip(command)
/* 0x41 is the 'required blank'. Same appearance as blank, but things */
/* that scan for blanks won't find it. Change leading blanks and */
/* underscore to 0x41. Spruce up left and right indicators. */
hint = translate(strip(hint,"T"),"41dedf"x," <>")
if command <> "" then
"SET CMSPF" pf hint "NOECHO" command
else
"SET CMSPF" pf
end
End_Of_Command:
/***********************************************************************/
/* Get all the CMSPF key settings and display the descriptions on */
/* the bottom 2 reserved lines of the VSCREEN */
/* */
/* COLOR values: */
/* 0=Default 1=Blue 2=Red 3=Pink 4=Green 5=Turquois 6=Yellow 7=White */
/* */
/* EXTHI values: */
/* 0=Default 1=Blink 2=Reverse 4=Underline */
/* */
"QUERY FULLSCREEN (LIFO" /* If not in FS CMS, then there */
pull . onoff . /* is no reason to play with */
if onoff <> "ON" then EXIT /* CMSPF key pseudonyms. */
"SET TEXT ON" /* Force TEXT on */
"PIPE",
"| command QUERY CMSPF",
"| spec /!CMSPF./ 1 w2 n /!/ n 13.9 n",
"| strip",
"| varload"
/**********************************************************************/
/* Each PF key description consumes 13 characters. With 12 per line, */
/* that's 156 characters. A screen that's narrower than 156 has to */
/* will try squeeze extra space by hoping that some of the pseudonyms */
/* are less than 9 characters. But if they don't fit, drop them. */
/**********************************************************************/
if scrW >= 156 then
pfmax = 9 /* Force the definitions to full width. */
else
pfmax = 0
pfmlen = max(length(cmspf.01), length(cmspf.13), pfmax)
fkstr1 = " 1="left(cmspf.01, pfmlen)
fkstr2 = "13="left(cmspf.13, pfmlen)
mask = "NNN" || left("DDDDDDDD", pfmlen)
do i = 2 to 12
pfa = value( "CMSPF." || right(i, 2, "0") ) /* make it 2 digits */
pfb = value( "CMSPF." || i+12 ) /* already 2 digits */
pfmlen = max( length(pfa), length(pfb), pfmax )
/* If it makes the line too long, stop adding */
if length(mask) + pfmlen > scrW then leave
fkstr1 = fkstr1 right(i,2)"=" || left(pfa, pfmlen)
fkstr2 = fkstr2 i+12"=" || left(pfb, pfmlen)
mask = mask "NNN" || left("DDDDDDDDD", pfmlen)
end
If Init? then /* Get color numbers and save them for PF key refresh. */
do
m1 = pos( left(Color_PFNUM, 1), "BRPGTYW" ) /* Convert color name */
m2 = pos( left(Color_PFDESC, 1), "BRPGTYW" ) /* color number. */
Call Value "Color_PFND", m1 m2, GlobalVS
end
else
parse value value("Color_PFND" ,, GlobalVS) with m1 m2
mask = translate(mask, m1 m2, "N D")
wlen = length(fkstr1)+1 /* +1 for SF char */
write = "VSCREEN WRITE CMS"
write "-4 1" wlen "(RES DATA" fkstr2
write "-4 1" wlen "(RES COLOR" mask
write "-3 1" wlen "(RES DATA" fkstr1
write "-3 1" wlen "(RES COLOR" mask
/**********************************************************************/
/* Build CPU meter. It's like a linear VU meter on a tape deck. */
/* Each tick mark is 5% CPU. Usage is rounded up to the nearest */
/* multiple of 5%. That means 20 tick marks. Leave a high-water */
/* mark like a *good* VU meter. If you don't know what a VU meter */
/* or a tape deck is, I'm probably dead. */
/**********************************************************************/
parse value translate(diag(8,"INDICATE LOAD"), " ", "15"x) ,
with 1 "AVGPROC-" cpu "%" 1 "PAGING-" page "/"
parse value Value("CPU_HIGH" ,, GlobalVS) with highwater hipct hitime hidate hijul
today = date("J")
if today > hijul & time("H") > 4 then /* reset highwater after 4am tomorrow */
highwater = ""
cpu = right( cpu+0, 3)
cpuidx = (cpu+4)%5
if highwater = "" | cpu > hipct then
do
parse value cpuidx cpu time() with highwater hipct hitime
Call Value "CPU_HIGH", highwater hipct hitime date("U") today, GlobalVS
end
cpumeter = copies("af"x, 20)
if highwater > cpuidx then
cpumeter = overlay("4f"x, cpumeter, highwater)
cpumeter = right(cpu, 3)"%" cpumeter right(hipct"%", 4)
cpumeterH = "NNNN" copies("R", CPUidx) || copies("N", 20-CPUidx) "NNNN"
cpumeterC = "WWWW BBBBBGGGGGYYYYPPPRRW ????"
pagebase=left(" Paging rate:" page+0,24)
if page>500
then pageclr=copies("3",length(pagebase))
else pageclr=copies("1",length(pagebase))
when = hitime" " hidate
when2 = when x2c("BFBFBF") || x2c("BC")
write = "VSCREEN WRITE CMS 1" scrM-(length(when)%2) length(when2) "(RES"
write "DATA" when2
c = substr(cpumeterc, highwater+5, 1)
c = translate(c, "01234567", "DBRPGTYW")
write "COLOR" copies(c, length(when))
write = "VSCREEN WRITE CMS 2" scrM-(length(cpumeter)%2) length(cpumeter) "(RES"
write "DATA" cpumeter
write "COLOR" translate(cpumeterC, "01234567"c, "DBRPGTYW?")
write "EXTHI" translate(cpumeterH, "0124" , "NBRU" )
/**********************************************************************/
/* Now this idea is courtesy of Bruce Hayden, IBM. It looks for */
/* those annoying problems where you run a program that leaves */
/* your message settings messed up, particularly if you had to HX. */
/* If it happens, they are restored to they original settings. */
/* */
/* There is, of course, fine print. Very sneaky is Bruce. If you */
/* set the obscure NOPDATA ON, then this check will be suppressed. */
/* Good for when you are writing new programs. */
/**********************************************************************/
parse value translate(", "diag(8,'Q SET'), ' ', '15'x) ,
with ', MSG ' msgset . ', WNG ' wngset . ', EMSG ' emsgset . ',' ,
' IMSG ' imsgset . ',' . 'NOPDATA ' nopdata . ','
found = "MSG" msgset "WNG" wngset "EMSG" emsgset "IMSG" imsgset
wanted = Value("SET_WANTED" ,, GlobalVS)
if found <> wanted & wanted <> "" & nopdata = "OFF" then
do
pre = 'WMX: CP SET value repaired:'
col = length(pre) + 3
say pre
do until found = ""
parse var found f1 f2 found
parse var wanted w1 w2 wanted
text = f1 f2
if found <> "" then text = text", "
textL = length(text)
write = "VSCREEN WRITE CMS 0" col textL "("
write "DATA" text
if f2 = w2 then
write "COLOR" copies("4", textL) /* Green */
else
do /* warn and restore */
write "COLOR" copies("2", textL) /* Red */
"CP SET" w1 w2
end
col = col + textL
end
end
Exit /* Hasta la vista, baby! */
/*-----------------------END OF MAINLINE------------------------------*/
RGTLEFT:
/***********************************************************************/
/* Shift a window to the right or left. If currently positioned */
/* at column 1, shift right. Shift at most 75% of the window width */
/* to allow the reader to maintain context. When the end of the */
/* vscreen is reached, start back in the other direction */
/* */
/* Similar to RGTLEFT XEDIT. */
/* June 1986 */
arg wname shift .
address command
wname = word(wname "=", 1)
"QUERY WINDOW" wname "(LIFO" /* Get the name of the topmost window */
pull . wname . wW . /* and its width. */
"QUERY SHOW" wname "(LIFO" /* Find out where the window is */
pull . . . vname . wStart . /* positioned on its VSCREEEN. */
wEnd = wStart + wW -1 /* Window may be wider than vscreen! */
"QUERY VSCREEN" vname "(LIFO" /* Get VSCREEN width. */
pull . . . vW .
if wW >= vW then /* If window at least as wide as the */
exit 0 /* vscreen, then nothing to do. */
"QUERY DISPLAY (LIFO" /* Get display width */
pull . . scrW .
/***********************************************************************/
/* Figure out how much of the */
/* |wstart |wend vscreen we haven't seen, yet, */
/* V____________V in the most recent direction. */
/* 1__________________________vW If nothing remains to be seen, */
/* then reverse direction. */
/* Move the lesser of: */
/* - 75% of the display width (may be smaller than vscreen or window) */
/* - 75% of the window width */
/* - The remaining amount of unseen data in the current direction */
/* */
/* If you provide a shift amount on the call, it will override the */
/* 75% calculations. */
/***********************************************************************/
dirvar = "RTLT_"wname /* Get most recent direction */
"GLOBALV SELECT WMX GET" dirvar /* that we moved this window. */
direction = value(dirvar)
Select
when wStart = 1 then /* Start going RIGHT */
parse value "RIGHT" vW-wW with direction remaining .
when wEnd >= vW then /* Start going LEFT */
parse value "LEFT" vW-wW with direction remaining .
when direction = "LEFT" then /* Keep going LEFT */
remaining = wStart - 1
otherwise /* direction = RIGHT */ /* Keep going RIGHT */
remaining = vW - wEnd + 1
End /* 'remaining' is > 0 */
if shift <> "" then /* Limit the amount of shift */
shift = min(remaining, shift) ) /* depending on whether it was */
else /* specified or computed. */
shift = min(remaining, 75*scrW%100, 75*wW%100)
if direction <> value(dirvar) then
"GLOBALV SELECT WMX SETL" dirvar direction
"WINDOW" direction wname shift
return
ErrorOut:
/**********************************************************************/
/* Format and display error messages */
/**********************************************************************/
parse arg msgtext
say "WMX:" msgtext
exit 24
Error:
/**********************************************************************/
/* FFDC - try to catch the problem */
/**********************************************************************/
parse value Condition('D') with c1 c2 rest
if c1 = "PIPE" then return
if c2 = "DELETE" then return
Line = sigl
Return_Code = rc
stmt = sourceline(sigl)
say "Error" rc "on line" sigl": " stmt
exit