From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 20-APR-1989 11:28
To:	MRGATE::"ARISIA::EVERHART"
Subj:		LIBSEARCH part 1 of 2

Message-Id:  <8904201356.AA17572@crdgw1.ge.com>
Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu, 20 APR 89 05:58:08 PDT
Received: from NSS.Cs.Ucl.AC.UK by KL.SRI.COM with TCP; Thu, 20 Apr 89 05:39:59 PDT
Received: from ncdlab.ulcc.ac.uk by NSS.Cs.Ucl.AC.UK   via Janet with NIFTP
           id aa07222; 20 Apr 89 13:31 BST
Date: 		20-APR-1989 13:32:15 GMT
From: KEVIN%ncdlab.ulcc.ac.uk@NSS.Cs.Ucl.AC.UK
To: info-vax <@NSS.Cs.Ucl.AC.UK:info-vax@kl.sri.com>
Subject: 	LIBSEARCH part 1 of 2
Sender: "Kevin Ashley, ULCC Networks + Comms." <KEVIN%ncdlab.ulcc.ac.uk@NSS.Cs.Ucl.AC.UK>
Postal-Address: 	ULCC, 20 Guilford St, LONDON WC1N 1DZ, UK
Telephone: 	[+44] (1)-405-8400

...................... Cut between dotted lines and save ......................
$!.............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-5.04-WJM-AGH 29-SEP-1988
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! and modified by W.J.Moeller <moeller@dgogwdg5.BITNET>
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by KEVIN (Kevin Ashley, ULCC)
$! on Thursday 20-APR-1989 13:23:31.47
$!
$! ATTENTION: To keep each article below 33280 bytes, this program
$! has been transmitted in 2 parts.
$! You should concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 20 files:
$! AAAREADME.TXT LIBSEARCH.FOR PRSCOM.FOR PRSFIL.FOR PRSTARGET.FOR
$! SEARCH_MODULE.FOR STATS.FOR WINDOW.FOR LIBSEARCH.HLP FILCOM.INC FORMAT.INC
$! QUALCOM.INC STATCOM.INC TOPICS.INC TRGCOM.INC WINDOW.INC LIBSEARCHMSG.MSG
$! COMPILE.COM LINK.COM LIBSEARCH.CLD
$!=============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
                ", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
        VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));a:=0;Loop ExitIf Mark(None)=End_of(b);
x:=Erase_Character(1);if x="V" then i:=LENGTH(CURRENT_LINE);
if i<>78 then MOVE_HORIZONTAL(i);if i>78 then ERASE_CHARACTER(78-i);endif;
if i<78 then COPY_TEXT(FAO("!#* ",78-i));endif;
Move_Horizontal(-Current_Offset);endif;endif;if a then Append_Line;
Move_Horizontal(-Current_Offset);endif;a:=(x="V");Move_Vertical(1);EndLoop;
POSITION(BEGINNING_OF(b));p:=" "&LINE_END;loop x:=SEARCH(p,Forward,Exact);
exitif x=0;POSITION(END_OF(x));s:=CURRENT_LINE;EDIT(s,Trim_trailing,Off);
ERASE_CHARACTER(LENGTH(s)-CURRENT_OFFSET);endloop;Position(Beginning_of(b));
Loop x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="AAAREADME.TXT"
$ Check_Sum_is=1548768482
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
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:
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@COMPILE
X@LINK
VThen copy LIBSEARCH.EXE to where you keep these things, and modify LIBSEARCH.C
XLD
Xappropriately. Either make LIBSEARCH.CLD available to all, to use SET COMMAND,
Xor modify your dcl tables :
XSET COMMAND/TAB=SYS$SHARE:DCLTABLES/OUT=SYS$SHARE:DCLTABLES libsearch
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 world)
X
$ GoSub Convert_File
$ File_is="LIBSEARCH.FOR"
$ Check_Sum_is=695214922
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
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
X1`009Call PrsFil(File,Fillen)
X`009If(Fillen .ne. 0) Then
X`009`009If(Open_lib(File(1:Fillen),Libidx,Help)) Then
X`009`009  Call Search_lib(Libidx,Help)
X`009`009Endif
X`009`009Goto 1
X`009Else
X`009`009Call Stat_Rep
X`009`009Call Exit(1)
X`009Endif
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`009Rec_Truncated = .False.`009`009!No truncate initially
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,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
$ GoSub Convert_File
$ File_is="PRSCOM.FOR"
$ Check_Sum_is=2050658183
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X`009Subroutine PRSCOM
X*
X*`009Parse global qualifiers for the Search command, setting
X*`009values in common blocks.
X*
X`009Implicit None
X`009Integer Status,Cli$Get_Value,Cli$Present,Lib$Get_Lun
X*`009External CLI$_NEGATED,CLI$_LOCNEG
X`009Character*128 Temp
X`009Integer Tlen
X
X`009Include 'QUALCOM.INC'
X`009Include 'WINDOW.INC'       !To get value of MAXWIN
X
X`009External LIBSEARCH_WINPARONE,LIBSEARCH_WINPARBAD
X`009External LIBSEARCH_INVNUMFMT`009`009!Message codes
X*
X*`009Handle simple yes/no qualifiers first.
X*
X`009Remaining = .False.
X`009If(Cli$Present('REMAINING')) Remaining = .True.
X
X`009Exact = .False.
X`009If(Cli$Present('EXACT')) Exact = .True.
X
X`009Statistics = .False.
X`009If(Cli$Present('STATISTICS')) Statistics = .True.
X
X`009Heading = .False.
X`009If(Cli$Present('HEADING')) Heading = .True.
X
X`009Numbers = .False.
X`009If(Cli$Present('NUMBERS')) Numbers = .True.
X
X`009Log = .False.
X`009If(Cli$Present('LOG')) Log = .True.
X
X`009Subtopic = .False.
X`009If(Cli$Present('SUBTOPICS')) Subtopic = .True.
X*
X*`009Now the ones that take values - enumerated ones first.
X*
X`009Match = Match_Or
X`009If(Cli$Present('MATCH')) Then
X`009`009Status = Cli$Get_Value('MATCH',Temp,Tlen)
X`009`009Call Stchek(Status)
X`009`009Match = (Index(MatchNams,Temp(1:Tlen)) - 1)/4
X`009Endif
X
X`009Format = FmtTxt
X
X`009If(Cli$Present('FORMAT')) Then
X`009`009Status = Cli$Get_Value('FORMAT',Temp,Tlen)
X`009`009Call Stchek(Status)
X`009`009Format = Index('TPDN',Temp(1:1)) - 1
X`009Endif
X*
X*`009Window - if not present, no lines before or after, but target line
X*`009itself. If present, but no value, then /WINDOW=5 is assumed.
X*`009If present with two values, set before and after to values. If one
X*`009value, then subtract one, round up to multiple of two, and set before
X*`009and after.
X*`009Window=0 implies no windows at all - just file lines. To indicate this,
X*`009we set WINDOW false.
X*
X`009Window = .True.
X`009WinBefore = 0
X`009WinAfter = 0
X`009If(Cli$Present('WINDOW')) Then
X`009`009WinBefore = 2
X`009`009WinAfter = 2
X
X`009`009If(Cli$Get_Value('WINDOW',Temp,Tlen)) Then
X`009`009  Read(Temp(1:Tlen),'(I<Tlen>)',Err=900) WinBefore
X
X`009`009  If(Cli$Get_Value('WINDOW',Temp,Tlen)) Then
X`009`009    Read(Temp(1:Tlen),'(I<Tlen>)',Err=900) WinAfter
X
X`009`009    If(Winbefore .gt. Maxwin - 1) Then
X`009`009`009Call Lib$Signal(LIBSEARCH_WINPARONE,
X     $                     %val(1),%val(Maxwin-1))
X`009`009    Endif
X
X`009`009  Else
X*
X*`009Split /WINDOW=n between before and after
X*`009Check for special case of Window=0
X*
X`009`009  If(Winbefore .gt. (Maxwin-1)*2+1) Then
X`009`009`009Call Lib$Signal(LIBSEARCH_WINPARBAD,
X     $                     %val(1),%val(Maxwin*2))
X`009`009   Endif
X
X`009`009   If(Winbefore .eq. 0) Then
X`009`009     Window = .False.
X`009`009     Winbefore = 0
X`009`009     Winafter = 0
X`009`009     Remaining = .False.    !this is what SEARCH does....
X`009`009   Else
X`009`009     Winbefore = Winbefore - 1
X`009`009     WinBefore = WinBefore + Mod(WinBefore,2)
X`009`009     WinBefore = WinBefore/2
X`009`009     WinAfter = WinBefore
X`009`009   Endif`009!/WINDOW=0 specified
X`009`009  Endif`009`009!2 VALUES FOR Window
X`009`009Endif`009`009! Any values present
X`009Endif`009`009`009!/Window present
X
X*   qualifier EXCLUDE
X*      nonnegatable
X*      value (required,list)
X*
X*`009OUTPUT qualifier - get output and open it now.
X*
X`009Call Cli$Get_Value('OUTPUT',Temp,Tlen)
X`009Status = Lib$Get_Lun(Outlun)
X`009Call StChek(Status)
X`009Open(Unit=Outlun,Status='New',Name=Temp(1:Tlen),
X     $      CarriageControl='LIST',Recl=Lbr$C_Maxrecsiz)
X
X`009If(Statistics) Call Stat_ini
X`009Call Win_ini(Winbefore,Winafter,Window)   !Init window buffers
X`009Return
X*
X*`009Errors with numbers come here.
X*
X900`009Call Lib$Signal(LIBSEARCH_INVNUMFMT,%val(1),Temp(1:Tlen))
X`009End
$ GoSub Convert_File
$ File_is="PRSFIL.FOR"
$ Check_Sum_is=823005532
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X`009Subroutine Prsfil(File,Flen)
X*
X*`009This routine is called once to retrieve each file name
X*`009we work with.
X*`009On the first call, it does all the command parsing, filling
X*`009up an array with names. Repeated calls to Lib$Find_File
X*`009are then used to parse the names, one of which is returned
X*`009on each call.
X*`009  We have to do all the parsing at once so we can pick up local
X*`009  qualifiers for the names.
X*
X`009Implicit None
X`009Character*(*) File
X`009Integer Flen
X`009Integer Status,Cli$Get_Value,Cli$Present,Status1,Stv
X`009External Cli$_Absent,Cli$_Present,Cli$_LocPres
X`009Include '($LBRDEF)'
X`009Include 'FILCOM.INC'
X`009Include 'QUALCOM.INC'
X`009Character*160 Temp
X`009Integer Tlen
X`009Integer I
X`009Logical First,GlobalMod
X`009Save First
X`009Data First /.True./
X
X`009External Rms$_NMF
X`009Integer Lib$Find_File,Context
X`009External LIBSEARCH_TOOMNYFIL,LIBSEARCH_OPENIN
X
X`009If(First) Then
X`009 Nfiles = 0
X`009 Status1 = 1
X`009 GlobalMod = .False.
X`009 Cfile = 1
X`009 First = .False.
X`009 Context = 0
X*
X*`009Initialize module type tables and exclusion tables
X*
X`009 Do I = 1,Maxfiles
X`009   Deftyps(I) = ' '
X`009   Excluded(I) = ' '
X`009   Lexcl(I) = 0
X`009 Enddo
X
X`009 Call PrsLibTyp(.True.,Deftyps(1))`009`009!Initialize type tables
X
X`009  Do I = 2,Maxfiles
X`009   Deftyps(I) = Deftyps(1)
X`009  Enddo
X*
X*`009Look for global /EXCLUDE
X*
X`009 Call Prsexcl(.True.,Excluded(1),Lexcl(1))
X
X`009 Do I = 2,Maxfiles
X`009  Excluded(I) = Excluded(1)
X`009  Lexcl(I) = Lexcl(1)
X`009 Enddo
X
X*
X*`009Look for global /MEXCLUDE
X*
X`009 Call Prsmexcl(.True.,Modexcl(1),LModexcl(1))
X
X`009 Do I = 2,Maxfiles
X`009  Modexcl(I) = Modexcl(1)
X`009  Lmodexcl(I) = Lmodexcl(1)
X`009 Enddo
X
X`009 Do While(Status1)
X`009   Status1 = Cli$Get_Value('SOURCE',Temp,Tlen)
X`009   If(Status1 .eq. %Loc(Cli$_Absent)) Goto 20
X`009   Call StChek(Status1)
X
X`009   If(Nfiles .lt. Maxfiles) Then
X`009     Nfiles = Nfiles + 1
X`009     Filnams(Nfiles) = Temp(1:Tlen)
X`009     Fnamlen(Nfiles) = Tlen
X*
X*`009Look for /MODULE qualifier, globally or locally
X*
X`009     Status = Cli$Present('MODULES')
X`009     If(Status.eq.%Loc(Cli$_Present) .and..Not.GlobalMod) Then
X*
X*`009Globally present - fill up all entries
X*
X`009`009GlobalMod = .True.
X`009`009Status = Cli$Get_Value('MODULES',Temp,Tlen)
X`009`009Call Stchek(Status)
X`009`009Do I = 1,Maxfiles
X`009`009  Modquals(I) = Temp(1:Tlen)
X`009`009  Modqlen(I) = Tlen
X`009`009Enddo
X`009     Else If(Status .eq. %Loc(Cli$_LocPres)) Then
X*
X*`009Locally present - set it for this module
X*
X`009`009Status = Cli$Get_Value('MODULES',Temp,Tlen)
X`009`009Call Stchek(Status)
X`009`009Modquals(Nfiles) = Temp(1:Tlen)
X`009`009Modqlen(Nfiles) = Tlen
X`009     Else If(.Not.GlobalMod) Then
X`009`009Modquals(Nfiles) = '*'
X`009`009Modqlen(Nfiles) = 1
X`009     Endif`009`009`009!test for /MODULE
X*
X*`009Look for /HELP,/TEXT,/MACRO
X*
X`009     Call PrslibTyp(.False.,Temp)
X`009     If(Temp(1:3) .ne. ' ') Deftyps(Nfiles) = Temp(1:3)
X*
X*`009Look for local /EXCLUDE
X*
X`009     Call PrsExcl(.False.,Temp,Tlen)
X`009     If(Tlen .ne. 0) Then
X`009`009Excluded(Nfiles) = Temp(1:Tlen)
X`009`009Lexcl(Nfiles) = Tlen
X`009     Endif
X
X*
X*`009Look for local /MEXCLUDE
X*
X`009     Call PrsMExcl(.False.,Temp,Tlen)
X`009     If(Tlen .ne. 0) Then
X`009`009Modexcl(Nfiles) = Temp(1:Tlen)
X`009`009LModexcl(Nfiles) = Tlen
X`009     Endif
X
X`009   Else
X`009    Call Lib$Signal(LIBSEARCH_TOOMNYFIL,%val(1),%Val(Maxfiles))
X`009   Endif
X
X`009  Enddo
X*
X*`009Now we have all the names, start parsing the first one.
X*
X`009Endif
X
X*
X*`009Get next matching name
X*
X20`009Tlen = Fnamlen(Cfile)
X`009Status = Lib$Find_File(Filnams(Cfile)(1:Tlen),
X     $                         Current_File,Context,
X     $                         '.'//Deftyps(Cfile),,Stv,2)
X`009If(Status) Then
X`009`009Cfilnaml = Index(Current_File,' ') - 1
X`009`009File = Current_File
X`009`009Flen = Cfilnaml
X`009`009Cmodqual = Modquals(Cfile)
X`009`009Cmodqlen = Modqlen(Cfile)
X`009`009Return
X*
X*`009If file not found, see if we have any more file specs
X*
X`009Else If(Status .eq. %Loc(Rms$_NMF)) Then
X`009`009Cfile = Cfile + 1
X`009`009If(Cfile .le. Nfiles) Goto 20
X*
X*`009No, so say there is nothing left.
X*
X`009`009Flen = 0
X`009`009File = ' '
X`009`009Return
X`009Else
X*
X*`009If here, there is some problem parsing the filespec
X*`009Signal a warning, and move to the next
X*
X`009`009Call Lib$Signal(LIBSEARCH_OPENIN,%Val(1),
X     $                             Filnams(Cfile)(1:Tlen),
X     $                             %Val(Status),%Val(Stv))
X`009`009Goto 20
X`009Endif
X`009End
X
X`009Subroutine PrsLibTyp(GlobalType,Typstr)
X*
X*`009Check for qualifiers of the /Macro type, return a text string.
X*`009Globaltype is true if we are looking for global qualifiers
X*
X`009Implicit None
X
X`009Integer Status,Cli$Present,Status1
X`009External Cli$_Absent,Cli$_Present,Cli$_LocPres
X`009Integer I,Type
X`009Logical Globaltype
X`009Character*3 Typstr,Types(3)
X`009Data Types/'MLB','HLB','TLB'/
X*
X*`009Look for /HELP,/TEXT,/MACRO
X*
X`009Type = 0
X`009Typstr = ' '
X
X`009If(Globaltype) Then
X`009`009Status1 = %Loc(Cli$_Present)
X`009`009Type = 2`009`009!Default /HELP globally
X`009Else
X`009`009Status1 = %Loc(Cli$_LocPres)
X`009Endif
X
X`009Status = Cli$Present('MACRO')
X`009If(Status.eq.Status1) Then
X`009`009Type = 1
X`009Else
X`009 Status = Cli$Present('HELP')
X`009 If(Status.eq.Status1) Then
X`009`009Type = 2
X`009 Else
X`009   Status = Cli$Present('TEXT')
X`009   If(Status.eq.Status1) Then
X`009`009Type = 3
X`009   Endif
X`009 Endif
X`009Endif
X
X`009If(Type .ne. 0) Typstr = Types(Type)
X`009Return
X`009End
X
X`009Subroutine PrsExcl(GlobalType,Name,Lnam)
X*
X*`009Check for /EXCLUDE files
X*`009Globaltype is true if we are looking for global qualifiers
X*
X`009Implicit None
X
X`009Character*(*) Name
X`009Logical Globaltype
X`009Integer Lnam
X
X`009Integer Status,Cli$Present,Status1,Cli$Get_Value
X`009External Cli$_Absent,Cli$_Present,Cli$_LocPres
X`009Integer I,Type
X
X`009If(Globaltype) Then
X`009`009Status1 = %Loc(Cli$_Present)
X`009Else
X`009`009Status1 = %Loc(Cli$_LocPres)
X`009Endif
X
X`009Status = Cli$Present('EXCLUDE')
X
X`009If(Status.eq.Status1) Then
X`009  Status = Cli$Get_Value('EXCLUDE',Name,Lnam)
X`009  Call Stchek(Status)
X`009Else
X`009  Name = ' '
X`009  Lnam = 0
X`009Endif
X
X`009Return
X`009End
X
X`009Subroutine PrsMExcl(GlobalType,Name,Lnam)
X*
X*`009Check for /MEXCLUDE modules
X*`009Globaltype is true if we are looking for global qualifiers
X*
X`009Implicit None
X
X`009Character*(*) Name
X`009Logical Globaltype
X`009Integer Lnam
X
X`009Integer Status,Cli$Present,Status1,Cli$Get_Value
X`009External Cli$_Absent,Cli$_Present,Cli$_LocPres
X`009Integer I,Type
X
X`009If(Globaltype) Then
X`009`009Status1 = %Loc(Cli$_Present)
X`009Else
X`009`009Status1 = %Loc(Cli$_LocPres)
X`009Endif
X
X`009Status = Cli$Present('MEXCLUDE')
X
X`009If(Status.eq.Status1) Then
X`009  Status = Cli$Get_Value('MEXCLUDE',Name,Lnam)
X`009  Call Stchek(Status)
X`009Else
X`009  Name = ' '
X`009  Lnam = 0
X`009Endif
X
X`009Return
X`009End
$ GoSub Convert_File
$ File_is="PRSTARGET.FOR"
$ Check_Sum_is=1310449325
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X`009Subroutine PrsTarget
X*
X*`009Routine to pick up strings which are search targets.
X*`009We allocate dynamic strings for each one as it is parsed,
X*`009and store the descriptors in a common block array.
X*
X`009Implicit None
X`009Include 'TRGCOM.INC'
X`009Include 'QUALCOM.INC'
X`009Character*128 Temp
X`009Integer Tlen
X`009Integer Status,Cli$Get_Value,Str$get1_Dx,Str$Copy_Dx
X`009External CLI$_Absent
X`009External LIBSEARCH_TOOMNYTRG
X
X`009Ntargets = 0
X`009Status = 1
X
X`009Do While(Status)
X`009  Status = Cli$Get_Value('STRING',Temp,Tlen)
X`009  If(Status .eq. %Loc(Cli$_Absent)) Return
X`009  Call StChek(Status)
X`009  If(Ntargets .lt. Maxtarget) Then
X`009    Ntargets = Ntargets + 1
X`009    Call DynIni(Target(Ntargets))
X*
X*`009Allocate a dynamic string and copy the value into it.
X*
X`009    Status = Str$Get1_Dx(Tlen,Target(Ntargets))
X`009    Call Stchek(Status)
X*
X*`009If we don't want exact matching, uppercase the target.
X*
X`009    If(.Not.Exact) Call Str$Upcase(Temp,Temp(1:Tlen))
X`009    Status = Str$Copy_Dx(Target(Ntargets),Temp(1:Tlen))
X`009    Call Stchek(Status)
X`009  Else
X`009    Call Lib$Signal(LIBSEARCH_TOOMNYTRG,%val(1),%Val(Maxtarget))
X`009  Endif
X
X`009Enddo
X
X`009Call Stchek(Status)
X`009End
X
X`009Subroutine Dynini(Des)
X*
X*`009Initialize a dynamic string descriptor
X*
X`009Implicit None
X`009Include '($dscdef)'
X`009Record /DSCDEF1/ Des
X
X`009Des.DSC$W_MAXSTRLEN = 0
X`009Des.DSC$B_DTYPE = DSC$K_DTYPE_T
X`009Des.DSC$B_CLASS = DSC$K_CLASS_D
X`009Des.DSC$A_POINTER = 0
X
X`009Return
X`009End
$ GoSub Convert_File
$ File_is="SEARCH_MODULE.FOR"
$ Check_Sum_is=875121588
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X`009Integer Function Search_Module(Key,Rfa)
X`009Implicit None
X`009Character*(*) Key
X`009Integer RFA(2),TxtRfa(2)
X*
X*`009We now have the RFA of a particular key. Now we
X*`009call up a search routine once for each record,
X*`009outputting any records we find. We output the module name
X*`009if this is the first time we have found the target in this module.
X*`009We output the filename if this is the first hit in the file.
X*`009These are suppressed if header is false. Asterisks are included if
X*`009WINDOW is true.
X*
X`009Include '($LBRDEF)'
X`009Include 'FILCOM.INC'
X`009Include 'QUALCOM.INC'
X`009Include 'TOPICS.INC'
X`009Include '($STRDEF)'
X
X`009External RMS$_EOF
X`009Integer Status,Lbr$Lookup_Key,Lbr$Find,Getrec,Str$Match_Wild
X`009Logical Search_Rec,Sstat
X`009Structure /DESCRIP/
X`009`009Integer*2 Len
X`009`009Byte Type
X`009`009Byte Class
X`009`009Integer Address
X`009End Structure
X`009Record /DESCRIP/ Rec_Descriptor
X`009Include 'STATCOM.INC'
X`009Character*(*) Hfm1,Hfm2,Hfm3,Hfm4
X`009Parameter (Hfm1 = '(40(''*''))')
X`009Parameter (Hfm2 = '(30(''*''))')
X`009Parameter (Hfm3 = '(15(''*''))')
X`009Parameter (Hfm4 = '(20(''*''))')
X`009Logical Typerest`009`009!True after first hit if /REMAINING
X`009Logical Inwindow`009`009!True while outputting in window
X`009Logical Nsub`009`009`009!True when help subtopic changes
X`009Integer I,Wincnt,Smatch
X
X*
X*`009Check to see if we want to handle this module first.
X*
X`009If(LModexcl(Cfile) .ne. 0) Then
X`009`009Status = Str$Match_Wild(Key,
X     $                       Modexcl(Cfile)(1:Lmodexcl(Cfile)))
X`009`009Search_Module = 1
X`009`009If(Status .eq. Str$_Match) Return
X`009Endif
X*
X*`009Yes, so find the module.
X*
X`009Status = Lbr$Find(FilIdx,Rfa)
X`009Call Stchek(Status)
X*
X*`009Initialize flags.
X*
X`009Status = 1
X`009Typerest = .False.
X`009Inwindow = .False.
X`009Call Win_Fini
X`009Call Dynini(Rec_Descriptor)
X`009Ctopic = 0
X`009Smatch = 0
X`009Nsub = .False.
X*
X*`009Get_record returns a variable length descriptor, which
X*`009we then use to pass to our search routine.
X*
X`009Do While (Status)
X`009  Status = GetRec(Filidx,Rec_Descriptor)
X
X`009  If(Status) Then
X`009     Recs = Recs + 1
X`009     Totchr = Totchr + Rec_Descriptor.Len
X*
X*`009If a help library, and subtopic output requested, track current
X*`009subtopic.
X*
X`009     If(Subtopic .and. Helplib) Call Xtopic(Rec_Descriptor,Nsub)
X`009     If(Nsub) Smatch = 0      !If new subtopic, zero topic hit count
X*
X*`009Search the record for the target(s)
X*
X`009     SStat = Search_Rec(Rec_Descriptor)
X*
X*`009If search succeeded...
X*
X`009     If(Sstat) Then
X`009`009Matches = Matches + 1                 !Bump hit count
X`009`009Smatch = Smatch + 1`009`009      !And topic hit count
X`009`009If(Remaining) Typerest = .True.       !show all if /REMAINING
X*
X*`009If first match in this module...
X*
X`009       If(Matches .eq. 1) Then                !If first this module
X`009`009If(FmodMatch .eq. 0) Then`009        !If first this file
X*
X*`009Stars for windows at start of file
X*
X`009`009 If(Window .and. Heading) Write(Outlun,Hfm1)`032
X*
X*`009Filenames for /HEADING
X*
X                 If(Heading)`032
X     $                   Write(Outlun,'(A)') Current_File(1:Cfilnaml)
X`009`009Else  If(Window .and. Heading) Then
X*
X*`009Window and heading gets more stars if first this module
X*
X`009`009  Write(Outlun,Hfm2)
X`009`009Endif`009`009!First match this file
X*
X*`009Heading - special case for help libraries with /SUBTOPIC
X*
X                 If(Heading) Then
X`009`009   If(Subtopic .and. Helplib .and. Ctopic .gt. 0) Then
X`009`009     Write(Outlun,'(A,<Ctopic>(2x,A))')`032
X     $                        Key,(Topics(I)(1:Ltopics(I)),I=1,Ctopic)
X`009`009   Else
X`009`009      Write(Outlun,'(A)') Key
X`009`009   Endif`009    !Special help format
X`009`009 Endif`009`009    !Heading required.
X
X`009       Else If(Subtopic .and. Helplib .and. Ctopic .gt. 0) Then
X*
X*`009First match this subtopic ?
X*
X`009`009If(Smatch .eq. 1 .and. Heading) Then
X`009`009`009   If(Window) Write(Outlun,Hfm4)
X`009`009`009   Write(Outlun,'(A,<Ctopic>(2x,A))')`032
X     $                        Key,(Topics(I)(1:Ltopics(I)),I=1,Ctopic)
X`009        Endif
X`009       Endif`009`009`009`009!First match this module
X*
X*`009Do we need to open a new window ?
X*`009If so, we only output asterisks at the start if this is not the
X*`009first window this subtopic/module
X*`009Otherwise, we output a blank line.
X*
X`009       If(Winbefore .gt. 0 .and. .Not. Inwindow) Then
X`009`009If(Subtopic .and. Helplib) Then
X`009`009   If(SMatch .gt. 1) Then
X`009`009`009Write(Outlun,Hfm3)     !15 asterisks open window
X`009`009   Else
X`009`009`009Write(Outlun,'(/)')
X`009`009   Endif
X`009`009Else
X`009`009   If(Matches .gt. 1) Then
X`009`009`009Write(Outlun,Hfm3)     !15 asterisks open window
X`009`009   Else
X`009`009`009Write(Outlun,'(/)')
X`009`009   Endif
X`009`009Endif`009`009`009`009!Type of module
X`009`009Do I = -Winbefore,-1,1
X`009`009 Call WinOut(I)
X`009`009Enddo
X`009       Endif`009`009`009`009!Opening window
X
X`009       If(Window) Call Type_Rec(Rec_Descriptor,Recs)
X`009       If(Remaining) Typerest = .True.       !show all if /REMAINING
X
X`009       If(Winafter .gt. 0) Then
X`009`009Inwindow = .True.`009`009`009!Set up for post window
X`009`009Wincnt = Winafter
X`009       Endif
X*
X*`009But if it failed...
X*
X`009     Else If(Typerest) Then`009!If no hit in this record, but /REM
X`009       Call Type_Rec(Rec_Descriptor,Recs)
X`009     Else If(Inwindow) Then     !No hit, but still some /WINDOW lines
X`009       Call Type_Rec(Rec_Descriptor,Recs)
X`009       Wincnt = Wincnt - 1
X
X`009       If(Wincnt .eq. 0) Then
X`009`009Inwindow = .False.`009`009 !Done 'em all
X`009       Endif`009`009`009!End of window
X`009     Endif`009`009`009!Hit in record
X`009  Endif`009`009`009`009!Status OK
X`009Enddo`009`009`009`009!While read OK
X
X*`009If completion status is RMS$_EOF, then fine. Otherwise,
X*`009signal error.
X*
X`009If(Status .eq. %Loc(RMS$_EOF)) Then
X`009`009Search_Module = 1
X`009`009Call Module_End(Key)`009`009!Accumulate stats, report
X`009`009Return
X`009Endif
X
X`009Call Lib$Signal(%val(Status))
X`009Search_Module = Status
X`009Return
X`009End
X
X`009Logical Function Search_rec(Record)
X`009IMPLICIT NONE
X`009Character*(*) Record
X`009Include 'QUALCOM.INC'
X`009Include 'TRGCOM.INC'
X`009Integer Str$get1_dx,Str$Upcase,Str$Free1_Dx,Status
X`009Integer Pos,Hits,Str$Find_First_Substring
X`009Integer I,Dum
X`009Logical First
X`009Data First /.True./
X`009Record /DSCDEF1/ Tstr
X*
X*`009For each target, see if we can find it in the string.
X*`009Terminate when search conditions are satisfied.
X*`009If not exact matching, uppercase the record first.
X*
X`009If(.Not.Exact) Then
X`009   If(First) Then
X`009`009Call Dynini(Tstr)
X`009`009First = .False.
X`009   Endif
X`009   Status = Str$Get1_Dx(Len(Record),Tstr)
X`009   Call Stchek(Status)
X`009   Status = Str$Upcase(Tstr,Record)
X`009   Call Stchek(Status)
X`009Endif
X*
X`009Hits = 0
X`009Do I = 1,Ntargets
X`009 If(.Not.Exact) Then
X`009   Status = Str$Find_First_Substring(Tstr,Pos,Dum,Target(I))
X`009 Else
X`009   Status = Str$Find_First_Substring(Record,Pos,Dum,Target(I))
X`009 Endif
X
X`009 If(Pos .ne. 0) Hits = Hits + 1
X*
X*`009Check if any test is complete.
X*
X`009 If(Match .eq. Match_or .and. Hits .gt. 0) Then
X`009`009Search_Rec = .True.    ! OR succeeds after at least one hit
X`009`009Goto 100
X`009 Else If(Match .eq. Match_Nor .and. Pos .eq. 0) Then
X`009`009Search_Rec = .True.    ! NOR succeeds after at least one failure
X`009`009Goto 100
X`009 Else If(Match .eq. Match_And .and. Pos .eq. 0) Then
X`009`009Search_Rec = .False.    ! AND fails after one failure
X`009`009Goto 100
X`009 Else If(Match .eq. Match_Nand .and. Hits .ne. 0) Then
X`009`009Search_Rec = .False.    ! NAND fails after at least one hit
X`009`009Goto 100
X`009 Endif
X`009Enddo
X*
X*`009Now all is complete, check NAND and AND
X*       The OR or NOR test should have succeeded by now.
X*
X`009If(Match .eq. Match_And .and. Hits .eq. Ntargets) Then
X`009`009Search_Rec = .True.
X`009Else If(Match .eq. Match_NAnd .and. Hits .eq. 0) Then
X`009`009Search_Rec = .True.
X`009Else
X`009`009Search_Rec = .False.
X`009Endif
X
X100`009Continue
X
X`009Return
X`009End
X
X`009Subroutine Xtopic(Record,Nsub)
X*
X*`009This routine is called when we are looking at help libraries and must
X*`009keep track of which subtopic we are in.
X*`009Nsub is set true if there is a new subtopic level
X*
X`009Implicit None
X`009Character*(*) Record
X`009Logical Nsub
X`009Integer Ntopic,I
X`009Include 'TOPICS.INC'
X`009Integer Str$Find_First_not_In_Set
X*-------------------------------------------
X* Statement function for digit testing
X*
X`009Logical Digit
X`009Character*1 A
X
X`009Digit(A) = LGE(A,'0') .and. LLE(A,'9')
X*-------------------------------------------
X*
X*`009Skip empty records
X*
X`009Nsub = .False.
X`009If(Len(Record) .eq. 0) Return`032
X*
X*`009Skip records that don't start with a digit.
X*`009Also skip records that start with a digit, but are not followed
X*`009by space or tab.
X*
X`009If(.Not. Digit(Record(1:1))) Return
X`009If(Index(Char(32)//Char(9),Record(2:2)) .eq. 0) Return
X*
X*`009OK, we have a new subtopic/level. Read the level, extract the
X*`009topic.
X*
X`009Read(Record,*) Ntopic
X`009Nsub = .True.
X`009I = str$find_first_not_in_set ( Record,'0123456789  ')
X`009If(I .ne. 0) Then
X`009    Ctopic = Ntopic - 1
X`009    If(Ctopic .gt. 0) Then
X`009`009Topics(Ctopic) = Record(I:)
X`009    `009Ltopics(Ctopic) = Len(Record) - I + 1
X`009    Endif
X`009Endif
X
X`009Return
X`009End
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*`009real output routine.
X*
X`009Include 'QUALCOM.INC'
X`009Include 'STATCOM.INC'
X`009Include 'FORMAT.INC'
X
X`009Character*2048 Outrec
X`009Character*1 C
X`009Integer L1,L2,I
X`009Integer HT,CR
X`009Parameter (HT = 9)
X`009Parameter (CR = 13)
X
X`009If(Format .eq. FmtAll) Then`009`009!Simple - just output record
X
X`009  Call Output_Rec(Record,Linnum)
X
X`009Else
X*
X*`009Must pre-format record
X*
X`009  L1 = Len(Record)
X`009  L2 = 0
X`009  Rec_Truncated = .True.
X
X`009  Do I = 1,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*
X`009   Else If(Format .eq. Fmttxt .and.`032
X     $               Ichar(C) .ge. HT .and. Ichar(C) .le. CR) Then
X`009    L2 = L2 + 1
X`009    If(L2 .gt. 2048)  Goto 100
X`009    Outrec(L2:L2) = C
X`009   Else
X*
X*`009Otherwise look up character in translation table for formatted version
X*
X`009    If(L2 + Lform(Ichar(C)) .gt. 2048) 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 Output_Rec(Outrec(1:L2),Linnum)
X
X`009Endif
X
X`009Totout = Totout + 1
X`009Return
X`009End
X
X`009Subroutine Output_Rec(Record,Linnum)
X`009Implicit None
X`009Integer Linnum
X`009Character*(*) Record
X`009Include 'QUALCOM.INC'
X
X`009If(.Not.Numbers) Then
X`009`009Write(Outlun,'(A)') Record
X`009Else
X`009`009Write(Outlun,'(I6,A,A)') Linnum,Char(9),Record
X`009Endif
X`009Return
X`009End
$ GoSub Convert_File
$ Goto Part2

