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

Message-Id:  <8910161851.AA00586@crdgw1.ge.com>
Received: From NSFNET-RELAY.AC.UK by CRVAX.SRI.COM with TCP; Mon, 16 OCT 89 11:30:19 PDT
Received: from ncdlab.ulcc.ac.uk by NSFnet-Relay.AC.UK   via Janet with NIFTP
           id aa10631; 16 Oct 89 17:15 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 2/7

-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X`009`009      Call Output_Add(Unders(Rp:Hend),Nrec,Op,Linnum)
X`009`009    Else
X`009`009      Call Output_Add(Record(Rp:Hend),Nrec,Op,Linnum)
X`009`009    Endif
X
X`009`009    Rp = Hpos(I)`032
X`009`009  Enddo
X`009`009  If(Op .ne. 0)
X     $                  Call Output_Rec(Nrec(1:op),Linnum,Trunc_flag)
X
X`009 Endif
X`009Endif
X
X`009Return
X`009End
X
X`009Subroutine Hilite_Position(Record,Hpos,Nchanges,Tmp)
X`009Implicit None
X`009Integer*2 Hpos(*)
X`009Character*(*) Record,Tmp
X`009Integer Nchanges
X*
X*`009This routine, given a record, returns a set of pairs indicating
X*`009where highlighting is to be turned on and off.
X*`009It also returns the number of such pairs.
X*`009Tmp is a work character array of the same size as RECORD.
X*
X`009Include 'TRGCOM.INC'
X`009Integer Pos1,Snum,Rp,Rl,Tl
X
X`009Nchanges = 0
X`009Tmp = ' '
X`009Rl = Len(Record)
X*
X*`009Starting with the whole string, use interface routine to Str$find_first
X*`009to locate where first hit is. We then search for subsequent hits from
X*`009the next character position. Note that it is important to order the
X*`009targets so that the largest is first in the list. This means we
X*`009correctly highlight when one target is a substring of another, and
X*`009the longer one appears in the source record.
X*
X*`009First TMP is built up to contain spaces where no highlighting is
X*`009needed and uppercase H elsewhere.
X*
X`009Rp = 1
X`009Call Str_Find_First_Substring(Record(Rp:),Pos1,Snum,Ntargets,Target)
X`009Do While (Snum .ne. 0 .and. Rp .le. Rl)
X`009   Tl = Target(Snum).Dsc$W_Maxstrlen
X`009   Call Str$Dupl_Char(Tmp(Rp+Pos1-1:Rp+Pos1+Tl-1),Tl,IChar('H'))
X`009   Rp = Rp + Pos1
X`009   Call Str_Find_First_Substring(
X     $                 Record(Rp:),Pos1,Snum,Ntargets,Target)
X`009Enddo
X*
X*`009This is now converted to a set of change pairs
X*
X  `009If(Rp .ne. 1) Then
X `009`009Rp = 1
X`009`009Pos1 = Index(Tmp(Rp:),'H')
X
X`009`009Do While (Pos1 .ne. 0)
X`009`009   Hpos(Nchanges*2+1) = Rp + Pos1 - 1
X`009`009   Nchanges = Nchanges + 1
X`009`009   Rp = Rp + Pos1
X`009`009   Pos1 = Index(Tmp(Rp:),' ')
X`009`009   If(Pos1 .ne. 0) Then
X`009`009     Hpos(Nchanges*2) = Rp + Pos1 - 1
X`009`009     Rp = Rp +  Pos1
X`009`009     Pos1 = Index(Tmp(Rp:),'H')
X`009`009   Else
X`009`009     Hpos(Nchanges*2) = Rl + 1
X`009`009   Endif
X`009`009Enddo
X`009Endif             `032
X`009
X`009Return
X`009End
X
X`009Subroutine Output_Add(Portion,Bulk,Pos,Linnum)
X`009Implicit None
X`009Character*(*) Portion,Bulk
X`009Integer Pos,Linnum
X*
X*`009Add another chunk of output to an output record.
X*`009Flush the buffer with the continued marked if necessary
X*
X`009If(Len(Portion) + Pos .gt. Len(Bulk)) Then
X`009`009Call Output_Rec(Bulk(1:Pos),Linnum,.True.)
X`009`009Pos = 0
X`009Endif
X
X`009Bulk(Pos+1:Pos+Len(Portion)) = Portion
X`009Pos = Pos + Len(Portion)
X`009Return
X`009End
X
X`009Subroutine Output_Rec(Record,Linnum,Contin)
X`009Implicit None
X`009Integer Linnum
X`009Logical Contin
X`009Character*(*) Record
X*
X*`009This REALLY writes output to the output file.
X*
X`009Include 'QUALCOM.INC'
X`009Include 'STATCOM.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`009If(Contin) Write(Outlun,'(A)') '(continued)'
X`009Totout = Totout + 1
X`009Return
X`009End
$ CALL UNPACK OUTPUT.FOR;26 1260279852
$ create/nolog 'f'
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`009Integer Sys$Bintim
X`009External CLI$_NEGATED,CLI$_LOCNEG
X`009Character*128 Temp
X`009Integer Tlen
X`009Include 'QUALCOM.INC'
X`009Include 'WINDOW.INC'       !To get value of MAXWIN
X`009Logical Hilite_Used
X
X`009External Libsearch_Cmd
X`009External LIBSEARCH_WINPARONE,LIBSEARCH_WINPARBAD
X`009External LIBSEARCH_INVNUMFMT,LIBSEARCH_WDW_MAXPRM`009!Message codes
X*
X*`009Fake up CLI tables if necessary
X*
X`009Call Init_Cli(Libsearch_Cmd,'LIBSEARCH')
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`009Confirm = .False.
X`009Confirm_Module = .False.
X`009If(Cli$Present('CONFIRM')) Then
X`009`009Confirm = .True.
X`009`009Status = Cli$Get_Value('CONFIRM',Temp,Tlen)
X`009`009Call Stchek(Status)
X`009`009Confirm_Module = Temp(1:Tlen) .eq. 'MODULE'
X`009Endif
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`009`009If(Temp(1:Tlen) .eq. 'NOFF') Format = Fmtnoff
X`009Endif
X*
X*`009Before,since,created and such all interact.
X*
X`009Time_Type = Module_Time`009`009`009!Default if none specified
X`009If(Cli$Present('BACKUP')) Time_type = Backup
X`009If(Cli$Present('EXPIRED')) Time_type = Expired
X`009If(Cli$Present('MODIFIED')) Time_type = Modified
X`009If(Cli$Present('CREATED')) Time_type = Created
X
X`009Before = .False.
X`009If(Cli$Present('BEFORE')) Then
X`009`009Status = Cli$Get_Value('BEFORE',Temp,Tlen)
X`009`009Call Stchek(Status)
X`009`009Before = .True.
X`009`009Status = sys$bintim (Temp(1:Tlen),Btime)
X`009`009Call Stchek(Status)
X`009Endif
X
X`009Since = .False.
X`009If(Cli$Present('SINCE')) Then
X`009`009Status = Cli$Get_Value('SINCE',Temp,Tlen)
X`009`009Call Stchek(Status)
X`009`009Since = .True.
X`009`009Status = sys$bintim (Temp(1:Tlen),Stime)
X`009`009Call Stchek(Status)
X`009Endif
X*
X*`009Highlight is slightly different - we treat as a single enumerated
X*`009type.
X*
X`009If(Cli$Present('HIGHLIGHT')) Then
X`009`009Status = Cli$Get_Value('HIGHLIGHT',Temp,Tlen)
X`009`009Call Stchek(Status)
X`009`009If(Temp(1:Tlen) .eq. 'HARDCOPY' .or.`032
X     $                    CLI$present('HARDCOPY')) Then
X`009`009  Status = Cli$Get_Value('HARDCOPY',Temp,Tlen)
X`009`009  Call Stchek(Status)
X`009`009  Hilite = Index('UO',Temp(1:1)) + 4
X`009`009Else
X`009`009  Hilite = (Index('BOBLREUN',Temp(1:2)) + 1)/2
X`009`009Endif
X
X`009`009Hilite_used = .True.
X`009Else If(Cli$Present('HIGHLIGHT') .eq. %loc(Cli$_Negated)) Then
X`009`009HiLite = 0
X`009`009Hilite_used = .True.
X`009Else
X`009`009Hilite_used = .False.
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    If(Cli$Get_Value('WINDOW',Temp,Tlen)) Then
X`009`009        Call Lib$Signal(LIBSEARCH_WDW_MAXPRM) !Too many windows
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*    Change re pat rankin's suggestions to match SEARCH more closely.
X*`009after = before + 0 or 1
X*
X`009`009    WinAfter = Winbefore - Winbefore/2
X`009`009    Winbefore = Winbefore/2
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`009IF(.Not. Cli$Get_Value('OUTPUT',Temp,Tlen)) Then
X`009`009Temp = 'NL:'
X`009`009Tlen = 3
X`009Endif
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
X
X`009Integer Function Init_Cli(Table,Verb)
X*
X*`009This function is called by a program which wishes to use the CLI
X*`009routines, but doesn't know if the user has done a SET COMMAND to
X*`009invoke the program. The routine fakes the CLI tables if necessary.
X*`009Translated by Kevin Ashley from Joe Meadows' original C routine.
X*
X`009Implicit None
X`009Integer Table
X`009Character*(*) Verb
X`009Include '($DSCDEF)'
X`009Record/DSCDEF1/ Dyndes
X`009Integer Cli$Get_Value,Cli$Dcl_Parse,Str$Compare
X`009Integer Status,L
X`032
X`009Dyndes.Dsc$B_DType = Dsc$K_Dtype_T
X`009Dyndes.Dsc$B_Class = Dsc$K_Class_D
X`032
X`009Status = Cli$Get_Value('$VERB',Dyndes)
X`032
X`009If(.Not.Status) Then
X`009`009Init_Cli = Status
X`009`009Return
X`009Endif
X`032
X`009L = Min(Len(Verb),Dyndes.Dsc$W_Maxstrlen)
X`009If(Str$Compare(Verb(1:L),Dyndes) .eq. 0) Then
X`009`009Init_Cli = 1`009`009!SET COMMAND used OK
X`009Else
X`009`009Status = Cli$Get_Value('$LINE',Dyndes)
X`009`009If(.Not. Status) Then
X`009`009   Init_Cli = Status
X`009`009   Return
X`009`009Endif
X*
X*`009We now replace the foreign image specification with the verb name...
X*
X`009`009Call Init_Cli1(Dyndes,Verb)
X`009`009Status = Cli$Dcl_Parse(Dyndes,Table)
X`009`009Init_Cli = Status
X`009Endif
X`032
X`009Return
X`009End
X`032
X`009Subroutine Init_Cli1(Command,Verb)
X*
X*`009replace foreign image specification in  command with verb
X*
X`009Implicit None
X`009Character*(*) Command,Verb
X`009Integer I
X`032
X`009I = 1
X`009Do While (I .lt. Len(Command) .and.
X     $             Command(I:I) .ne. ' ' .and.
X     $             Command(I:I) .ne. '/')
X`009`009If(I .le. Len(Verb)) Then
X`009`009  Command(I:I) = Verb(I:I)
X`009`009Else
X`009`009  Command(I:I) = ' '
X`009`009Endif
X`009`009I = I + 1
X`009Enddo
X`009Return
X`009End
$ CALL UNPACK PRSCOM.FOR;32 628011676
$ create/nolog 'f'
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`009Logical Confirmed,Bad_Timing
X`009External LIBSEARCH_TOOMNYFIL,LIBSEARCH_OPENIN,LIBSEARCH_TOOMNYEXC
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(Excluded,Lexcl,Nexcl,Maxfiles)
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*
+-+-+-+-+-+-+-+-  END  OF PART 2 +-+-+-+-+-+-+-+-

