From: fairfield@slacvx.slac.stanford.edu
Subject: MATCHD.1-of-1 (Re: Procedure to matchup (){}[]  ???)
Organization: Stanford Linear Accelerator Center
Date: Sun, 8 Nov 1992 23:21:44 GMT

In article <1992Nov8.053543.383@wsuhub.uc.twsu.edu>, ldgiltne@wsuhub.uc.twsu.edu (Lawrence Giltner) writes:
> Before I spend a lot of time reinventing the wheel:
> 
> Does anybody have a procedure to pair up parenthesis, brackets, and
> braces.  I would like to put the cursor on one of ()[]{} and let the
> program figure out which direction it has to search and if found, then
> marks/selects all the text between them, including the ()[]{}.
> 
> Is there a TPU procedure for this?   TPU v2.6 on VMS v5.5.

    Below I've included a VMS_SHARE file containing TPU code to do just
what you want.  In addition to matching (), [], and {}, it matches <>,
`', Ascii(171) with  Ascii(187) [the left an right angle-quotation marks],
and Asccii(191) with ? [the upside-down with the rightside-up quesion marks].
It also matches double quotes with each other, but that's pretty much useless
as they have no "parity"...

    The TPU file is in a form suitable to be include in an EVE$BUILD master 
list, i.e., with MODULE_IDENT and MODULE_INIT routines.  If you just want to
EXTEND TPU * and save the sectionfile, you'll need to move the definition
of khf$kt_left_delims and khf$kt_right_delims to your init file, or into
the main procedure, EVE_MATCH_DELIMITORS, defining them each time through the
routine...

    To use, just put the cursor on one member of the delimitors you want to 
match, then hit DO and type "MATCH" on the EVE command line (or define a key 
to do MATCH DELIMITORS and press that key).

		Cheers, Ken
-- 
 Dr. Kenneth H. Fairfield    |  Internet: Fairfield@Slac.Stanford.Edu
 SLAC, P.O.Box 4349, MS 98   |  DECnet:   45537::FAIRFIELD (45537=SLACVX)
 Stanford, CA   94309        |  BITNET    Fairfield@Slacvx
 ----------------------------------------------------------------------------
 These opinions are mine, not SLAC's, Stanford's, nor the DOE's...

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 8.1
$!   On  8-NOV-1992 15:08:14.25   By user FAIRFIELD   
$!
$! The VMS_SHARE software that created this archive
$!    was written by  Andy Harper, Kings College London UK
$!    -- September 1992
$!
$! Credit is due to these people for their original ideas:
$!    James Gray, Michael Bednarek 
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. MATCHDELIM.TPU;2
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_UNPACK_TEMP","SYS$SCRATCH:."+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if .not. f$trnlnm("SHARE_UNPACK_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto start
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$unpack: subroutine ! P1=filename, P2=checksum, P3=attributes
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'"
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn' File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-UNPACK, Unpacking file ''P1'"
$ n=P1
$ if P3 .nes. "" then $ n=f
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='n'
PROCEDURE GetHex LOCAL x1,x2;x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,
ERASE_CHARACTER(1))-1;RETURN 16*x1+x2;ENDPROCEDURE;
PROCEDURE SkipPartsep LOOP EXITIF INDEX(ERASE_LINE,"-+-+-+-+-+-+-+-+")=1;
ENDLOOP;ENDPROCEDURE;
PROCEDURE ExpandChar CASE CURRENT_CHARACTER FROM ' ' TO 'z' ["`"]
:ERASE_CHARACTER(1);COPY_TEXT(ASCII(GetHex));[" "]:ERASE_CHARACTER(1);[
OUTRANGE,INRANGE]:MOVE_HORIZONTAL(1);ENDCASE;ENDPROCEDURE;
PROCEDURE ProcessLine s:=ERASE_CHARACTER(1);LOOP EXITIF CURRENT_OFFSET>=LENGTH(
CURRENT_LINE);ExpandChar;ENDLOOP;IF s="V" THEN APPEND_LINE;ENDIF;ENDPROCEDURE;
PROCEDURE AdvanceLine MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);
ENDPROCEDURE;PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=
END_OF(b);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep;
ELSE ProcessLine;AdvanceLine;ENDIF;ENDLOOP;ENDPROCEDURE;SET(FACILITY_NAME,
"UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,OFF);t:="0123456789ABCDEF";f:=
GET_INFO(COMMAND_LINE,"file_name");b:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,
GET_INFO(COMMAND_LINE,"output_file"));QUIT;
$ if p3 .eqs. "" then $ goto dl
$ open/write fdl &f
$ write fdl "RECORD"
$ write fdl P3
$ close fdl
$ w "-I-CONVRFM, Converting record format to ", P3
$ convert/fdl=&f &f-1 &P1
$dl: delete 'f'*
$ if P2 .eqs. "" then $ goto ckskip
$ checksum 'P1'
$ if checksum$checksum .nes. P2 then $ -
  e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ exit
$ckskip: e "-W-CHKSUMSKIP, checksum validation unavailable for ''P1'"
$ endsubroutine
$start:
$!
$ create 'f'
Xprocedure`20KHF_MATCHD_MODULE_IDENT
X`09return`20"V02-001";
Xendprocedure;
X
X
Xprocedure`20KHF_MATCHD_MODULE_INIT
X
X!+
X!`20`20Initialize`20marker`20variables`20used`20by`20Eve_Match_Delimitors:
X!-
X`20`20khf$x_match1_position:=`200;
X`20`20khf$x_match2_position:=`200;
X`20`20khf$x_match3_position:=`200;
X`20`20khf$x_match4_position:=`200;
X
X!+
X!`20`20Initialize`20list`20of`20delimitors`20used`20by`20Eve_Match_Delimitors.
V`20`20Include
X!`20`20double-angle`20quotes`20and`20upside-down`20question`20mark`20in`20deli
Vmitor`20list;
X!`20`20a`20generic`20double-quote`20mark`20matches`20itself.`20`20A`20user`20m
Vay`20modify`20these
X!`20`20strings`20in`20a`20TPU$COMMAND`20procedure.
X!-
X`20`20khf$kt_left_delims`20`20:=`20Ascii(34)`20+`20"(<`5B`60`7B"`20+`20Ascii(1
V71)`20+`20Ascii(191);
X`20`20khf$kt_right_delims`20:=`20Ascii(34)`20+`20")>`5D'`7D"`20+`20Ascii(187)
V`20+`20"?";
X
Xendprocedure;
X
X
X!++
X!`20`20`20This`20procedure`20highlights`20(in`20BOLD,`20REVERSE`20video)`20mat
Vching`20pairs
X!`20`20`20of`20delimitors,`20the`20first`20of`20which`20is`20taken`20to`20be
V`20the`20character`20at
X!`20`20`20the`20current`20cursor`20position.`20`20Highlighting`20is`20turned
V`20off`20by`20invoking
X!`20`20`20this`20procedure`20with`20the`20cursor`20positioned`20on`20a`20non-d
Velimitor`20character.
X!`20`20`20Subsequent`20invocations`20turn`20off`20the`20highlighting`20on`20pr
Veviously`20matched
X!`20`20`20pairs,`20as`20well.
X!
X!`20`20`20This`20procedure`20uses`20the`20global`20marker`20variables`20khf$x_
Vmatch1_position,
X!`20`20`20khf$x_match2_position,`20khf$x_match3_position,`20and`20khf$x_match4
V_position.
X!
X!`20Author/Date:`09`09K.H.`20Fairfield,`09`0916-Jan-1988
X!
X!--
XProcedure`20Eve_Match_Delimitors
X!`09`20`20--------------------
XLocal`20saved_mark,`09!`20mark`20current`20position
X`20`20`20`20`20`20first_char,`09!`20first`20character`20of`20matching`20pair
X`20`20`20`20`20`20last_char,`09!`20second`20character`20of`20matching`20pair
X`20`20`20`20`20`20direction,`09!`20search`20direction
X`20`20`20`20`20`20n;`09`09!`20character`20position`20in`20khf$kt_left_delims
V`20or
X`09`09`09!`20khf$kt_right_delims`20string.
X
X
X`20`20`20`20On_Error
X`09`5BTPU$_CONTROLC`5D:
X`09`20`20`20`20Eve$Learn_Abort;
X`09`20`20`20`20Eve$$Restore_Position`20(saved_mark);
X`09`5BOTHERWISE`5D:
X`09`20`20`20`20Eve$$Restore_Position`20(saved_mark);
X`20`20`20`20Endon_Error;
X
X
X`20`20`20`20saved_mark`20:=`20Mark`20(NONE);
X
X!+
X!`20`20Make`20an`20early`20return`20here`20if`20the`20current`20position`20is
V`20the`20same
X!`20`20position`20as`20the`20last`20previously`20marked`20delimitor.
X!-
X`20`20`20`20If`20khf$x_match1_position`20<>`200`20Then
X`09If`20saved_mark`20=`20khf$x_match1_position`20Then
X
X`09`20`20`20`20khf$x_match1_position:=`200;
X`09`20`20`20`20khf$x_match2_position:=`200;
X`09`20`20`20`20khf$x_match3_position:=`200;
X`09`20`20`20`20khf$x_match4_position:=`200;
X`09`20`20`20`20Return`20(TRUE);
X
X`09Endif;
X`20`20`20`20Endif;
X
X`20`20`20`20first_char`20:=`20CURRENT_CHARACTER;
X
X`20`20`20`20n`20:=`20Index`20(khf$kt_left_delims,`20first_char);
X
X`20`20`20`20If`20n`20>`200`20Then
X`09last_char`20:=`20Substr`20(khf$kt_right_delims,`20n,`201);
X`09direction`20:=`20FORWARD;
X`20`20`20`20Else
X`09n`20:=`20Index`20(khf$kt_right_delims,`20first_char);
X
X`09If`20n`20>`200`20Then
X`09`20`20`20`20last_char`20:=`20Substr`20(khf$kt_left_delims,`20n,`201);
X`09`20`20`20`20direction`20:=`20REVERSE;
X`09Else
X!+
X!`20`20Current_Character`20was`20not`20a`20delimitor.`20`20If`20highlighting
V`20is`20on,`20turn`20it
X!`20`20off,`20else`20issue`20an`20error`20message.
X!-
X`09`20`20`20`20If`20khf$x_match1_position`20=`200`20Then
X`09`09Eve$message`20("The`20current`20character,`20"`20+`20first_char`20+
X`09`09`09`20",`20is`20not`20a`20valid`20delimitor`20to`20match.");
X`09`20`20`20`20Endif;
X`09`20`20`20`20khf$x_match1_position:=`200;
X`09`20`20`20`20khf$x_match2_position:=`200;
X`09`20`20`20`20khf$x_match3_position:=`200;
X`09`20`20`20`20khf$x_match4_position:=`200;
X`09`20`20`20`20Return`20(FALSE);
X`09Endif;
X`20`20`20`20Endif;
X
X`20`20`20`20khf$x_match1_position:=`20Mark`20(BOLD);
X`20`20`20`20khf$x_match2_position:=`20Mark`20(REVERSE);
X
X`20`20`20`20If`20Khf_Find_Match`20(first_char,`20last_char,`20direction)`20=
V`201`20Then
X`09khf$x_match3_position:=`20Mark`20(BOLD);
X`09khf$x_match4_position:=`20Mark`20(REVERSE);
X`09Update`20(CURRENT_WINDOW);
X`09Position`20(khf$x_match1_position);
X`09Return`20(TRUE);
X`20`20`20`20Else
X`09Position`20(khf$x_match1_position);
X`09khf$x_match1_position:=`200;
X`09khf$x_match2_position:=`200;
X`09khf$x_match3_position:=`200;
X`09khf$x_match4_position:=`200;
X`09Eve$message`20("`20Could`20not`20find`20the`20matching`20"`20+`20last_char
V`20+
X`09`09`20"`20character`20for`20the`20current`20character,`20"`20+`20first_char
V);
X`09Return`20(FALSE);
X`20`20`20`20Endif;
X
X
XEndProcedure;`09`09!`20Eve_Match_Delimitors
X
X
X!++
X!`20`20`20The`20following`20procedure`20does`20the`20actually`20search`20for
V`20the`20matching
X!`20`20`20delimitor`20character.`20`20A`20recursive`20algorithm`20is`20used
V`20so`20that`20intervening
X!`20`20`20pairs`20of`20matched`20delimitors`20are`20not`20mistakenly`20selecte
Vd`20as`20the`20match.
X!
X!`20Input`20Parameters:
X!
X!`09first`09`20`20`20`20the`20delimitor`20character`20whose`20mate`20is`20bein
Vg`20sought
X!
X!`09last`09`20`20`20`20the`20matching`20delimitor`20character
X!
X!`09direction`20`20`20the`20direction`20to`20search.`20`20If`20first_char`20is
V`20a`20right-
X!`09`09`20`20`20`20delimitor,`20the`20search`20direction`20is`20FORWARD,
X!`09`09`20`20`20`20otherwise`20it`20is`20REVERSE.
X!
X!`20Author/Date:`09`09K.H.`20Fairfield,`09`0916-Jan-1988
X!-
X
XProcedure`20Khf_Find_Match`20(first,`20last,`20direction)
X!`09`20`20--------------
XLocal`20this_patt,`20this_range;
X
X`20`20`20`20this_patt`20:=`20first`20+`20last;
X`20`20`20`20Loop
X`09If`20direction`20=`20FORWARD`20Then
X`09`20`20`20`20Move_Horizontal`20(1);
X`09Else
X`09`20`20`20`20Move_Horizontal`20(-1);
X`09Endif;
X`09this_range`20:=`20Search_Quietly`20(Any`20(this_patt),`20direction);
X`09If`20this_range`20<>`200
X`09Then
X`09`20`20`20`20Position`20(this_range);
X`09Else
X`09`20`20`20`20Return`20(0);
X`09Endif;
X`09If`20CURRENT_CHARACTER`20=`20last`20Then
X`09`20`20`20`20Return`20(1);
X`09Else
X`09`20`20`20`20If`20Khf_Find_Match`20(first,`20last,`20direction)`20=`200`20Th
Ven
X`09`09Return`20(0);
X`09`20`20`20`20Endif;
X`09Endif;
X`20`20`20`20Endloop;
X
XEndprocedure;`09`09!`20Khf_Find_Match
X
$ call unpack MATCHDELIM.TPU;2 1952715885 ""
$ v=f$verify(v)
$ exit