From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 16-OCT-1989 19:24
To:	MRGATE::"ARISIA::EVERHART"
Subj:	LIBSEARCH SEARCH for VMS libraries 1/7

Message-Id:  <8910161850.AA00558@crdgw1.ge.com>
Received: From NSFNET-RELAY.AC.UK by CRVAX.SRI.COM with TCP; Mon, 16 OCT 89 11:29:39 PDT
Received: from ncdlab.ulcc.ac.uk by NSFnet-Relay.AC.UK   via Janet with NIFTP
           id aa10591; 16 Oct 89 17:14 BST
Date:           Mon, 16 Oct 89  17:22 BST
From: "Kevin Ashley - ULCC Networks Development." <KEVIN%ncdlab.ulcc.ac.uk@NSFnet-Relay.AC.UK>
To: INFO-VAX <@NSFnet-Relay.AC.UK:INFO-VAX@crvax.sri.com>
Subject:        LIBSEARCH SEARCH for VMS libraries 1/7

$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.1-004  3-AUG-1989
$!   On 16-OCT-1989 17:07:56.28   By user KEVIN (Kevin Ashley, ULCC)
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 7 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! 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. AAAREADME.TXT;6
$!       2. LIBSEARCH.FOR;36
$!       3. OUTPUT.FOR;26
$!       4. PRSCOM.FOR;32
$!       5. PRSFIL.FOR;51
$!       6. PRSTARGET.FOR;13
$!       7. SEARCH_MODULE.FOR;78
$!       8. STATS.FOR;34
$!       9. WINDOW.FOR;19
$!      10. FIND_FIRST.MAR;9
$!      11. FILCOM.INC;14
$!      12. FORMAT.INC;1
$!      13. QUALCOM.INC;17
$!      14. STATCOM.INC;6
$!      15. TOPICS.INC;4
$!      16. TRGCOM.INC;4
$!      17. WINDOW.INC;5
$!      18. BUILD.COM;1
$!      19. LINK.COM;10
$!      20. COMPILE.COM;9
$!      21. LIBSEARCH.HLP;21
$!      22. TEST.HLP;3
$!      23. LIBSEARCHMSG.MSG;9
$!      24. LIBSEARCH.CLD;27
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ if f$getsyi("version") .ges. "V4.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
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete/nolog '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/nolog 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");
buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff))
;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);x:=
ERASE_CHARACTER(1);IF g = 0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x=
"V" THEN APPEND_LINE;MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;
IF x="+" THEN g:=1;ERASE_LINE;ENDIF;ELSE IF x="-" THEN g:=0;ENDIF;ERASE_LINE;
ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD);
EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));
ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o);
ENDPROCEDURE;Unpacker;EXIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create/nolog 'f'
XLIBSEARCH is a program which does just about everything the SEARCH command
Xdoes, but for libraries. LIBSEARCH has a number of uses particular to its
Xabilities to search libraries, such as:
X
XFinding which HELP subject contains info on the keyword you want;
XFinding which macro defines the symbol you want;
XFinding which Include module from FORSYSDEF.TLB contains the definitions you
Xwant;
XPoking around in general.
X
XTo build LIBSEARCH, after unpacking the files into their own directory:
X
X$ @BUILD
X
XThen copy LIBSEARCH.EXE to where you keep these things, and modify LIBSEARCH
V.CLD
Xappropriately.`032
X
XYou can invoke LIBSEARCH two ways - via a foreign symbol, or as a defined DC
VL
Xcommand. If you use the foreign symbol approach, LIBSEARCH cannot prompt
Xfor missing parameters. To use as a foreign command, type
X
X$ LIBSEARCH :== $device:`091dir`093LIBSEARCH.EXE
X
Xwhere device:`091dir`093 is where you put LIBSEARCH.EXE.
X
XTo use as a defined DCL command:
X
XEither make LIBSEARCH.CLD available to all, so that they can type
X
XSET COMMAND dev:`091dir`093LIBSEARCH.CLD
X
Xor modify your system dcl tables :
X
XSET COMMAND/TAB=SYS$SHARE:DCLTABLES/OUT=SYS$COMMON:`091SYSLIB`093DCLTABLES l
Vibsearch
XINSTALL REPLACE SYS$SHARE:DCLTABLES
X
XModify the help if necessary, and add to your help library.
X
XAll done!
X
XPlease report bugs, etc. to K.Ashley@Uk.Ac.Ulcc.Ncdlab (Janet).
X                            K.Ashley@Ncdlab.Ulcc.Ac.Uk (Most of rest of worl
Vd)
X`009`009`009    K.Ashley%uk.ac.ulcc.ncdlab@nsfnet-relay.ac.uk (Arpa)
X`009`009`009    K.Ashley%uk.ac.ulcc.ncdlab@UKACRL (Bitnet/EARN)
X
$ CALL UNPACK AAAREADME.TXT;6 58347744
$ create/nolog 'f'
X`009Program Libsearch
X`009Implicit None
X`009Character*160 File
X`009Integer Fillen,TLen
X`009Integer LibIdx
X`009Logical HELP
X`009Logical Open_lib
X*
X*`009Search a library for specified strings
X*`009PRSCOM parses global qualifiers for the command, and
X*`009sets up info in common block /QUALCOM/
X*`009PRSTARGET gets the target strings, and initializes the
X*`009strings pointed to by /TRGCOM/
X*`009PRSFIL parses the input file names, and any /MODULE qualifiers,
X*`009and returns one filename and module stuff on each call.
X*
X`009Call Prscom
X`009Call PrsTarget
X
X`009Call PrsFil(File,Fillen)
X
X`009Do While (Fillen .ne. 0)
X
X`009`009If(Open_lib(File(1:Fillen),Libidx,Help)) Then
X`009`009  Call Search_lib(Libidx,Help)
X`009`009Endif
X`009`009Call PrsFil(File,Fillen)
X
X  `009Enddo
X
X`009Call Stat_Rep
X`009Call Exit(1)
X
X`009End
X
X`009Subroutine Search_lib(Libidx,Help)
X*
X*`009Search library for specified text.
X*`009We call Lbr$get_index to process all modules. A subset could
X*`009be processed by specifying a match string to Get_index.
X*`009It calls one of our routines for each module, which then looks
X*`009for the text.
X*
X`009Implicit None
X`009Integer Libidx
X`009Logical HELP
X
X`009Integer Status,Lbr$Get_index,Lbr$Close,Lbr$Set_Move
X`009External Search_Module
X`009Include '($LBRDEF)'
X`009Include 'FILCOM.INC'
X`009Include 'STATCOM.INC'
X`009External LBR$_NOMTCHFOU,LBR$_NULIDX
X*-------------------------------------------------------------
X
X*`009Store library handle for co-routine
X
X`009FilIdx = Libidx
X`009Helplib = Help`009`009`009!Remember library type
X*
X*`009Set move mode, and use dynamic strings for the records.
X*
X`009Status = Lbr$Set_Move(Libidx)
X`009Call Stchek(Status)
X*
X*`009Now ask the librarian to call Search_module for each module that
X*`009matches the wildcard spec in Cmodqual
X*
X`009Status = Lbr$Get_index(Libidx,1,Search_Module,
X     $        Cmodqual(1:Cmodqlen))
X`009If(Status .Ne. %Loc(LBR$_NOMTCHFOU) .and.
X     $     Status .ne. %loc(LBR$_NULIDX))  Call Stchek(Status)
X*
X*`009Accumulate file statistics, and possibly do some logging
X*
X`009Call File_end(Status)
X
X`009Status = Lbr$Close(Libidx)
X`009Call Stchek(Status)
X
X`009Return
X`009End
X
X`009Logical Function Open_lib(Filename,Libidx,Help)
X*
X*`009Open the named library for read access
X*`009Check it is text,help or macro
X*`009Return a flag if it is a help library, for special processing.
X*
X`009Implicit None
X`009Character*(*) Filename
X`009Integer Libidx
X`009Logical Help
X`009Integer Stv,Lbr$Ret_Rmsstv
X`009Include '($LBRDEF)'
X`009Include '($LHIDEF)'
X
X`009Integer Status,LBR$Ini_Control,Lbr$Open,Lbr$Get_header
X`009Record /LHIDEF/ Libhdr
X`009Integer Type
X`009External LIBSEARCH_NOTTXTMAC,LIBSEARCH_OPENIN
X
X*-------------------------------------------------------------
X
X*`009  Init control structures
X
X`009Open_lib = .False.
X
X`009Status = Lbr$Ini_Control(Libidx,Lbr$C_Read)
X`009Call Stchek(status)
X
X*`009   Open the library for read access
X
X`009Status = Lbr$Open(Libidx,Filename)
X*
X*`009If error, signal warning and continue
X*
X`009If(.not. Status) Then
X`009`009Stv = Lbr$Ret_Rmsstv()
X`009`009Call Lib$Signal(LIBSEARCH_OPENIN,%val(1),Filename,
X     $                    %val(Status),%Val(Stv))
X`009`009Return
X`009Endif
X
X*`009   Read the header block to find out what type it is
X
X`009Open_lib = .True.
X
X`009Status = Lbr$Get_Header(Libidx,Libhdr)
X`009Call Stchek(status)
X
X`009Type = Libhdr.LHI$L_Type
X
X`009If(Type .ne. Lbr$C_Typ_MLB .and.
X     $     Type .ne. Lbr$C_Typ_HLP .and.
X     $     Type .ne. Lbr$C_Typ_TXT) Then
X`009`009Call Lib$Signal(LIBSEARCH_NOTTXTMAC)
X`009Endif
X
X`009Help = Type .eq. Lbr$C_Typ_HLP
X*
X*`009Type seems OK.
X*
X`009Return
X`009End
X
X`009Subroutine StChek(Status)
X`009Implicit None
X`009Integer Status
X
X`009If(.Not. Status) Call Lib$Signal(%val(Status))
X`009Return
X`009End
$ CALL UNPACK LIBSEARCH.FOR;36 2135968931
$ create/nolog 'f'
X*
X*`009This file contains all routines concerned with outputting
X*`009lines found in the input files to the output file.
X*`009There are three formatting stages:
X*`009(1) Transform the record according to the /FORMAT spec.
X*`009(2) Transform the result according to /HIGHLIGHT.
X*`009(3) Output the line, with line numbers according to /NUMBER
X*
X*`009These are handled by Type_Rec,Hilite_Rec and Output_Rec
X*
X`009Subroutine Type_Rec(Record,Linnum)
X`009Implicit None
X`009Character*(*) Record
X`009Integer Linnum
X*
X*`009This routine is given a line to output, and a line number if necessary.
X*`009It formats the output line if necessary, and then passes it to the
X*`009next output routine.
X*`009If the formatted version of the record is very long, it may break
X*`009it up into multiple subrecords.
X*
X`009Include 'QUALCOM.INC'
X`009Include 'FORMAT.INC'
X
X`009Character*(mxolen) Outrec
X`009Character*1 C
X`009Integer L0,L1,L2,I
X`009Integer HT,CR,FF
X`009Parameter (HT = 9)
X`009Parameter (CR = 13)
X`009Parameter (FF = 12)
X`009Logical Rec_Truncated
X
X`009If(Format .eq. FmtAll) Then`009`009!Simple - just output record
X
X`009  Call Hilite_Rec(Record,Linnum,.False.)
X
X`009Else
X*
X*`009Must pre-format record
X*
X`009  L1 = Len(Record)
X`009  L0 = 1
X`009  Rec_Truncated = .True.
X*
X*`009Return here for record segments
X*
X50`009  L2 = 0
X`009  Do I = L0,L1
X`009   C = Record(I:I)
X*
X*`009  /FORMAT=NULL means ignore nulls
X*
X`009   If(Format .eq. FmtNul .and. IChar(C) .eq. 0) Then
X`009    Continue
X*
X*`009/FORMAT=TEXT means pass HT,CR,FF,VT,LF unchanged
X*`009/FORMAT=NOFF is the same, apart from FF, which is replaced by <FF>
X*
X`009   Else If(Ichar(C) .ge. HT .and. Ichar(C) .le. CR .and.
X     $             ((Format .eq. Fmttxt) .or.`032
X     $              (Format .eq. Fmtnoff .and. Ichar(C) .ne. FF))) Then
X`009    L2 = L2 + 1
X`009    If(L2 .gt. Len(Outrec))  Goto 100
X`009    Outrec(L2:L2) = C
X`009   Else
X*
X*`009Otherwise look up character in translation table for formatted version
X*`009(/FORMAT=DUMP)
X*
X`009    If(L2 + Lform(Ichar(C)) .gt. Len(Outrec)) Goto 100
X`009    Outrec(L2+1:L2+Lform(IChar(C))) = Cform(Ichar(C))
X`009    L2 = L2 + LForm(IChar(C))
X`009   Endif
X`009  Enddo
X
X`009  Rec_Truncated = .False.
X
X100`009  Call Hilite_Rec(Outrec(1:L2),Linnum,Rec_Truncated)
X
X`009  If(Rec_Truncated) Then
X`009`009L0 = I
X`009`009Goto 50
X`009  Endif
X
X`009Endif
X
X`009Return
X`009End
X
X`009Subroutine Hilite_Rec(Record,Linnum,Trunc_Flag)
X`009Implicit None
X`009Integer Linnum
X`009Logical Trunc_Flag
X`009Character*(*) Record
X*
X*`009This is given a line in which non-printables have been removed if
X*`009necessary. It applies any highlighting rules necessary, and
X*`009then passes the result to the real highlight routine.
X*`009This method suffers from the same bug as SEARCH, in that if, after
X*`009pre-formatting, the string contains one of the targets (such as CAN)
X*`009it is incorrectly highlighted.
X*
X`009Include 'QUALCOM.INC'
X`009Integer*2 Hpos(Mxolen)
X`009Integer Nchanges
X`009Character*(Mxolen) Nrec,Spaces,Unders
X`009Character*2 Hion(4),Hioff
X`009Character*1 CSI,Cr
X`009Parameter (CSI = Char(155), Cr= Char(13))
X`009Data Hion /'1m','5m','7m','4m'/
X`009Data Hioff /'0m'/
X`009Data Spaces,Unders/' ',' '/
X`009Integer Rp,I,Op,Hend
X`009Integer Tstr(2)
X
X`009If(Hilite .eq. Hilite_None) Then
X`009   Call Output_Rec(Record,Linnum,Trunc_Flag) !Simple - no highlighting
X
X`009Else
X*
X*`009 Need to do highlighting of some sort. Allocate dynamic strings
X*`009if non-exact matching used.
X*
X`009  If(.Not. Exact) Then
X`009`009If(Tstr(1) .eq. 0) Call Dynini(Tstr)
X`009`009Call Str$Upcase(Tstr,Record)
X`009  Else
X`009`009Tstr(1) = Len(Record)
X`009`009Tstr(2) = %Loc(Record)
X`009  Endif
X
X`009  Call Hilite_Position(Tstr,Hpos,Nchanges,Nrec)
X
X`009  If(Nchanges .eq. 0) Then
X`009`009  Call Output_Rec(Record,Linnum,Trunc_flag)
X`009  Else If(Hilite .le. Hilite_Under) Then`009!Escape seq highlighting
X
X`009`009  Rp = 1
X`009`009  Op = 0
X
X`009`009  Do I = 2,Nchanges*2,2
X`009`009    If(Hpos(I-1) .gt. Rp)
X     $               Call Output_Add(Record(Rp:Hpos(I-1)-1),
X     $                                Nrec,Op,Linnum)
X`009`009    Rp = Hpos(I-1)
X       `009`009    Hend = Min(Hpos(I)-1,Len(Record))
X       `009`009    Call Output_Add(
X     $                   CSI//Hion(Hilite)//Record(Rp:Hend)//Csi//Hioff,
X     $                                           Nrec,Op,Linnum)
X`009`009    Rp = Hpos(I)`032
X`009`009  Enddo
X`009`009  If(Rp .le. Len(Record))
X     $                  Call Output_Add(Record(Rp:),Nrec,Op,Linnum)
X`009`009  If(Op .ne. 0)
X     $                  Call Output_Rec(Nrec(1:op),Linnum,Trunc_flag)
X`009 Else`009`009!Hardcopy highlighting
X
X`009`009Rp = 1
X`009`009Op = 0
X`009`009Call Output_Add(Record,Nrec,Op,Linnum)
X`009`009Call Output_Add(CR,Nrec,Op,Linnum)
X
X`009`009Do I = 2,Nchanges*2,2
X`009`009    If(Hpos(I-1) .gt. Rp)
X     $               Call Output_Add(Spaces(:Hpos(I-1)-Rp),
X     $                                Nrec,Op,Linnum)
X`009`009    Rp = Hpos(I-1)
X       `009`009    Hend = Min(Hpos(I)-1,Len(Record))
X`009`009    If(Hilite .eq. Hilite_Hunder) Then
X`009`009      If(Unders(1:1) .eq. ' ') Then
X`009`009`009Call Str$Dupl_Char(Unders,Mxolen,IChar('_'))
X`009`009      Endif
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-

