Many of you have written, asking me to publish my PROFILE XEDIT. I was
reluctant as it had formed over the decades by a process I can best describe
as "accretion". It had a lot of barnacles and rust (the embarrasing
parts) that needed to be cleaned up. That's been done and lots of commentary
added to explain why I did what I did. Enjoy!!
Alan
May 2015
This profile sets PF keys 3, 7, and 8 to the WMX program. It is
available at the same web site.
Alan
July 2015
/**********************************************************************/
/* This XEDIT profile is a "super-profile". It is a self-contained */
/* macro that functions not only as a traditional XEDIT profile, */
/* but as a "container" that holds other macros. */
/* */
/* It contains a PROFILE, a FILE/FFILE processor, and a macro to */
/* toggle the scale and tab lines on and off. */
/* */
/* It does this by taking advantage of the fact that XEDIT accepts, */
/* but does not use, any string specified after the end of the */
/* XEDIT options, deliminted by the rarely-used right parenthesis. */
/* */
/* This is also used to supply various options that help in the */
/* development of new functions. */
/* */
/* It caters to traditional CMS files on mindisk or SFS. Some */
/* accomodation is made for BFS, but only to the extent of figuring */
/* out the proper CRLF sequences for text files. (Not too shabby */
/* since it's easy to find FTP servers/clients that don't follow */
/* RFC 959 which defines it as 0x0d0a. So I accommodate that here. */
/* */
/* Note the use of the EMSG subcommand. In the standard profile */
/* section of this macro, it is always queued, never issued */
/* directly. This is important if you have more than one message */
/* to issue. */
/* -------------------- */
/* Mr. Toad's Wild Ride */
/* This PROFILE XEDIT has been evolving since I first joined IBM in */
/* 1982. As a VM developer, there were editing rules that had to */
/* followed and this profile tried to simplify that for me as much */
/* possible. And one day I was able to make my 3270 wider than */
/* 80 characters. That made the world more complicated and my */
/* macros along with it. */
/* */
/* I use a terminal that is 42 x 160, and most of my work is intended */
/* to be viewed in such dimensions. I try to be tolerant of lesser */
/* displays, but I'm only willing to spend so much effort to do it. */
/* */
/* There are various programming styles throughout the program. */
/* Sometimes I wrote defensively and sometimes, well, not so much. */
/* O.M.G.! There are even times when I put "then do" on one line! */
/* */
/* You will see a mix of single and double quotes. In my younger */
/* days I used single quotes, graduating to double quotes later. */
/* There is a certain elegance in using one or the other, but I have */
/* to say "move past it." Trying to change them simply breaks */
/* perfectly fine code. And when you're done fixing it, you have */
/* a program that doesn't do anything more than when you started. */
/* So if you feel like changing it, lie down until the feeling goes */
/* away. (Inhale energy. Exhale stress. In....out...in...out.... */
/* */
/* Finally, I work in code page 924 (ISO 8859-15) and with SET TEXT */
/* ON, so you might see some odd characters with other settings. */
/* If you're still using SET TRANSLATE, to get square brackets, stop */
/* it. The 1980s called and they want their code back. */
/* */
/* Please enjoy what you find here. If you find something that */
/* doesn't work right for you, let me know. I like generic */
/* solutions, not ones that only work for me. If you figure out */
/* how to convert this to one big pipeline, keep it to yourself, */
/* please. I tried to be conservative in my use of odd semantics, */
/* but I also tried to expand my education as I went. */
/* */
/* Learn, improve, and teach those that follow. */
/* */
/* Alan Altmark, IBM Endicott */
/* Sir Alan, Lord of the Protocols May 2, 2015 */
/* IBM z Systems Lab Services and Training */
/**********************************************************************/
/* */
/* XEDIT ... ( . ) option-list */
/* */
/* DEBUG - Turns on various debugging capabilities */
/* NOSAVE - Don't update GLOBALV with memory of this file */
/* NORESET - Don't restore any remembered settings */
/* NOLOAD - Let XEDIT implicitly load the file with all default */
/* options. Implies NOSAVE. */
/* WORD UPPERCASE | LOWERCASE - Change case of word @ cursor */
/* SCALE PFxx ON | OFFs - Turns the scale on or off. */
/* SETCURL - Makes the line with athe cursor the current line */
/* LINEADD - Sophisticated lineadd function */
/* EXIT or - Will save file-specific settings and exit */
/* CLOSE If specified, it must appear last as it takes an */
/* XEDIT subcommand as its argument. E.g. EXIT PFILE */
/* */
/* Options specified after closing parentheses because that's how */
/* you pass your own options to XEDIT. */
/* */
/**********************************************************************/
Trace 'O'
parse arg fid '(' opts ')' sysparm 1 xeditarg, bfsname
parse upper value space(opts) with opts
GlobalV = 'Lasting XEDPROF'
upper sysparm
$DEBUG = sign( wordpos('DEBUG' , sysparm) )
$EXIT = sign( wordpos('EXIT' , sysparm) )
$CLOSE = sign( wordpos('CLOSE' , sysparm) )
$SCALE = sign( wordpos('SCALE' , sysparm) )
$WORD = sign( wordpos('WORD' , sysparm) )
$SETCURL = sign( wordpos('SETCURL' , sysparm) )
$LINEADD = sign( wordpos('LINEADD' , sysparm) )
$LOAD = 1-sign( wordpos('NOLOAD' , sysparm) )
$SAVE = 1-sign( wordpos('NOSAVE' , sysparm) )
$RESTORE = 1-sign( wordpos('NOREST' , sysparm) )
if ($EXIT) then Signal Save_And_Exit
if ($CLOSE) then Signal Save_And_Exit
if ($SCALE) then Signal ToggleScale
if ($WORD) then Signal DoWord
if ($SETCURL) then Signal SetCurline
if ($LINEADD) then Signal LineAdd
IsOS? = 0
/**********************************************************************/
/* For BFS files, determine the end-of-line sequence. For existing */
/* files, look for common EOL in the first 150 characters. For new */
/* files, use the EBCDIC POSIX sequence CRNL (0x0d15). This ensures */
/* that the z/VM TCP/IP POSIX translation table uses the correct */
/* ASCII sequence 0x0d0a to signal EOL. */
/**********************************************************************/
bfsline = ""
if bfsname <> "" & words(bfsname) = 1 then
do
if wordpos('BFSLINE', opts) > 0 then
signal LOAD
fid = bfsname
tname = strip(bfsname, "Both", "'")
address command "PIPE var tname | BFSSTATE | hole"
if rc <> 0 then do
bfsline = "BFSLINE /X'0D15'/"
queue "EMSG Linend = 0x0d15"
signal LOAD
end
address command "PIPE BFS" bfsname "| trunc 150 | var line1"
Select
when rc <> 0 then nop
when pos("0D15"x, line1) > 0 then do
bfsline = "BFSLINE /X'0D15'/"
queue "EMSG Linend = 0x0d15"
end
when pos("0D25"x, line1) > 0 then do
bfsline = "BFSLINE CRLF"
queue "EMSG Linend = CRLF (0x0d25)"
END
when pos("15"x, line1) > 0 then do
bfsline = "BFSLINE NL"
queue "EMSG Linend = NL (0x15)"
END
otherwise
bfsline = ""
queue "EMSG Warning: No linend characters present in first 150 characters!"
End
signal LOAD
end
/**********************************************************************/
/* Process regular CMS files. BFS has been handled. */
/**********************************************************************/
parse var fid fn ft fm . /* We'll reassemble fid later */
/**********************************************************************/
/* Look for abbreviations or misspellings of commonly used files. */
/* List is pairs of '/abbrev real'. By prefixing the list with the */
/* original value, 'not found' will return the original value. */
/**********************************************************************/
If fn <> "" then
do
fixup = fn "/PORFILE PROFILE /PROFIEL PROFILE /*" userid()
fn = word(fixup, wordpos( "/"fn, fixup) +1 )
end
if ft <> "" then
do
fixup = ft "/A ASSEMBLE /E EXEC /X XEDIT /L LISTING" ,
"/M MACRO /P PASCAL /V VTAMLST /S SCRIPT" ,
"/SYN SYNONYM /HMTL HTML /EXE EXEC /*" userid(),
"/UT1 SYSUT1"
ft = word(fixup, wordpos( "/"ft, fixup) +1 )
end
/**********************************************************************/
/* If you leave off fn, ft, or fm, (or specify as '=') it defaults */
/* the that of the most recently edited file. The exception is fm. */
/* It defaults to '*'. If you want the previously specified fm, then */
/* use '='. */
/**********************************************************************/
fm = word(fm '*', 1)
If (words(fid) < 3 | find(fid,'=') > 0) then
do
parse value value('LASTFILE' ,, GlobalV) ,
with oldfid 1 oldfn oldft oldfm
if fn = '=' | fn = '' then fn = oldfn
if ft = '=' | ft = '' then ft = oldft
if fm = '=' then fm = oldfm
if ($DEBUG) then
queue 'EMSG Infile='fid 'Realfile=' fn ft fm
end
fid = fn ft fm /* Reassemble file id. GLOBALV key excludes */
gv_key = fn'/'ft /* filemode since file may move. */
/**********************************************************************/
/* Since you can XEDIT a file on an OS-formatted disk (read-only), */
/* need to check for that. If so, issue FILEDEF so that XEDIT can */
/* find it. Must specify filemode for this to work. */
/**********************************************************************/
if fm = '*' then
Signal Load
address command "PIPE COMMAND QUERY DISK" FM,
"| drop 1",
"| spec w7 1",
"| var isOS?"
if isOS? = "OS" then
address command "FILEDEF SYSIN DISK" fid
LOAD:
/**********************************************************************/
/* Now we're going to explicitly load the file into memory with all */
/* the needed options. The only time you bypass this is if you */
/* use the NOLOAD parameter: xedit fn ft () noload */
/**********************************************************************/
if ($DEBUG) then /* DEBUG option will cause the */
queue 'EMSG LOAD' fid '(' bfsline opts
address XEDIT
'COMMAND LOAD' fid '(' bfsline opts /* Ok, XEDIT, now LIFT.... */
xrc = rc
if isOS? = "OS" then
address command "FILEDEF SYSIN CLEAR"
if xrc >= 4 then /* Exit if errors */
exit xrc
NOLOAD:
/**********************************************************************/
/* If file was not loaded by the LOAD command, it will load as soon */
/* as the first XEDIT command is issued. */
/**********************************************************************/
'SET MACRO OFF' /* Prevent macro interference */
'SET TRUNC *' /* No involuntary truncation */
'SET ZONE 1 *' /* Search to truncation point */
'EXTRACT /TRUNC/ZONE/LSCREEN/NBFILE/FNAME/FTYPE/FMODE/BASEFT/NAMETYPE'
/**********************************************************************/
/* Remember name of this file unless: */
/* - It's the same file as last time (we already remembered it) */
/* - This isn't the first file in the XEDIT ring */
/* - It's a BFS file (no "missing parts" to remember!) */
/* - The NOLOAD or NOSAVE option was specified */
/**********************************************************************/
If (fid <> oldfid) & (nbfile.1 = 1) ,
& nametype.1 = "CMS" & ($SAVE) & ($LOAD) then
Call Value 'LASTFILE', fn ft fm , GlobalV
/**********************************************************************/
/* Set the "effective" filetype. This value is used to determine any */
/* filetype-specific settings or behavior. It's necessary because */
/* UPDATE mode will always be used with a non-standard base filetype. */
/* E.g. $EXEC or $COPY. The more unusual values you see here are */
/* specific to the way the z/VM source iteself is maintained. I */
/* assume here that the first 3 characters are unique. If you need */
/* more granularity, don't be afraid to add it. I should probably */
/* check for UPDATE mode before doing this, but I've never had a */
/* problem. */
/**********************************************************************/
fixup = baseft.1 "/ASM ASSEMBLE /MSS MESSAGES /PAS PASCAL /CEE C" ,
"/CPY COPY /$HH H /$EX EXEC /$XE XEDIT" ,
"/REP REPOS /$IC INCLUDE /$CO COPY /$IN INCLUDE"
ft = word( fixup, wordpos("/"left(baseft.1,3), fixup) +1 )
/**********************************************************************/
/* ß START CUSTOMIZATIONS ß */
/* */
/* This is where you really start to customize things. Everything */
/* above is mostly just base file resolution. */
/**********************************************************************/
/********************************************************************/
/* Set special options for certain file types. */
/* */
/* The list of options to set is in SET_LIST. The values are in */
/* the same ordinal column of SET.<filetype>. Any periods will be */
/* changed to blanks when it comes time to issue the command. */
/* --------------------- */
/* In years gone by, this was a much more extensive array, but I */
/* found better ways to do certain things and it was trimmed back. */
/* Experience is the best teacher. */
/********************************************************************/
set_list = 'TABS'
Set. = ''
Set.INCLUDE = '1.40.71'
Set.EXEC = '1.40.71'
Set.GCS = '1.40.71'
Set.XEDIT = '1.40.71'
Set.C = '1.9.17.25.33.41.49.57.65.73.81'
Set.H = '1.9.17.25.33.41.49.57.65.73.81'
Set.COPY = '1.10.16.40.71'
Set.ASSEMBLE = '1.10.16.40.72'
Set.RPIBASE0 = '1.10.16.40.72'
Set.PLAS = '1.10.16.40.72'
Set.MACRO = '1.10.16.40.72'
Set.MACLIB = '1.10.16.40.72'
Set.PANEL = '1.10.16.40.72'
Set.PLS3 = '1.2.35.71'
if set.ft <> '' then do /* We have some settings to */
temp = Set.ft /* apply. */
do i = 1 to words(set_list)
if word(temp,i) <> '-' then
'COMMAND SET' word(set_list,i) translate(word(temp,i),' ','.')
end
end
SetView:
/**********************************************************************/
/* If we have serial numbers in the file, exclude them from view and */
/* from search. Serial numbers are present if we're in UPDATE */
/* mode, or if it's a fixed-length file that has numbers in the last */
/* ----------------- */
/* No, you're not imagining things. This profile is obsessed with */
/* UPDATE mode. That's what happens when you do development with */
/* tight change control processes! */
/**********************************************************************/
serno? = 0
'EXTRACT /UPDATE/SIZE/LINE/RECFM/LRECL/SERIAL/PREFIX'
Select
when serial.1 <> "OFF" then /* Serial numbers explicitly */
serno? = 1 /* requested. */
when update.1 = "ON" then /* UPDATE mode, so the file */
serno? = 1 /* has serial numbers, by def. */
when (size.1 > 0) & (recfm.1 = 'F') then
do /* Go to line 1 and see if */
'LOCATE :1' /* it has serial numbers in */
'EXTRACT /CURLINE' /* last 8 columns. */
if verify(right(curline.3,8), '0123456789') = 0 then
serno? = 1
'LOCATE :'line.1 /* Restore position in file */
end
otherwise nop
End
/**********************************************************************/
/* Fun times. How much data (width) should we show? */
/* - I don't want to see the serial numbers. */
/* - The last column of the display can't be used for data */
/* - Prefix takes up space (if present) */
/* - Logical screen size < physical */
/* - No point in displaying more than the truncation column */
/* or the logical record length. */
/* */
/* So whichever of those is the smallest wins. Search zone will */
/* include the invisible parts of the line, but not the serial nos. */
/**********************************************************************/
if serno? then lrecl = lrecl.1 - 8 /* Don't search serial #s */
else lrecl = lrecl.1
if prefix.1 = "OFF" then ScrWidth = lscreen.2 - 1
else ScrWidth = lscreen.2 - 7
'SET ZONE 1' lrecl
'SET VERIFY OFF 1' min(lrecl, trunc.1, ScrWidth)
/**********************************************************************/
/* Some miscellaneous settings */
/**********************************************************************/
'SET ARBCHAR ON ~' /* Arbitrary char for search */
'SET NONDISP `' /* Non-displayable substitute */
'SET VARBLANK ON' /* Variable # of blanks ok */
'SET STAY ON' /* Stay put if search fails */
'SET WRAP ON' /* Search entire file */
'SET SERIAL OFF' /* No automatic serialization */
'SET PREFIX NULLS LEFT' /* Prefix on the left */
'SET NUMBER ON' /* Use line number */
'SET NULLS ON' /* Use trailing nulls */
'SET HEX ON' /* Enable LOCATE /X'C1C2C3' */
'SET MSGLINE ON 3' lscreen.1-2 'OVERLAY' /* Leave 2 lines @ bottom */
'SET CURLINE ON 4'
'SET CMDLINE TOP' /* So 3270 kbd HOME key works */
'SET SCALE OFF' /* Because F13 toggles it */
'SET FULLREAD ON' /* Respect cursor location */
'SET AUTOSAVE 10' /* Cover Your Anatomy */
'SET CASE MIXED IGNORE' /* HLASM is mixed case. But */
/* beware ASSEMBLE is not! */
/**********************************************************************/
/* Set up PF keys */
/**********************************************************************/
'SET PF1 MACRO PROFILE () SCALE PF1 ON'
'SET PF2 MACRO PROFILE () LINEADD'
'SET PF3 EXEC WMX CLOSE'
'SET PF7 EXEC WMX BACKWARD'
'SET PF8 EXEC WMX FORWARD'
'SET PF13 MACRO PROFILE () SETCURL'
'SET PF19 MACRO PROFILE () WORD LOWERCAS'
'SET PF20 MACRO PROFILE () WORD UPPERCAS'
'SET PF22 LEFT 10'
'SET PF23 RIGHT 10'
'SET PF24 COPYKEY'
'SET PA3 SOS LINEDEL' /* Buglet: CP doesn't recognize PA3 even */
/* though CMS does! :-( */
/**********************************************************************/
/* Set colors for the sophisticated XEDIT user. */
/**********************************************************************/
'SET COLOR ARROW GREEN NONE HIGH'
'SET COLOR CMDLINE GREEN NONE NOHIGH'
'SET COLOR CURLINE WHITE NONE HIGH'
'SET COLOR FILEAREA YELLOW NONE NOHIGH'
'SET COLOR IDLINE PINK NONE HIGH'
'SET COLOR MSGLINE RED NONE HIGH'
'SET COLOR PENDING RED NONE HIGH'
'SET COLOR PREFIX TURQUOISE NONE NOHIGH'
'SET COLOR SCALE TURQUOISE NONE HIGH'
'SET COLOR SHADOW GREEN NONE NOHIGH'
'SET COLOR STATAREA RED UNDERLINE HIGH'
'SET COLOR TABLINE GREEN NONE HIGH'
'SET COLOR TOFEOF PINK NONE NOHIGH'
/**********************************************************************/
/* Set synonyms. Note that FILE and FFILE will come back to this */
/* exec so that settings can be saved. (Not for BFS.) */
/**********************************************************************/
if nametype.1 = "CMS" then
do
'SET SYNONYM FILE MACRO PROFILE () EXIT COMMAND PFILE'
'SET SYNONYM FFILE MACRO PROFILE () EXIT COMMAND FILE'
end
'SET SYNONYM RPT REPEAT' /* When Chuckie has control of */
'SET SYNONYM FIEL FILE' /* my fingers, he often makes */
'SET SYNONYM FLIE FILE' /* a lot of errors, so I try my*/
'SET SYNONYM FUKE FILE' /* best to counteract his evil */
'SET SYNONYM FO;E FILE' /* influence. But I have to */
'SET SYNONYM TP TOP' /* say that it's the changes in*/
'SET SYNONYM BOTTOM 1 LOCATE * BACK 1' /* laptop keyboards that cause */
'SET SYNONYM XEDIT 1 XEDIT' /* the most errors these days! */
'SET SYNONYM QUERY 1 QUERY'
'SET SYNONYM LPR CMS LPR'
/**********************************************************************/
/* Set some of my fave prefix commands. You don't have these, but */
/* here's what they do: */
/* COMBOX Build a language-appropriate comment box like this one. */
/* COMMENT Comment or uncomment the designated line(s). */
/* PREFIXJ Justify right, left, or center the indicated line(s). */
/* PREFIXP Copy the line(s) into the XEDIT "clipboard". */
/* PREFIXG Copy the contents of the clipboard after this line. */
/* PREFMERG Merge the block of lines into a single line. If you use */
/* MERG, it merges the current line with the next line. */
/* PREFIXH2 Invoke COL on the indicated lines. */
/* ---------------------------------- */
/* It annoys me that the 'oldname' parameter on SET SYNONYM is */
/* limited to 8 characters. It make it difficult to re-package */
/* them into this profile. */
/**********************************************************************/
Call Prefix_Synonym 'COMBOX ' , 'BX BBX BXO'
Call Prefix_Synonym 'COMMENT ' , 'K KK'
Call Prefix_Synonym 'PREFIXJ ' , 'J JJ JL JJL JR JJR'
Call Prefix_Synonym 'UPLOW ' , 'L LL U UU'
Call Prefix_Synonym 'PREFIXG ' , 'G GG'
Call Prefix_Synonym 'PREFIXP ' , 'W WW WD WWD'
Call Prefix_Synonym 'PREFIXH2' , 'H HH' /* COL */
Call Prefix_Synonym 'PREFMERG' , 'MERG MERGG'
/**********************************************************************/
/* If NOREST not specified, restore SET POINT labels and any settings */
/* were saved previously. This is one of my most useful additions. */
/**********************************************************************/
if ($RESTORE) then
do
points = value( gv_key'/POINTS' ,, GlobalV )
saypoints = ''
do while points <> ''
parse var points this points
parse var this line '_' names
names = translate(names, ' ','_')
saypoints = saypoints names
'LOCATE :'line
do j = 1 to words(names)
'SET POINT .'word(names,j)
end
end
if saypoints <> '' then
do
'TOP'
'EMSG POINT names restored:' space(saypoints,1)
end
/* Restore any file-specific settings */
settings = value( gv_key'/SETTINGS' ,, GlobalV )
do while settings <> ''
parse var settings xcmd xval settings
xcmd = translate(xcmd, ' ', '_') xval
xcmd
if ($DEBUG) then
'EMSG Restored' xcmd
end
end
/**********************************************************************/
/* Display date & time of last update in lower right */
/**********************************************************************/
'PIPE state' fname.1 baseft.1 fmode.1 ,
'| spec /Last Changed:/ 1 w8 nw /at/ nw w9 nw',
'| var footer'
if rc = 28 then footer = 'New file'
"PIPE command QUERY DISPLAY | spec w3 | var cols"
'SET RESERVED -1 DEFAULT NONE NOHIGH' right(footer, cols-1)
/**********************************************************************/
/* For new EXECs and XEDIT macros, insert a comment with name, */
/* place, and date for posterity. This is how I know that I wrote */
/* my LINEADD macro (see below) back in 1983. */
/**********************************************************************/
if size.1 = 0 & wordpos(ft, 'EXEC XEDIT') > 0 then
do
'COMMAND INPUT /*' fn ft '- Alan Altmark, Endicott,' date(USA) '*/'
'COMMAND TOP'
'COMMAND SET ALT 0 0' /* QQUIT not required */
end
'SET MACRO ON'
exit
Prefix_Synonym:
/**********************************************************************/
/* Set up line prefix synonyms. A command or macro is provided */
/* along with a list of abbreviations to be associated with the */
/* given command or macro. */
/**********************************************************************/
arg macname, abbrv
do i = 1 to words(abbrv)
'COMMAND SET PREFIX SYNONYM' word(abbrv,i) macname
end
return
/**********************************************************************/
/* "External" Subroutines */
/**********************************************************************/
/* Here are the elements of the super-profile that provide extra */
/* functions not related to initial loading of a file. Doing it */
/* this way lets me ship my PROFILE XEDIT around without having to */
/* worry about the external file dependencies. */
/**********************************************************************/
LineAdd:
/********************************************************************/
/* I wrote this in 1983. It inserts a blank line and positions */
/* the cursor to the first non-blank column in the prior line. */
/********************************************************************/
'PRESERVE' /* Save important settings */
'STREAM OFF' /* CLOCATE only current line */
'MSGMODE OFF' /* Don't tell me about errors */
'EXTRACT /CURSOR/COLUMN/LINE' /* Where are we in the file? */
savecol = column.1 /* Remember the column no. */
'ZONE 1 *'
'CLOCATE :0' /* Reset to start of line */
'LOCATE :'cursor.3 /* Bring selected line up */
'CLOCATE ^/ /' /* Find first non-blank */
if rc = 2 then /* If line is blank, then use */
'CLOCATE :'cursor.4 /* cursor location.. */
'SOS LINEADD' /* Add line */
'EXTRACT /CURSOR/COLUMN' /* Where are we again? */
'COMMAND CURSOR FILE' cursor.3 column.1 /* Position cursor */
'RESTORE' /* Put everything back where */
'LOCATE :'line.1 /* and how we found them. */
'CLOCATE :'savecol
exit
DoWord:
/********************************************************************/
/* Change word @ cursor to upper or lower case as requested. */
/* A 'word' is a token that's delimited by a blank or the usual */
/* REXX delimiters and operators. It works by scanning to either */
/* with the delimiters. (Frankly, I wrote it so long ago that I */
/* don't remember much more about it! It just works....) */
/********************************************************************/
parse var sysparm 'WORD' cmd .
cmd = word(cmd 'LOWERCAS', 1)
'EXTRACT /LINE/CURSOR' /* Remember where we parked. */
if CURSOR.3 = -1 then
'EMSG Cursor not on a valid line'
else
do
delim = ' ,"+-?<>&[]{}\%^$!|./:;*%=' || "'"
Rdelim = ')'delim
Ldelim = '('delim
'PRESERVE'
'LOCATE :'cursor.3
'EXTRACT /CURLINE' /* Go get the line the cursor is on. */
line = curline.3
if substr(line, cursor.4, 1) = ' ' then
'EMSG Cursor is not located on a word'
else
do
revline = reverse(line)' '
Lcol = verify( revline, Ldelim, 'MATCH', length(line)-cursor.4+1 )
Lcol = length(line) - Lcol + 1
Rcol = verify( line' ', Rdelim, 'MATCH', cursor.4 )
'COMMAND SET ZONE' Lcol+1 Rcol-1
cmd
end
'restore'
'LOCATE :'line.1 /* Put everthing back the way */
'CURSOR FILE' cursor.3 cursor.4 /* we found it. */
end
exit
SetCurline:
/********************************************************************/
/* I wrote this back in May 1988. It makes the line with the */
/* cursor the current line. */
/********************************************************************/
'EXTRACT /CURSOR'
if cursor.3 = -1 then
'EMSG Cursor not on valid line'
else
'LOCATE :'cursor.3
ToggleScale:
/**********************************************************************/
/* Toggle the SCALE line on/off. Put it wherever the cursor is. */
/* Invoked by PROFILE () SCALE PFxx ON | OFF */
/**********************************************************************/
parse var sysparm 'SCALE' key parm .
if parm = 'ON' then
do
'COMMAND EXTRACT /CURSOR'
'COMMAND SET MSGMODE OFF'
'COMMAND SET SCALE ON' cursor.1+1
'COMMAND SET TABLINE ON' cursor.1+2
'COMMAND SET MSGMODE ON'
'COMMAND SET' key 'ONLY MACRO PROFILE () SCALE' key 'OFF'
end
else
do
'COMMAND SET SCALE OFF'
'COMMAND SET TABLINE OFF'
'COMMAND SET' key 'ONLY MACRO PROFILE () SCALE' key 'ON'
end
exit
Save_And_Exit:
/**********************************************************************/
/* This routine is invoked when you are exiting the file with FILE */
/* or FFILE. It saves some XEDIT attributes so that they can be */
/* restored when the file is again edited. For simple settings, just */
/* add to the 'settings' variable. Note use of underscores. */
/* */
/* This routine is invoked by PROFILE () EXIT <command> */
/**********************************************************************/
parse var sysparm sysparm 'EXIT' ecmd
if ($SAVE) then
do
'EXTRACT /FNAME/BASEFT/FMODE/LINE/TEXT/APL/POINT *'
gv_key = strip(fname.1)'/'strip(baseft.1)
settings = 'LOCATE :'line.1 'SET_TEXT' text.1 'SET_APL' apl.1
Call Value gv_key'/SETTINGS' , settings, GlobalV
/******************************************************************/
/* Gather all of the name pointers and save them in the POINTS */
/* sub-variable. */
/******************************************************************/
points = ''
do i = 1 to point.0
parse var point.i . lineno names
points = points lineno'_'space(names, 1, '_')
end
Call Value gv_key'/POINTS', points, GlobalV
end
Select
when ecmd = '' then
ecmd = 'COMMAND PFILE'
when word(ecmd, 1) <> 'COMMAND' then
ecmd = 'COMMAND' ecmd
otherwise nop
End
if ($DEBUG) then
say "Exiting using command" ecmd
ecmd
exit rc