From:	CSBVAX::MRGATE!info-vax-RELAY@KL.SRI.COM@SMTP  1-AUG-1988 23:51
To:	ARISIA::EVERHART
Subj:	uw nntp news reader part c


Received: from ucbvax.berkeley.edu by KL.SRI.COM with TCP; Fri, 29 Jul 88 00:27:59 PDT
Received: by ucbvax.berkeley.edu (5.59/1.28)
	id AA10618; Thu, 28 Jul 88 15:06:50 PDT
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 28 Jul 88 20:25:00 GMT
From: dogie!dorl%vms.macc.wisc.edu@csd1.milw.wisc.edu  (Michael Dorl - MACC)
Organization: University of Wisconsin Academic Computing Center
Subject: uw nntp news reader part c
Message-Id: <520@dogie.edu>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com


	If (L .ge. Group(G).Active_End) Then
	  Cmd_ArticleCatchUp = .true.
	Else
	  Cmd_ArticleCatchUp = .false.
	EndIf

C Find the first range beyond L

	R = Group(G).Range_First
	X = 0

	Do While ((R .ne. 0) .and. (L .ge. Range(R).End))
	  X = R
	  R = Range(R).Next	    
	EndDo

C R is the Range following L or zero, X is the Range in front of
C L or zero.

C Release all ranges from Group(G).Range_First - X.  These ranges
C contain articles less than L.

	If (X .ne. 0) Then
	  Range(X).Next = 0
	  X = Group(G).Range_First
	  Call Range_Deallocate (X)
	  Group(G).Range_First = R
	EndIf

C Several cases can arise.
C
C   R = 0			All ranges have been released, get
C				a new one and set it to 1-L
C
C   L < R.Start			Add a new range to the
C				Group from 1-L
C
C   R.Start <= L < R.End        Set R.Start = 1
C
C   L >= R.End			Impossible

	If (R .eq. 0) Then
	  R = Range_Allocate ()
	  Range(R).Start = 1
	  Range(R).End   = L
	  Range(R).Next  = 0
	  Group(G).Range_First = R
	  Group(G).Range_Last = R
	Else If (L .lt. Range(R).Start) Then
	  X = Range_Allocate ()
	  Group(G).Range_First = X
	  Range(X).Start = 1
	  Range(X).End = L
	  Range(X).Next = R
	  Call Range_Combine (X, R)
	Else If
     $    ((L .ge. Range(R).Start) .and. (L .lt. Range(R).End)) Then
	  Range(R).Start = 1
	Else 
	  Stop 'Catchup error'
	EndIf

	A = L

	U = UnRead (G)			! Update unread mail count

	Return

	End ! Cmd_ArticleCatchUp


	Subroutine Cmd_ArticleDisplay (G, A, Rotate_Flag)

	Include 'News.Def'

C Parameter definitions

	Integer   *4	G	! Group number
	Integer   *4	A	! Article number
	Logical		Rotate_Flag

C External routines

	Integer		Srv_Cmd
	External 	Header_Check

C Local definitions

	Character *128	Cmd
	Integer   *4	Lg
	Integer   *4	Status
	Character *8	Num

C Begin Cmd_ArticleDisplay

	Call More_Heading

	Write (Cmd, '(A, I6)') 'head ', A
	Status = Srv_Cmd (Cmd(1:11), Cmd, Lg)
	If (.not. Status) Then
	  Call SMG_All_Print ('Server failed', '|')
	  Stop
	EndIf
	If (Cmd(1:3) .eq. '221') Then
	  Call Srv_RdTxt (.true., .false., Header_Check)
	Else
	  Call SMG_All_Print ('Unexpected server response', '|')
	  Call SMG_All_Print (Cmd(1:Lg), '|')
	  Stop
	EndIf

	Call SMG_All_Print (' ', '|')

	Write (Cmd, '(A, I6)') 'body ', A
	Status = Srv_Cmd (Cmd(1:11), Cmd, Lg)
	If (.not. Status) Then
	  Call SMG_All_Print ('Server failed', '|')
	  Stop
	EndIf
	If (Cmd(1:3) .eq. '222') Then
	  Call Srv_RdTxt (.true., Rotate_Flag, %Val(0))
	Else
	  Call SMG_All_Print ('Unexpected server response', '|')
	  Call SMG_All_Print (Cmd(1:Lg), '|')
	  Stop
	EndIf

	End ! Cmd_ArticleDisplay


	Integer Function Header_Check (Img)

	Include 'News.Def'

C Parameter definition

	Character *(*)	Img

C Local definitions

	Integer   *4	X
	Character *16	Fld

C Begin Header_Check

	Header_Check = .true.

	If ((Img .eq. ' ') .or. (.not. Header_Present)) Then
	  Return
	EndIf

	X = Index (Img, ':') - 1
	If (X .le. 0) Then
	  Fld = Img
	Else
	  Fld = Img(1:X)
	EndIf

	Call Str$Upcase (Fld, Fld)

	X = 1
	Do While (X .le. Header_Count)
	  If (Header(X) .eq. Fld) Then
	    Return
	  EndIf
	  X = X + 1
	EndDo

	Header_Check = .false.

	Return

	End ! Header_Check


	Subroutine Cmd_ArticleNone

	Call SMG_All_Print ('No article selected', '|')

	End ! Cmd_ArticleNone


	Integer Function Cmd_ArticleNumber (G, Text, S)

	Include 'News.Def'

C Parameter definition

	Integer   *4	G
	Character *(*)	Text
	Integer   *4	S

C Local delinitions

	Integer   *4	Lg
	Integer   *4	N
	Integer   *4	X
	Character *8    Num

C Begin Cmd_ArticleNUmber

	Lg = Len(Text)
	X = 1
	N = 0
	Cmd_ArticleNumber = .true.

	Do While ((X .le. Lg) .and. Cmd_ArticleNumber)
	  If ((Text(X:X) .ge. '0') .and. (Text(X:X) .le. '9')) Then
	    N = 10 * N + IChar(Text(X:X)) - IChar('0')
	  Else
	    Cmd_ArticleNumber = .false.
	  EndIf
	  X = X + 1
	EndDo

	If (Cmd_ArticleNumber) Then
	  If 
     $       (
     $        (N .ge. Group(G).Active_Start) 
     $       .and.
     $	      (N .le. Group(G).Active_End)
     $	     )
     $	  Then
	    S = N
	  Else
	    Call ItoS (N, Num, Lg)
	    Print '(A)', ' Article ' // Num(1:Lg) // ' not available'
	    Cmd_ArticleNumber = .false.
	  EndIf
	EndIf

	End ! Cmd_ArticleNumber


	Subroutine Cmd_ArticleKill (G, A, U)

	Include 'News.Def'

C Parameter definition

	Integer   *4		G	! Group number
	Integer   *4		A	! Article number
	Integer   *4            U	! Unread article count, updated

C External routines

	Integer			Range_Find

C Local definitions

	Logical 		Any
	Integer   *4		I
	Integer   *4		I_Lg
	Character *8		I_C
	Integer	  *4		Subject_Lg
	Integer   *4		Status
	Character *128		Subject
	Integer   *4		XSubject_Lg
	Character *128		XSubject

C Begin Cmd_ArticleKill

	Any = .false.

C Send XHdg Subject command to retrieve subject line for article

	Call CacheHdr (G, A, Subject, Subject_Lg)
C%	Call XHdr (A, 'subject', Subject, Subject_Lg)

C Remove article number from front of subject line

	Call ItoS (A, I_C, I_Lg)

        If (I_Lg .lt. Subject_Lg) Then
	
	  Subject(1:Subject_Lg-I_Lg) = Subject(1+I_Lg:Subject_Lg)
	  Subject_Lg = Subject_Lg - I_Lg

C Display subject being killed

	  Call SMG_All_Print
     $      ('Searching for: ' // Subject(1:Subject_Lg), '|')

C Page through articles looking for this subject

	  Do I = Group(G).Active_Start, Group(G).Active_End

	    If (Range_Find(G, I, .false.) .eq. 0) Then

c	      Write (XSubject, '(A,I)') 'Looking at article ', I
c	      Call SMG_ALL_Print (XSubject, '|')

	      Call CacheHdr (G, I, XSubject, XSubject_Lg)
c%	      Call XHdr (I, 'subject', XSubject, XSubject_Lg)

c	      Call SMG_All_Print (XSubject(1:XSubject_Lg), '|')

C Remove article number from front of subject line

	      Call ItoS (I, I_C, I_Lg)

	      If (XSubject_Lg .gt. I_Lg) Then

	        XSubject(1:XSubject_Lg-I_Lg) = 
     $ 		  XSubject(1+I_Lg:XSubject_Lg)
	        XSubject_Lg = XSubject_Lg - I_Lg

	        If 
     $		  (Subject(1:Subject_Lg) .eq. XSubject(1:XSubject_Lg))
     $	        Then
	          Status = Range_Find (G, I, .true., U)
	          Call ItoS (I, I_C, I_Lg)
	          Call SMG_All_Print ('Killed: ' // I_C(1:I_Lg), '|')
	          Any = .true.
	        EndIf

	      EndIf ! (XSubject_Lg .gt. I_Lg)

	    EndIf ! (Range_Find(G, I, .false.) .eq. 0)

	  End Do

        EndIf ! (I_Lg .lt. Subject_Lg)

	If (.not. Any) Then
	  Call SMG_All_Print ('No articles killed', '|')
	End If

	End ! Cmd_ArticleKill


	Integer Function Cmd_ArticleSameSubj (G, A)

	Include 'News.Def'

C Parameter definition

	Integer   *4		G	! Group number
	Integer   *4		A	! Article number

C External routines

	Integer			Range_Find

C Local definitions

	Integer   *4		I
	Integer   *4		I_Lg
	Character *8		I_C
	Integer	  *4		Subject_Lg
	Integer   *4		Status
	Character *128		Subject
	Integer   *4		XSubject_Lg
	Character *128		XSubject

C Begin Cmd_ArticleSameSubj

C Send XHdg Subject command to retrieve subject line for article

	Call CacheHdr (G, A, Subject, Subject_Lg)

C Remove article number from front of subject line

	Call ItoS (A, I_C, I_Lg)

        If (I_Lg .lt. Subject_Lg) Then
	
	  Subject(1:Subject_Lg-I_Lg) = Subject(1+I_Lg:Subject_Lg)
	  Subject_Lg = Subject_Lg - I_Lg

C Display subject being looked for

	  Call SMG_All_Print
     $      ('Searching for: ' // Subject(1:Subject_Lg), '|')

C Page through articles looking for this subject

	  Do I = Group(G).Active_Start, Group(G).Active_End

	    If (Range_Find(G, I, .false.) .eq. 0) Then

	      Call CacheHdr (G, I, XSubject, XSubject_Lg)

C Remove article number from front of subject line

	      Call ItoS (I, I_C, I_Lg)

	      If (XSubject_Lg .gt. I_Lg) Then

	        XSubject(1:XSubject_Lg-I_Lg) = 
     $ 		  XSubject(1+I_Lg:XSubject_Lg)
	        XSubject_Lg = XSubject_Lg - I_Lg

	        If 
     $		  (Subject(1:Subject_Lg) .eq. XSubject(1:XSubject_Lg))
     $	        Then
		  Cmd_ArticleSameSubj = .true.
		  A = I
		  Return
	        EndIf

	      EndIf ! (XSubject_Lg .gt. I_Lg)

	    EndIf ! (Range_Find(G, I, .false.) .eq. 0)

	  End Do

        EndIf ! (I_Lg .lt. Subject_Lg)

	Call SMG_All_Print ('No other articles found', '|')
	Cmd_ArticleSameSubj = .false.
	Return

	End ! Cmd_ArticleSameSubj 


	Integer Function Cmd_ArticleFirst (G, A)

	Include 'News.Def'

C Parameter definition

	Integer   *4		G	! Group number
	Integer   *4		A	! Article number

C Entry point definitions

	Integer			Cmd_ArticleLast

C External routines

	Integer			Range_Find

C Local definitions

	Integer   *4		E, D, I, S

C Begin Cmd_ArticleFirst

	S = Group(G).Active_Start
	E = Group(G).Active_End
        D = +1
	Goto 1

C Begin Cmd_ArticleLast

	Entry Cmd_ArticleLast (G, A)

	S = Group(G).Active_End
        E = Group(G).Active_Start
        D = -1
	Goto 1

C Page through articles looking for first unread

1	Do I = S, E, D 

	  If (Range_Find(G, I, .false.) .eq. 0) Then

	    A = I
	    Cmd_ArticleFirst = .true.
	    Return

	  EndIf

	End Do

C No unread articles found

	Call SMG_All_Print ('No unread articles found', '|')
	Cmd_ArticleFirst = .false.
	Return

	End ! Cmd_ArticleFirst


	Subroutine XHdr (A, What, Result, Lg)

	Include 'News.Def'

C Parameter definitions

	Integer   *4		A
	Character *(*)		What
	Character *(*)		Result
	Integer   *4		Lg

C External routines

	Integer  		Srv_Cmd
	Integer			Srv_Recv
	Integer			Srv_RdTxt

C local definitions

	Integer   *4		Status

C Begin XHdr

C Request header line with a 'xhdr what article_number' command

	Write (Result, '(A,I)') 'xhdr ' // What // ' ', A
	Status = Srv_Cmd (Result, Result, Lg)
	If (.not. Status) Then
	  Call SMG_All_Print ('Server failed', '|')
	  Stop
	EndIf
	If (Result(1:3) .ne. '221') Then
	  Call SMG_All_Print (Result(1:Lg), '|')
	  Call SMG_All_Print ('Unexpect server response', '|')
	  Stop
	EndIf

C Get header line

	Status = Srv_Recv (Result, Lg)
	If (.not. Status) Then
	  Call SMG_All_Print ('Server failed', '|')
	  Stop
	EndIf

C Skip rest of response

	If (Result(1:Lg) .ne. '.') Then
	  Status = Srv_RdTxt (.false., .false., %Val(0))	
	  If (.not. Status) Then
	    Call SMG_All_Print ('Server failed', '|')
	    Stop
	  EndIf
	EndIf

C Return

	Return

	End ! XHdr


	Subroutine Cmd_Help

	Include 'News.Def'

C Begin Cmd_Help

	Call SMG_Erase

	Call SMG_All_Print ('b             backup', '|')
	Call SMG_All_Print ('c [#]         catchup', '|')
	Call SMG_All_Print ('d             directory', '|')
	Call SMG_All_Print ('d/g pattern   group directory', '|')
	Call SMG_All_Print ('f             followup', '|')
	Call SMG_All_Print ('g group       go group', '|')
	Call SMG_All_Print ('h             help', '|')
	Call SMG_All_Print ('k             kill', '|')
	Call SMG_All_Print ('m             mark unread', '|')
	Call SMG_All_Print ('n             next', '|')
	Call SMG_All_Print ('p             post', '|')
	Call SMG_All_Print ('q             quit', '|')
	Call SMG_All_Print ('r             refresh', '|')
	Call SMG_All_Print ('s             save', '|')
	Call SMG_All_Print ('u             unsubscribe', '|')
	Call SMG_All_Print ('x             rotate', '|')
	Call SMG_All_Print ('z             next article same subject', '|') 
	Call SMG_All_Print ('#             article number', '|')
	Call SMG_All_Print ('^             first unread article', '|')
	Call SMG_All_Print ('$             last unread article', '|')
	Call SMG_All_Print (' ', '|')

	Return

	End ! Cmd_Help


	Integer Function Open_Newsrc ()

	Include 'News.Def'

C External routines

	Integer     	Range_Allocate
	Integer		TrimLg
	External	User_Open

C Local Definitions

	Character  *1		C
	Integer    *4		Status
	Character  *512		Image
	Integer    *4		R
	Integer    *4		S, L, N, E, X

C Begin Open_Newsrc

	Call User_Open_Init ('STATUS_OLD',0,0,0,0,0,0,0,0)

	Open
     $    (
     $     Unit 	= LU_Newsrc,
     $	   File		= 'Sys$Login:XX.Newsrc',
     $     Status	= 'Old',
     $     Form		= 'Formatted',
     $	   Recl		= 512,
     $	   UserOpen	= User_Open,
     $     IOStat	= Status
     $    )

	Group_Count = 0

	If (Status .ne. 0) Then
	  Newsrc_Is_Open = .false.
	  Open_Newsrc = 0
	  Return
	EndIf

	Newsrc_Is_Open = .true.

C Get date of creation of XX.Newsrc

	Call User_Open_Get_CDT (LU_Newsrc, Newsrc_CDT_VMS)
	Newsrc_CDT_News(1:2) = Newsrc_CDT_VMS(10:11)	! Year
	X = Index
     $    (
     $     'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC',
     $     Newsrc_CDT_VMS(4:6)
     $    )
	Write (Newsrc_CDT_News(3:4), '(I2.2)') X/3 + 1	! Month
        Newsrc_CDT_News( 5: 6) = Newsrc_CDT_VMS(1:2)	! Day
	If (Newsrc_CDT_News(5:5) .eq. ' ') Then
	  Newsrc_CDT_News(5:5) = '0'
	EndIf
	Newsrc_CDT_News( 7: 7) = ' '
	Newsrc_CDT_News( 8: 9) = Newsrc_CDT_VMS(13:14)	! Hour
	If (Newsrc_CDT_News(8:8) .eq. ' ') Then
	  Newsrc_CDT_News(8:8) = '0'
	EndIf
	Newsrc_CDT_News(10:11) = Newsrc_CDT_VMS(16:17)	! Minute
	If (Newsrc_CDT_News(10:10) .eq. ' ') Then
	  Newsrc_CDT_News(10:10) = '0'
	EndIf
	Newsrc_CDT_News(12:13) = Newsrc_CDT_VMS(19:20)	! Second
	If (Newsrc_CDT_News(12:12) .eq. ' ') Then
	  Newsrc_CDT_News(12:12) = '0'
	EndIf

C Now read users XX.Newsrc

	Status = 1
	Do While (Status)
	  Read
     $	    (
     $       Unit	= LU_Newsrc,
     $       Fmt	= '(A)',
     $       IOStat	= Status
     $      )
     $      Image
	  If (Status .lt. 0) Then
	    Open_Newsrc = 1
	    Status = 0
	  Else If (Status .ne. 0) Then
	    Close (LU_Newsrc)
	    Open_Newsrc = 0
	    Status = 0
	  Else
	    Status = 1
	    X = Index (Image, ':')
	    If (X .eq. 0) Then
	      X = Index (Image, '!')
	    EndIf
	    If (X .ne. 0) Then

C We have a new group

	      Group_Count = Group_Count + 1
	      Group(Group_Count).Range_First = 0
	      Group(Group_Count).Range_Last  = 0
	      Group(Group_Count).Newsrc_File = .true.

C Record group's name

	      Group(Group_Count).Name = Image (1:X-1)

C Get subscribed information

	      If (Image(X:X) .eq. ':') Then
	        Group(Group_Count).Subscribed = .true.
	      Else
	        Group(Group_Count).Subscribed = .false.
	      EndIf

C Clear moderated and activefile flags, they will get set properly
C when we page through the news groups later.

	      Group(Group_Count).Active_Post = .false.
	      Group(Group_Count).Active_File = .false.
	      
C Get article ranges

	      S = 0
	      N = 0
	      E = 0
	      L = 0

	      Do While (X .le. 512)

	        X = X + 1
		If (X .eq. 512) Then
	          C = ','
	        Else
	          C = Image (X:X)
	        EndIf

	        If ((C .ge. '0') .and. (C .le. '9')) Then
	          N = 10 * N + IChar(C) - IChar('0')
	        Else If (C .eq. '-') Then
	          S = N
	          N = 0
	        Else If (C .eq. ',') Then
	          E = N
	          If (S .eq. 0) Then
		    S = E
	          EndIf

C Now add a new range entry to this group's control structure

		  If (S .ne. 0) Then
		    If ((S .le. L) .or. (S .gt. E)) Then
		      Call SMG_All_Print
     $			(
     $                   'Error in XX.Newsrc entry for group ' //
     $                   Group(Group_Count).Name
     $                     (1:TrimLg(Group(Group_Count).Name)),
     $			 '|'
     $		        )
		    Else
	              R = Range_Allocate ()
	              Range(R).Next  = 0
	              Range(R).Start = S
		      Range(R).End   = E

	              If (Group(Group_Count).Range_First .eq. 0) Then
	                Group(Group_Count).Range_First = R
	              Else
	                Range(Group(Group_Count).Range_Last).Next
     $                    = R
	              EndIf
	              Group(Group_Count).Range_Last = R
		      L = E
		    EndIf
		  EndIf

C Get ready for next range

		  S = 0
	          E = 0
	          N = 0

	        EndIf
	      EndDo

	    Else
	
	    EndIf
	  EndIf
	End Do	  

	End ! Open_Newsrc


	Integer Function Close_Newsrc ()

	Include 'News.Def'

C External definitions

	Integer			TrimLg

C Local Definitions

	Logical			First
	Integer    *4		G
	Character  *512		Image
	Integer	   *4		R
	Integer    *4		Status
	Integer    *4		X

	Integer    *4           S,    E
	Character  *8		S_C,  E_C
	Integer    *4		S_Lg, E_Lg

C Begin Close_Newsrc

	If (Newsrc_Is_Open) Then
	  Close (LU_Newsrc)
	EndIf

	Open
     $    (
     $     Unit 	   = LU_Newsrc,
     $	   File		   = 'Sys$Login:XX.Newsrc',
     $     Status	   = 'New',
     $     Form		   = 'Formatted',
     $     CarriageControl = 'List',
     $	   Recl		   = 512,
     $     IOStat	   = Status
     $    )

	G = 1

	If (Status .ne. 0) Then
	  Close_Newsrc = 0
	  Return
	EndIf

C Wander through all groups

	Do While (G .le. Group_Count)

	  If
     $       (
     $        (Group(G).Active_File .and. Group(G).Subscribed)
     $       .or.
     $        Group(G).Newsrc_File
     $       )
     $    Then

C Start image with group name

	    X = TrimLg (Group(G).Name)
	    Image(1:X) = Group(G).Name(1:X)

C Now add subscribed flag

	    X = X + 1
	    If (Group(G).Subscribed) Then
	      Image(X:X) = ':'
	    Else
	      Image(X:X) = '!'
	    EndIf

C Wander through all ranges for this group

	    R = Group(G).Range_First
	    First = .true.

	    Do While (R .ne. 0)

	      If (.not. First) Then
	        X = X + 1
	        Image(X:X) = ','
	      Else
	        First = .false.
	      EndIf

	      S = Range(R).Start
	      Call ItoS (S, S_C, S_Lg)
	      Image(X+1:X+S_Lg) = S_C(1:S_Lg)
	      X = X + S_Lg

	      If (Range(R).End .ne. Range(R).Start) Then
                X = X + 1
	        Image(X:X) = '-'
		E = Range(R).End
	        Call ItoS (E, E_C, E_Lg)
	        Image(X+1:X+E_Lg) = E_C(1:E_Lg)
	        X = X + E_Lg
	      EndIf

	      R = Range(R).Next

	    End Do ! (R .ne. 0)

	    Write (LU_Newsrc, '(A)') Image(1:X)
	 
	  EndIf

	  G = G + 1
	End Do ! (G .le. Group_Count)

C Return success

	Close_Newsrc = 1

	End ! Close_Newsrc


	Integer Function Range_Allocate

	Include 'News.Def'

C Begin Range_Allocate

	If (Range_Free_List .ne. 0) Then
	  Range_Allocate = Range_Free_List
	  Range_Free_List = Range(Range_Free_List).Next
	Else
	  If (Range_Count .lt. Mx_Range) Then
	    Range_Count = Range_Count + 1
	    Range_Allocate = Range_Count
	  Else
	    Call SMG_All_Print ('Range array exceeded', '|')
	    Stop
	  EndIf
	EndIf

	Range(Range_Allocate).Next  = 0
	Range(Range_Allocate).Start = 0
	Range(Range_Allocate).End   = 0

	Return

	End ! Range_Allocate


	Subroutine Range_Deallocate (R)

 	Include 'News.Def'

C Parameter definitions

	Integer   *4	R	! Range index

C Local definitions

	Integer   *4 	N, X

C Begin Range_Deallocate

	X = R
	Do While (X .ne. 0)
	  N = Range(X).Next
	  Range(X).Next = Range_Free_List
	  Range_Free_List = X
	  X = N
	End Do

	End ! Range_Deallocate


	Integer Function Range_Find (G, A, Create, U)

	Include 'News.Def'

C Description
C
C   Locates the Range entry for article number A in group G.
C   If a range entry does not exist for A and Create is true,
C   one is created.
C
C   Returns the Range entry index or zero if none.
C

C Parameter definitions

	Integer   *4		G	! Group number
	Integer	  *4		A	! Article number
	Logical			Create  ! .true. if create on no find
	Integer   *4		U	! Unread article count, updated

C External routines

	Integer			Range_Allocate

C Local definitions

	Integer   *4		P
	Integer   *4		R, RR
	Logical			Found

C Begin Range_Find

	P = 0
	R = Group(G).Range_First
	Found = .false.
	Range_Find = 0

	Do While ((R .ne. 0) .and. (.not. Found))	
	  If ((A .ge. Range(R).Start) .and. (A .le. Range(R).End)) Then
	    Found = .true.
	    Range_Find = R
	  Else If (A .lt. Range(R).Start) Then
	    Found = .true.
	  Else
	    P = R
	    R = Range(R).Next
	  End If
	End Do

	If ((Range_Find .eq. 0) .and. Create) Then
	  If 
     $      (
     $       (P .ne. 0) 
     $      .and. 
     $       ((Range(P).End+1) .eq. A)
     $      ) Then
            Range(P).End = Range(P).End + 1
	    Range_Find = P
	    Call Range_Combine (P, R)
	  Else If
     $      (
     $       (R .ne. 0) 
     $      .and.
     $       ((Range(R).Start-1) .eq. A)
     $      ) Then
	    Range(R).Start = Range(R).Start - 1
	    Range_Find = R
	    Call Range_Combine (P, R)
	  Else
	    RR = Range_Allocate ()
	    Range_Find = RR
	    Range(RR).Start = A
	    Range(RR).End   = A
	    Range(RR).Next  = R
	    If (P .eq. 0) Then
	      Group(G).Range_First = Range_Find
	      Group(G).Range_Last  = Range_Find
	    Else
	      Range(P).Next = Range_Find
	    EndIf
	  EndIf

	  U = U - 1
	  If (U .lt. 0) Then
	    U = 0
	  EndIf

	EndIf

	End ! Range_Find


	Subroutine Range_Combine (P, R)

	Include 'News.Def'

C Parameter definitions

	Integer   *4		P
	Integer   *4		R

C Begin Range_Combine

	If ((P .ne. 0) .and. (R .ne. 0)) Then

C Are range entries ajacent?

	  If ((Range(P).End + 1) .eq. Range(R).Start) Then

C Mark entry P with entire range

	    Range(P).End  = Range(R).End

C Remove entry R from the chain

	    Range(P).Next = Range(R).Next

C Release entry R

	    Range(R).Next = 0
	    Call Range_Deallocate (R)

	  EndIf
	EndIf

	End ! Range_Combine


	Integer Function Srv_Connect

	Include 'News.Def'

C Description
C
C   Connects to the Remote News server.  
C
C   Returns success or failure.
C   

C Local Variables

	Integer     *4          I
        Integer     *4          Lg
	Record /Socket_IN_Def/  Server_Socket
	Integer	    *4		Status
	Integer     *4		IP_Address
	Equivalence		(IP_Address, Server_IP_Number)

C Empty Recv buffer

	Recv_BufS = 2
	Recv_BufE = 1

C Open a channel to INET0:

	Channel = Socket
     $    (
     $     %Val(AF_INet),
     $     %Val(Sock_Stream),
     $     %Val(0)
     $    )

	If (Channel .eq. -1) Then
	  Srv_Connect = 2
	  Return
	EndIf

C Connect to remote machine

	Server_Socket.SIN_Family  = AF_INet
	Server_Socket.SIN_Port    = HtoNS (%Val(119))
        Server_Socket.SIN_Address = IP_Address 	! '111e6880'X

	Do I = 1,8
	  Server_Socket.SIN_Fill(I) = 0
	EndDo

	Status = Connect 
     $    (
     $     %Val(Channel),
     $     Server_Socket,
     $     %Val(16)
     $    )

	If (Status .ne. 0) Then
	  Srv_Connect = 4
	  Return
	EndIf

C Return success

	Srv_Connect = 1

	Return

	End ! Srv_Connect


	Integer Function Srv_NetClose()

	Include 'News.Def'

C Description
C
C   Close Connection to the Remote News server.  
C
C   Returns success or failure.
C   

C External routines

	Integer  	NetClose

C Local variables

	Integer   *4	Status

C Begin Srv_NetClose

C Disconnect from remote machine

	Status = NetClose (%Val(Channel))

	If (Status .ne. 0) Then
	  Srv_NetClose = 4
	  Return
	EndIf

C Return success

	Srv_NetClose = 1

	Return

	End ! Srv_NetClose



	Integer Function Srv_Recv (Buf, Lg)

	Include 'News.Def'

C Description
C
C   Read data form server to Buf.
C
C   Returns success or failure.

C Parameter Definitions

	Character *(*)		Buf
	Integer   *4		Lg

C Local definitions

	Integer	  *4		Buf_Lg
	Character *2		CRLF
	Logical 		CR
	Logical			Done
	Integer   *4		I
	Integer   *4		III
	Integer   *4		N
	Integer   *4		NN
	Integer	  *4		Recv_Buf_Addr
	Integer   *4		Recv_Buf_Lg
	Logical			Skip

C Begin Srv_Recv

	Buf_Lg = Len(Buf)

	CRLF(1:1) = Char(13)
	CRLF(2:2) = Char(10)

	Lg = 0			! No bytes xferred so far

	Done = .false.
	CR = .false.

       Do While (.not. Done)

C If there is no data in the receive buffer, get some

	If (Recv_BufS .gt. Recv_BufE) Then

	  Recv_Buf_Addr = %Loc(Recv_Buf)
	  Recv_Buf_Lg   = Len(Recv_Buf)

	  I = Recv 
     $      (
     $       %Val(Channel),
     $       %Val(Recv_Buf_Addr),
     $       %Val(Recv_Buf_Lg),
     $       %Val(0)
     $      )

	  If (I .eq. -1) Then
	    Srv_Recv = 0
	  Else
	    Srv_Recv = 1
	    If (Debug) Then
	      Print '(8(x,o3.3))', (IChar(Recv_Buf(III:III)),III=1,I)
	    EndIf
	  EndIf
	
	  Recv_BufS = 1
	  Recv_BufE = I

	EndIf

C Now we have some data

C If we last saw a carriage return and the next character is a LF
C then we have found the end of the image and we are done

	If (CR .and. (Recv_Buf(Recv_BufS:Recv_BufS) .eq. CRLF(2:2))) Then

	  Done = .true.
	  Recv_BufS = Recv_BufS + 1

	Else

C No terminator, look for the next hunk to transfer.

	  CR = .false.
	  I = Index (Recv_Buf(Recv_BufS:Recv_BufE), CRLF(1:1))

	  If (I .eq. 0) Then
	    N = Recv_BufE - Recv_BufS + 1
	    Skip = 0
	  Else 
	    N = I - 1
	    Skip = 1
	    CR = .true.
	  EndIf

C Anything to tranfer?

	  If (N .gt. 0) Then

	    NN = Buf_Lg - Lg
	    If (NN .gt. N) Then
	      NN = N
	    EndIf
	    If (NN .gt. 0) Then
	      Buf(Lg+1:Lg+NN) = Recv_Buf(Recv_BufS:Recv_BufS+NN-1)
	      Lg = Lg + NN
	    EndIf

	  EndIf

	  Recv_BufS = Recv_BufS + N + Skip

	EndIf

       EndDo

	If (Lg .le. 0) Then
	  Lg = 1
	  Buf(1:1) = ' '
	EndIf

	Return

	End ! Srv_Recv


	Integer Function Srv_Send (Msg)

	Include 'News.Def'

C Description
C
C   Send data from Buffer to News Server
C
C   Returns success or failure.

C Parameter Definitions

	Character *(*)		Msg

C Local definitions

	Character *512		Buf
	Integer	  *4		Buf_Addr
	Integer   *4		Buf_Lg
	Integer   *4		CC
  
C Begin Srv_Send

	Buf_Lg   = Len(Msg)
	Buf      = Msg(1:Buf_Lg) // Char(13) // Char(10)
	Buf_Addr = %Loc(Buf)
	Buf_Lg   = Buf_Lg+2

	CC = Send
     $    (
     $     %Val(Channel),
     $     %Val(Buf_Addr),
     $     %Val(Buf_Lg),
     $     %Val(0)
     $    )

	If (CC .eq. -1) Then
	  Srv_Send = 0
	Else
	  Srv_Send = 1
	EndIf

	Return

	End ! Srv_Send


	Integer Function Srv_Cmd (Cmd, Rsp, Lg)

	Include 'News.Def'

C Description
C
C   Send Cmd to the news server and retrieve its response in Rsp
C
C   Returns
C
C     Srv_Cmd	Success or failure
C     Rsp 	Response text from server
C     Lg	Length of Rsp text

C Parameter definitions
	
	Character *(*)		Cmd
	Character *(*)		Rsp
	Integer	  *4		Lg

C External Routines

	Integer			Srv_Send
	Integer			Srv_Recv

C Begin Srv_Cmd

	Srv_Cmd = Srv_Send (Cmd)
	If (.not. Srv_Cmd) Then
	  Return
	EndIf

	Srv_Cmd = Srv_Recv (Rsp, Lg)

C Return 

	Return

	End ! Srv_Cmd


	Integer Function Srv_RdTxt (P, Rot, Image_Routine)

	Include 'News.Def'

C Parameters

	Logical		P		! .true. means print
					! .false. means skip
	Logical		Rot		! .true. means rotate
	External	Image_Routine   ! Called for each image
	Integer		Image_Routine

C External Routines

	Integer		Srv_Recv
	Logical		SMG_More_Print

C Local definitions

	Character *512 	Buf
	Integer	  *4	Lg
        Logical	  	Ok

C Begin Srv_RdTxt

	Buf(1:1) = ' '

	Ok = P
	Do While (Buf(1:Lg) .ne. '.')
	  Srv_RdTxt = Srv_Recv (Buf, Lg)
	  If (.not. Srv_RdTxt) Then
	    Return
	  EndIf
	  If (Buf(1:Lg) .ne. '.') Then
	    If (Ok) Then
	      If (Rot) Then
		Call Rotate (Buf(1:Lg))
	      EndIf
	      If
     $	        (
     $		 (%Loc(Image_Routine) .eq. 0)
     $          .or.
     $		 (Image_Routine(Buf(1:Lg)))
     $          )
     $	      Then
		If (Debug) Then
		  Call SMG_More_Print ('RdTxt image:', '|')
		EndIf
	        OK = SMG_More_Print (Buf(1:Lg), '|')
	      EndIf
	    EndIf
	  EndIf
	EndDo

C All done, return

	End ! Srv_RdTxt


	Subroutine Srv_CopyTxt (LU, Pre, Rotate_Flag)

	Include 'News.Def'

C Parameter definitions

	Integer   *4	LU
	Character *(*)	Pre
	Logical		Rotate_Flag

C External routines

	Integer		Srv_Recv

C Local definitions

	Character *1024	Buf
	Integer   *4    Buf_S, Buf_E	! Buf pointers
	Integer   *4    Lg
	Integer	  *4	MxLg		! Recl for LU_Save
	Integer	  *4    Pre_Lg
	Integer	  *4	X

C Begin Srv_CopyTxt

	If (Pre .eq. ' ') Then
	  Pre_Lg = 0
	Else
 	  Pre_Lg = Len (Pre)
	EndIf

	Inquire (Unit = LU, Recl = MxLg)
	MxLg = MxLg - 4

	Buf = ' '
	Lg = 1

	Do While ((Buf(1:Lg) .ne. '.') .and. (Srv_Recv(Buf,Lg)))

	  If (Lg .eq. 0) Then
	    Lg = 1
	    Buf(1:1) = ' '
	  EndIf

	  If (Buf(1:lg) .ne. '.') Then
	    If (Rotate_Flag) Then
	      Call Rotate (Buf(1:Lg))
%%end part c
Michael Dorl (608) 262-0466
dorl@vms.macc.wisc.edu
dorl@wiscmacc.bitnet
