/***********************************************************************/ /* 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 order shown. All that exist will */ /* 3. WMX PROFILE be used, and the last one to change */ /* 4. WMX 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 (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 (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 */ /* 2. WMX PROFILE */ /* 3. WMX */ /* 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 overrides WMX DEFAULTS */ "| a:", "?", "state WMX PROFILE *", /* WMX PROFILE overrides WMX */ "| a:", "?", "state WMX" userid() "*", /* WMX 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