From:	CSBVAX::MRGATE!info-vax-RELAY@KL.SRI.COM@SMTP  2-AUG-1988 01:34
To:	ARISIA::EVERHART
Subj:	uw nntp news reader part d


Received: from ucbvax.berkeley.edu by KL.SRI.COM with TCP; Fri, 29 Jul 88 00:34:56 PDT
Received: by ucbvax.berkeley.edu (5.59/1.28)
	id AA10657; Thu, 28 Jul 88 15:10:15 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:26:12 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 d
Message-Id: <521@dogie.edu>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com


	EndDo

	End ! Srv_CopyTxt


	Integer Function GetInteger (Buf, X, Lg)

	Implicit None

C Parameter definitions

	Character *(*)		Buf
	Integer   *4		X
	Integer   *4		Lg

C Begin GetInteger

	GetInteger = 0

C Skip leading blanks

	Do While ((X .le. Lg) .and. (Buf(X:X) .eq. ' '))
	  X = X + 1
	End Do

C Accumulate field

	Do While
     $    (
     $     (X .le. Lg) 
     $    .and.
     $     ((Buf(X:X) .ge. '0') .and. (Buf(X:X) .le. '9'))
     $    )
          GetInteger = 10 * GetInteger + IChar(Buf(X:X)) - IChar('0')
	  X = X + 1
	EndDo

	Return

	End ! GetInteger


	Subroutine GetField (Rsl, Src, Src_X, Src_Lg)

	Implicit None

C Parameter definitions

	Character *(*)		Rsl		! Result
	Character *(*)		Src		! Source of data
	Integer   *4		Src_X		! Source index
	Integer   *4		Src_Lg		! Source length

C Local variables

	Integer Rsl_X
	Integer Rsl_Lg

C Begin GetField

	Rsl    = ' '
	Rsl_X  = 1
	Rsl_Lg = Len(Rsl)

C Skip leading blanks

	Do While 
     $    ((Src_X .le. Src_Lg) .and. (Src(Src_X:Src_X) .eq. ' '))
	  Src_X = Src_X + 1
	EndDo

C Accumulate field

	Do While 
     $    ((Src_X .le. Src_Lg) .and. (Src(Src_X:Src_X) .ne. ' '))
	  If (Rsl_X .le. Rsl_Lg) Then
	    Rsl(Rsl_X:Rsl_X) = Src(Src_X:Src_X)
	    Rsl_X = Rsl_X + 1
	  EndIf
	  Src_X = Src_X + 1
	EndDo

	Return

	End ! GetField


	Integer Function TrimLg (S)

	Implicit None

	Character *(*)	S

	TrimLg = Len(S)

	Do While ((TrimLg .gt. 1) .and. (S(TrimLg:TrimLg) .eq. ' '))
	  TrimLg = TrimLg - 1
	End Do

	End


	Subroutine ItoS (I,S,L)

C Description
C
C   Converts integer I to a left justified space filled string S.
C   Number of non blank charcaters returned in L

	Implicit None

C Parameter definitions

	Integer   *4	I
	Character *(*)	S
	Integer   *4	L

C Local Definitions

	Character *8	B
	Integer   *4	N

C Begin ItoS

	Write (B, '(I8)') I

	S = ' '
	L = 0

	Do N = 1,8
	  If (B(N:N) .ne. ' ') Then
	    If (L .lt. Len(S)) Then
	      L = L + 1
	      S(L:L) = B(N:N)
	    EndIf
	  EndIf
	EndDo

	End ! ItoS


	Subroutine Get_Mail_Control 

	Include 'News.Def'

C External routines

	External	User_Open
	Integer		TrimLg

C Define the structure of the entries in the Sys$System:VMSMail.Dat file.

        Structure /VMDDef/
          Union
            Map
              Character  *512        All
	    EndMap
	    Map
	      Character  *31         UserName        ! User Id
	      Integer    *2          Flags           ! Flags = self copy, edit, etc.
	      Integer    *2          Mail            ! New mail count
	      Integer    *4          Spare(7)             
	      Byte                   Spare1(2)
	      Byte                   DirLng          ! Directory length
	      Byte                   FNmLng          ! Full user name
	      Byte                   FwdLng          ! Forward name length
	      Character  *444        CMiscData       ! Space for directory name,
                          	                     ! Full user name, and
                                	             ! Forward name
	    EndMap
	  EndUnion
	  Integer      *4          Lg                ! Length of VMD record
	  Integer      *4          DirX              ! Directory index
	  Integer      *4          FNmX              ! Full name index
	  Integer      *4          FwdX              ! Forward index
	End Structure ! VMDDef

C Length of fixed portion of VMS record

	Parameter VMD_FxLng           = 68

C values for VMD Flags

	Parameter VMD_Flags_SendSelf  = 1
	Parameter VMD_Flags_ReplySelf = 2
	Parameter VMD_Flags_NoPurge   = 4

C Local definitions

	Integer   *4		Lg
	Integer   *4		Status
	Record    /VMDDef/	Vmd
	Integer   *4		X

C Begin Read_Mail_Control

	Call UpPriv
	Call User_Open_Init  ('STATUS_OLD',0,0,0,0,0,0,0,0)
	Call User_Open_Param ('EXEC_LOG',0,0,0,0,0,0,0,0,0)
	Open
     $    (
     $     Unit		= LU_VMSMail,
     $	   File		= 'Sys$System:VMSMail.Dat',
     $     Form		= 'Formatted',
     $     Status	= 'Old',
     $	   Access	= 'Keyed',
     $     Shared,
     $     UserOpen	= User_Open,
     $     IOStat	= Status
     $    )
	Call DownPriv

	UserPersonalName = ' '
	UserMailDirectory = ' '	  

	If (Status .ne. 0) Then
	  Return
	EndIf

	VMD.UserName = UserName
	Call STR$UpCase (VMD.UserName, VMD.UserName)
	Read
     $    (
     $     Unit 	= LU_VMSMail,
     $     KeyId        = 0,
     $	   KeyEq 	= VMD.UserName,
     $     IOStat	= Status,
     $     Fmt 		= '(Q,A)'
     $    )
     $    VMD.Lg, VMD.All

	If (Status .eq. 0) Then

	  Unlock (LU_VMSMail)
	
	  X = 1
	  If (VMD.FwdLng .ne. 0) Then
	    VMD.FwdX = X
	  Else
	    VMD.FwdX = 0
	  EndIf

	  X = X + VMD.FwdLng
	  If (VMD.FnmLng .ne. 0) Then
	    VMD.FnmX = X
	    UserPersonalName = 
     $        VMD.CMiscData(VMD.FnmX:VMD.FnmX+VMD.FnmLng-1)
	  Else
	    VMD.FnmX = 0
	  EndIf

	  X = X + VMD.FnmLng
	  If (VMD.DirLng .ne. 0) Then
	    VMD.DirX = X
	    Lg = TrimLg (UserDirectory) - 6
	    UserMailDirectory = UserDirectory(1:Lg) //
     $        VMD.CMiscData(VMD.DirX+1:VMD.DirX+VMD.DirLng-1)
	  Else
	    UserMailDirectory = 'Sys$Login:'
	    VMD.DirX = 0
	  EndIf

	EndIf

	Close (LU_VMSMail)

	End ! Read_Mail_Control


       Integer Function TransLog (In, Out, Table)

       Implicit None

       Include '($PSLDef)'
       Include '($LNMDef)'

C Parameter definitions

       Character *(*) In		! name to be translated
       Character *(*) Out		! resulting translated name
       Integer   *4   Table		! table 0 = User 'LNM$FILE_DEV'
					!       1 = Exec 'LNM$SYSTEM_TABLE'

C Local definitions

       Structure /ItmDef/
         Integer *2 Length
         Integer *2 Code
         Integer *4 Address
         Integer *4 ReturnLength
       End Structure ! /ItmDef/

       Integer *4       AcMode
       Integer *4       Attr
       Integer *4       InLg
       Record /ItmDef/  ItmList(2)
       Character *32    LogNameTable
       Integer *4       LogNameTableLg
       Integer *4       ResultLg

       Integer TrimLg, Sys$TrnLnm


C Begin

       Attr = LNM$M_Case_Blind
	
       If (Table .eq. 0) Then
	 LogNameTable = 'LNM$FILE_DEV'
         AcMode = PSL$C_User
       Else If (Table .eq. 1) Then
         LogNameTable = 'LNM$SYSTEM_TABLE'
         AcMode = PSL$C_Exec
       Else
	 Call Lib$Stop (%Val(0))
       EndIf

       LogNameTableLg = TrimLg (LogNameTable)
       ItmList(1).Code = LNM$_String
       ItmList(1).Length = Len(Out)
       ItmList(1).Address = %Loc (Out)
       ItmList(1).ReturnLength = %Loc(ResultLg)
       ItmList(2).Code = 0
       ItmList(2).Length = 0
       Out = ' '
       InLg = TrimLg (In)

       TransLog = Sys$TrnLnm (Attr,
     $                        LogNameTable(1:LogNameTableLg),
     $                        In(1:InLg),
     $                        AcMode,
     $                        ItmList
     $                       )

       End ! TransLog


	Integer Function User_Edit (InFile, OutFile)

	Implicit  None

	Include 'SMG.Def'

C Parameter Definition

	Character *(*) InFile, OutFile

C External Routines

        External Lib$Spawn
        Integer  Lib$Spawn
	External SMG$Disable_Broadcast_Trapping
	Integer  SMG$Disable_Broadcast_Trapping
	External SMG$Set_Broadcast_Trapping
	Integer  SMG$Set_Broadcast_Trapping
	External SMG_Broadcast_AST
	External TrimLg
	Integer  TrimLg

C Local Definitions

	Character *128 Cmd
	Integer		Status

C Begin User_Edit

	If (InFile .eq. ' ') Then
	  Cmd = '@MAIL$EDIT "" ' // OutFile
	Else
	  Cmd = '@MAIL$EDIT '  		 //
     $	        Infile(1:TrimLg(InFile)) // 
     $          ' ' 			 //
     $		OutFile
	EndIf

	Status = SMG$Disable_Broadcast_Trapping (SMG_PBId)

	User_Edit = Lib$Spawn
     $    (
     $	   Cmd,				! Command String
     $      ,				! Input File
     $      ,				! Output File
     $      ,				! Flags
     $      ,				! Process Name
     $      ,				! Process Id
     $      ,				! Completion Status
     $      ,				! Completion EFN
     $      ,				! Completion ASTAdr
     $      ,				! Completion ASTArg
     $      ,				! Prompt
     $     				! CLI
     $    )

	Status = SMG$Set_Broadcast_Trapping 
     $    (
     $     SMG_PBId,			! Pasteboard-Id
     $     SMG_Broadcast_AST,		! AST-Routine
     $     				! AST-Argument
     $    )

	If (.not. Status) Then
	  Call Lib$Stop (%Val(Status))
	EndIf

	End ! User_Edit


	Subroutine CacheHdr (G, Article, Subject, Subject_Lg)

	Include 'News.Def'

C Parameter definition

	Integer   *4	G
	Integer   *4 	Article
	Character *(*)	Subject
	Integer   *4    Subject_Lg

C External routines

	Integer		TrimLg

C Local definitions

	Integer   *4	NCache
	Character *128	Cache_Subject (500)
	Integer   *4    Cache_Article (500)
	Integer   *4	I

C 	Begin CacheHdr

C Is the requested information in the cache?

	If (NCache .gt. 0) Then
	  Do I = 1, NCache
	    If (Cache_Article(I) .eq. Article) Then
	      Subject = Cache_Subject(I)
	      Subject_Lg = TrimLg(Subject)
c	      Call SMG_All_Print ('hdr cache hit', '|')
	      Return
	    EndIf
	  EndDo
	EndIf

C Requested information not cached, we have to read it.

	Call XHdr (Article, 'subject', Subject, Subject_Lg)
	If (NCache .lt. 500) Then
	  NCache = NCache + 1
	  I = NCache
	Else
	  I = 1
	EndIf

C	Call SMG_All_Print ('Hdr cache no hit', '|')
	Cache_Subject(I) = Subject(1:Subject_Lg)
	Cache_Article(I) = Article
	     

	Return

C	Begin CacheHdr_Init

	Entry CacheHdr_Init (G)

	NCache = 0
C	Call SMG_All_Print ('Hdr cache init', '|')

	Return

	End ! CacheHdr
******** news_cld_install.com ********
$ Set command/Table=sys$common:[syslib]dcltables -
             /Output=sys$common:[syslib]dcltables -
    NewsDir:News.CLD
$ Dir/Date sys$common:[syslib]dcltables.exe
$ mcr install
sys$common:[syslib]dcltables.exe/replace
sys$common:[syslib]dcltables.exe/full
$
******** smg.def ********
C Define string descriptor, mainly used in places that need a
C zero length string

        Structure /String_Def/
	  Integer *2 Length
	  Byte	   DType
	  Byte	   Class
	  Integer *4 Address
        End Structure ! String_Def

C Screen management and terminal control information

        Integer *4           SMGKeyDefId       ! Define Key table id
        Integer *4           SMGKeyBdId        ! Virtual keyboard id
        Integer *4           SMG_PBId          ! Pasteboard Id
        Integer *4           SMG_PBCols        ! Pasteboard columns
        Integer *4           SMG_PBRows        ! Pastaboard rows
	Logical              SMG_Video	       ! .true. if video terminal
	Logical		     SMG_Term	       ! .true. if interactive terminal
	Integer *4	     SMG_Line	       ! Screen line number

        Character *132       PrintLine         ! Work area for building print
                                               ! lines
C More information

        Character *132       More_Input        ! More response
        Character *132       More_Hdg_One      ! Heading line 1
        Character *132       More_Hdg_Two      ! Heading line 2

C Control C definition

	Integer   *4	     TT_Chan
	Integer	  *4	     Control_C

C Common definition

	Common /SMG/ 
     $
     $  SMGKeyDefId,         SMGKeyBdId,            SMG_PBId,
     $  SMG_PBRows,          SMG_PBCols,            SMG_Video,
     $  SMG_Term,	     SMG_Line,
     $
     $  PrintLine,
     $
     $  More_Input,          More_Hdg_One,          More_Hdg_Two,
     $
     $  Control_C,	     TT_Chan
******** smg_routines.for ********
       Subroutine SMG_Initialize

       Implicit None

       Include 'SMG.Def'
       Include '($RMSDef)'
       Include '($SMGDef)/list'

C External definitions

       Integer  SMG$Create_Key_Table
       Integer  SMG$Create_PasteBoard
       Integer  SMG$Create_Virtual_Keyboard
       Integer  SMG$Define_Key
       Integer  SMG$Get_PasteBoard_Attributes
       Integer  SMG$Load_Key_Defs
       Integer  SMG$Set_Broadcast_Trapping

       External SMG_Broadcast_Ast
       External SMG$S_Pasteboard_Info_Block
       External DC$_Term

C Local Definitions

       Integer *4 Status

       Record /SMGDef/ PB_Info

C Begin SMG_Initialize 

       Status = SMG$Create_PasteBoard
     $   (SMG_PBId,,SMG_PBRows,SMG_PBCols,0)
       If (.not. Status) Then
	 Call Lib$Stop(%Val(Status))
       EndIf

       If (SMG_PBCols .eq. 0) Then
	 SMG_PBCols = 132
       EndIf

       Status = SMG$Get_PasteBoard_Attributes
     $   (SMG_PBId,PB_Info,%Loc(SMG$S_PasteBoard_Info_Block))
       If (Status) Then
	 If (PB_Info.SMG$B_DevClass .eq. %Loc(DC$_Term)) Then
	   SMG_Term = .true.
	 Else
	   SMG_Term = .false.
	 EndIf
	 If ((PB_Info.SMG$B_DevClass .ne. %Loc(DC$_Term))      .or.
     $	     (PB_Info.SMG$B_SMG_DevType .eq. SMG$K_Unknown)  .or.
     $	     (PB_Info.SMG$B_SMG_DevType .eq. SMG$K_HardCopy)
     $      ) Then
	   SMG_Video = .false.
	 Else
	   SMG_Video = .true.
	 EndIf
       Else
         Call Lib$Stop(%Val(Status))
       EndIf

       Status = SMG$Create_Key_Table (SMGKeyDefId)

       If (SMG_Term) Then

       Status = SMG$Set_Broadcast_Trapping
     $   (SMG_PBId,		! Pasteboard-Id
     $    SMG_Broadcast_AST,	! AST-Routine
     $    			! AST-Argument
     $   )
       If (.not. Status) Call Lib$Stop(%Val(Status))

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key PF1 ""/Echo/Set_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key PF2 "Help"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key PF2 "Dir/Folder"/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key PF3 "Extract/Mail"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key PF3 "Extract"/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key PF4 "Erase"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key PF4 "Select Mail"/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP0 "Next"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP0 "Next/Edit"/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP1 "Back"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP1 "Back/Edit"/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP2 "Print"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP2 "Print/Print/Notify"' //
     $     '/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP3 "Dir"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP3 "Dir/Start=999999"' //
     $     '/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP4 "Current"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP4 "Current/Edit"/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP5 "First"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP5 "First/Edit"/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP6 "Last"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP6 "Last/Edit"/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP7 "Send"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP7 "Send/Edit"/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP8 "Reply"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP8 "Reply/Edit/Extract"' //
     $     '/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP9 "Forward"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key KP9 "Forward/Edit"/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key Enter "Select "/Echo/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key Minus "Read/New"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key Minus "Show New"/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key Comma "Dir/New"/Echo/Terminate')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key Comma "Dir Mail"/Echo/Terminate/If_State=Gold')

       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key Period "File "/Echo')
       Status = SMG$Define_Key (SMGKeyDefId,
     $  'Define/Key Period "Delete "/Echo/If_State=Gold')

       Status = SMG$Load_Key_Defs
     $   (
     $    SMGKeyDefId,		! Table
     $    'MAIL$INIT',		! File
     $    'MAIL$INIT',		! Default file (so '.' is not used)
     $    1			! File spec is logical name
     $   )

       If (.not. Status) Then
         If (Status .ne. RMS$_FNF) Then
           Call Lib$Signal (%Val(Status))
         EndIf
       EndIf

       Call CLI$DCL_Parse	! Restore the parse state of the command
				! that originally invoked the image.
				! Load_Key_Def destroys the state and restores
				! it if no error occurs; it does not restore
				! it if an error does occur.

       EndIf ! (SMG_Term)

       Status = SMG$Create_Virtual_KeyBoard (SMGKeyBdId)

       End ! SMG_Initialize

	Subroutine SMG_Broadcast_AST

	Implicit None

	Include 'SMG.Def'

C Description

C   	AST Routine established by SMG_Initialize to trap and handle
C	broadcast messages.

C External Routines and Symbols

	External SMG$_No_MorMsg
	Integer  SMG$_No_MorMsg
        External SMG$Get_Broadcast_Message
	Integer  SMG$Get_Broadcast_Message
	External SMG$Cancel_Input
	Integer  SMG$Cancel_Input
	External TrimLg
	Integer  TrimLg

C Local definitions

	Integer 		Status
	Character *132 		Msg
	Integer 		I

C Begin SMG_Broadcast_AST

	Status = SMG$Cancel_Input (SMGKeyBdId)

	Status = 1
	Do While ((Status) .and. (Status .ne. %Loc(SMG$_No_MorMsg)))
	  Status = SMG$Get_Broadcast_Message (SMG_PBId, Msg)
	  If ((Status) .and. (Status .ne. %Loc(SMG$_No_MorMsg))) Then
	    Call SMG_Print (' ')
	    Call SMG_Print (Msg)
	  EndIf
	EndDo
          
	End ! SMG_Broadcast_AST


	Subroutine SMG_Print_X (Buffer)

	Implicit None

	Include 'SMG.Def'
	Include '($IODef)'

C Parameter definitions

	Character *(*) Buffer

C External routines

	Integer		Sys$QIOW

C Local definitions

	Integer   *4	CC
	Integer   *4	L
	Integer   *4	IOSB(2)
	Integer   *4	Status

C Begin SMG_Print_X

	L = Len(Buffer)
	If (L .gt. SMG_PBCols) Then		! SMG_PBCols seems to be
	  L = SMG_PBCols			!  defined even if 
	EndIf					!   SMG_Video is .false.

	If (.not. SMG_Term) Then

	  Print '(x,A)', Buffer(1:L)

	Else

	  CC = '01000000'x

	  Status = Sys$QIOW
     $      (
     $       ,					! efn
     $	     %Val(TT_Chan),			! channel
     $	     %Val(IO$_WriteVBlk),		! function
     $       IOSB,				! IO status block
     $       ,					! astadr
     $	     ,					! astprm
     $       %Val(%Loc(Buffer)),		! p1 = buffer address
     $	     %Val(L),				! p2 = character count
     $	     ,					! p3
     $       %Val(CC),				! p4 = carriage control
     $	     ,					! p5
     $ 						! p6
     $      )

	EndIf

	SMG_Line = SMG_Line + 1

	End ! SMG_Print_X


	Integer Function SMG_More_Print (Text, Continuation)

	Implicit None

	Include 'SMG.Def'

C Description SMG_More_Print
C
C   Breaks Text down into CR/LF separated pieces of maximum size 
C   SMG_PBCols.  Calls more for each one.  Second and subsequent 
C   pieces are prefaced by Continuation.
C
C   Returns More status.
C

C Description SMG_Print
C
C   Same as above but More is not called.
C

	Integer	SMG_Print

C Parameter Definitions

	Character	*(*) 		Text
	Character 	*(*)		Continuation

C External Routines

	External 	More
	Integer		More
	External	TrimLg
	Integer		TrimLg

C Local Variables

	Integer		S	! Start of hunk in Text
	Integer		E	! End of hunk in Text
        Integer		L	! Length of Text
        Integer		LC	! Length of Continuation
	Integer		X	! Length of extra stuff for current hunk
	Integer		FF	! Location of form feeds
	Character       *512	Buffer
	Character       *2	CRLF
	Integer		CR
	Integer		NE
	Logical		More_Flag

C Begin SMG_More_Print

	LC = Len(Continuation)
        More_Flag = .true.
	Goto 1

C Begin SMG_Print

	Entry SMG_Print (Text)

	LC = 0
	More_Flag = .false.

C Begin common SMG_More_Print - SMG_Print 

1	CRLF(1:1) = Char (13)	! <CR>
	CRLF(2:2) = Char (10)	! <LF>

	Call Expand_Tabs (Text, Buffer)
	L = TrimLg (Buffer)

C Replace any form feed characters with blanks

	FF = Index (Buffer,Char(12))
	Do While (FF .ne. 0)
	  Buffer(FF:FF) = ' '
	  SMG_Line = 999
	  FF = Index (Buffer,Char(12))
	End Do

	S  = 1
	L  = TrimLg(Buffer)
	X  = 0
	SMG_More_Print = .true.

	Do While (S .le. L)

C Attempt to print whatever is left

	  E = L
	  NE = E + 1

C But limit to SMG_PBCols

	  If ((E-S+1+X) .gt. SMG_PBCols) Then
	    E = S + SMG_PBCols - X - 1 
	    NE = E + 1
	  EndIf

C But also take into account CR LF separated hunks

	  CR = Index (Buffer(S:L), CRLF)
          If (CR .ne. 0) Then
	    CR = S + CR - 1
	    If (CR .eq. S) Then
	      E = S
	      NE = S + 2
	      Buffer (CR:CR+1) = '  '
	    Else If (CR .le. (E+1)) Then
	      E = CR - 1
	      NE = CR + 2
	    Else
	      ! Don't care, this CR/LF outside of hunk
	    EndIf
	  EndIf

C Call more to see if this hunk fits on screen

	  If (More_Flag) Then
	    SMG_More_Print = More ()
	    If (.not. SMG_More_Print) Then
	      Return
	    EndIf
	  Else
	    SMG_More_Print = 1
	  EndIf

C Now, print this hunk

	  If (X .eq. 0) Then	  
	    Call SMG_Print_X (Buffer(S:E))
	  Else
	    Call SMG_Print_X (Continuation // Buffer(S:E))
	  End If

C New start is end of last line ignoring any trailing CR/LF

	  S = NE

C Length of extra stuff now includes continuation characters

	  X = LC

	End Do

	Return

	End ! SMG_More_Print

	Subroutine SMG_All_Print (Text, Continuation)

	Implicit None

	Include 'SMG.Def'

C Description
C
C   Breaks Text down into SMG_PBCols sized pieces and prints same.

C Parameter Definitions

	Character	*(*) 		Text
	Character 	*(*)		Continuation

C External Routines

	External	TrimLg
	Integer		TrimLg

C Local Variables

	Integer		S	! Start of hunk in Text
	Integer		E	! End of hunk in Text
        Integer		L	! Length of Text
        Integer		LC	! Length of Continuation
	Integer		X	! Length of extrac stuff for current hunk

C Begin SMG_More_Print

	S  = 1
	L  = TrimLg(Text)
	LC = Len(Continuation)
	X  = 0

	Do While (S .le. L)

	  E = L
	  If (SMG_Video) Then
	    If ((E-S+1+X) .gt. SMG_PBCols) Then
	      E = S + SMG_PBCols - X - 1 
	    EndIf
	  EndIf

	  If (X .eq. 0) Then	  
	    Call SMG_Print (Text(S:E))
	  Else
	    Call SMG_Print (Continuation // Text(S:E))
	  End If

	  S = E + 1
	  X = LC

	End Do

	End ! SMG_All_Print

	Subroutine SMG_Erase

	Implicit None

	Include 'SMG.Def'

C Description:
C
C   Erase the display if appropriate
C

C External Definitions:

	External SMG$Erase_Pasteboard
	Integer  SMG$Erase_Pasteboard

C Local Definitions

	Integer Status

C Begin SMG_Erase

	If (SMG_Video) Then
	  Status = SMG$Erase_Pasteboard (SMG_PBId)
	  If (.not. Status) Then
	    Call Lib$Stop (%Val(Status))
	  End If
	End If

	SMG_Line = 1

	End ! SMG_Erase


	Integer Function More

	Implicit None

        Include 'SMG.Def'

C External Definitions

        External SMG_Prompt
        Integer  SMG_Prompt

C Local Definitions

        Integer        Status

C Begin More

        If (Control_C) Then
          More = 0
          Return
        EndIf

        More = 1
	If (.not. SMG_Video) Then
	  Return
	EndIf

	If (SMG_Line .ge. (SMG_PBRows-4)) Then
	  SMG_Line = 0
	  Call SMG_Print_X (' ')
	  Call SMG_Print_X ('Press RETURN for more...')
	  Call SMG_Print_X (' ')
          Status = SMG_Prompt
     $      (More_Input, '> ', )
          If ((More_Input .ne. ' ') .or. (.not. Status)) Then
            More = 0
          Else
	    Call More_Heading
  	  EndIf
        EndIf
	Return

	End ! More


        Subroutine More_Heading

	Implicit None

	Include 'SMG.Def'

C Begin More_Heading

        Call SMG_Erase
        If (More_Hdg_One .ne. '@') Then
          Call SMG_Print_X (More_Hdg_One)
        EndIf
	If (More_Hdg_Two .ne. '@') Then
          Call SMG_Print_X (More_Hdg_Two)
	EndIf
	Call SMG_Print_X (' ')

	End ! More_Heading


	Subroutine Expand_Tabs (In, Out)
	
	Implicit None

C Parameter Definitions

	Character *(*) In, Out

C Local Definitions

	Integer X_In, L_In, T_In, X_Out, L_Out, E_Out, L, T
	Integer HT
	Parameter (HT=9)

C Begin Expand_Tabs

	X_In = 1
	L_In = Len(In)

	X_Out = 1
	L_Out = Len(Out)

	Do While (X_In .le. L_In)

C Find the next tab

	  T_In = Index (In(X_In:L_In), Char(HT))

	  If (T_In .ne. 0) Then

	    T_In = T_In + X_In - 1

C Tab, found move text before tab (if any) to output

	    L = T_In - X_In
	    If (L .gt. 0) Then
	      If (X_Out .le. L_Out) Then
	        E_Out = X_Out + L - 1
	        If (E_Out .gt. L_Out) Then
	          E_Out = L_Out
	        End If
	        Out(X_Out:E_Out) = In(X_In:X_In+L-1)
	        X_Out = X_Out + L
	      End If
	    End If

C Now advance to the next tab stop if not already there

	    T = 8 * ((X_Out-1)/8 + 1) + 1
	    L = T - X_Out
	    If (L .gt. 0) Then
	      If (X_Out .le. L_Out) Then
	        E_Out = X_Out + L - 1
	        If (E_Out .gt. L_Out) Then
	          E_Out = L_Out
	        End If
	        Out(X_Out:E_Out) = ' '
	        X_Out = X_Out + L
	      End If
	    End If

	    X_In = T_In + 1

	  Else

C No tab found, copy remaider of text to output

	    L = L_In - X_In + 1
	    If (L .gt. 0) Then
	      If (X_Out .le. L_Out) Then
	        E_Out = X_Out + L - 1
	        If (E_Out .gt. L_Out) Then
	          E_Out = L_Out
	        End If
	        Out(X_Out:E_Out) = In(X_In:L_In)
	        X_In = X_In + L
	        X_Out = X_Out + L
	      End If
	    End If

	  End If
	End Do

C Blank fill rest of output

	If (X_Out .le. L_Out) Then
	  Out(X_Out:L_Out) = ' '
	End If

	Return

	End ! Expand_Tabs


       Integer Function SMG_Prompt 
     $   (Get_String, Prompt_String, Get_Length)

       Implicit None

       Include  'SMG.Def'
       Include  '($SSDef)'

C Parameter Definitions

       Character	*(*)		Get_String
       Character	*(*)		Prompt_String
       Integer		*4		Get_Length

C External Definitions

       External SMG$Read_Composed_Line
       Integer  SMG$Read_Composed_Line
       External TrimLg
       Integer  TrimLg

C Local Definitions

       Record 		/String_Def/	Init_Desc, Prompt_Desc
       Character	*128		Init_String
       Integer		*4		Get_String_Length

C Begin SMG_Prompt

       Prompt_Desc.DType   = 14
       Prompt_Desc.Class   = 1
       Prompt_Desc.Address = %Loc(Prompt_String)
       If (Prompt_String .eq. ' ') Then
         Prompt_Desc.Length = 0
       Else
         Prompt_Desc.Length = Len(Prompt_String)
       EndIf

       Init_Desc.DType     = 14
       Init_Desc.Class     = 1
       Init_Desc.Address   = %Loc(Init_String)
       Init_Desc.Length    = 0

1      SMG_Prompt = SMG$Read_Composed_Line
     $   (
     $    SMGKeyBdId,		! Keyboard Id
     $    SMGKeyDefId,		! Key Table Id
     $    Get_String,		! Received text
     $    Prompt_Desc,		! Prompt text
     $    Get_String_Length,	! received text length
     $    ,			! display id
     $    ,			! function key flags
     $    Init_Desc		! ini string
     $   )

       SMG_Line = SMG_Line + 1

       If ((SMG_Prompt .eq. SS$_Abort)
     $      .or.
     $     (SMG_Prompt .eq. SS$_Cancel)
     $    ) Then
         Init_String = Get_String
	 Init_Desc.Length = Get_String_Length
	 Goto 1
       EndIf

       If (Control_C) Then
	 Call SMG_Print (' ')	 
       EndIf

       If (%Loc(Get_Length) .ne. 0) Then
         Get_Length = TrimLg(Get_String)
       EndIf

       End ! SMG_Prompt


       Subroutine Ctrl_C

       Implicit None

       Include 'SMG.Def'	
       Include '($SysSrvNam)'

C Local Definitions

       Integer *4       Status

C Begin Ctrl_C

       Status = Sys$Assign ('TT', TT_Chan,,)

       If (.not. Status) Then
         Call Lib$Stop (%Val(Status))
       EndIf
       Call CtrlC_Enable
       Control_C = 0

       Return

       End ! Ctrl_C



       Subroutine CtrlC_Routine

       Implicit None

       Include 'SMG.Def'

C Begin CtrlC_Routine

       Call CtrlC_Enable
       Control_C = 1
       Return

       End ! CtrlC_Routine



       Subroutine CtrlC_Enable

       Implicit None

       Include 'SMG.Def'

       Include '($SysSrvNam)'
       Include '($IODef)'

C External Definitions

       External CtrlC_Routine

C Local Definitions

       Integer *4 Status, Mode

C Begin CtrlC_Enable

       Mode = IO$_SetMode .or. IO$M_CtrlCAst

       Status = Sys$QIOW (,
     $                    %Val(TT_Chan),
     $                    %Val(Mode),
     $                    ,,,CtrlC_Routine,
     $                    ,%Val(3),,,
     $                   )

       If (.not. Status) Then

C Ignore bad status so we can run from batch

c         Call Lib$Stop (%Val(Status))

       EndIf

       Return

       End ! CtrlC_Enable
******** tnews.cld ********
Define Verb TNews
 Image     "Dsk$User1:[MaccNet.Dorl.XXNews]News"
 Qualifier Header      Value(List)
 Qualifier Mark	       Value(Type=$Rest_Of_Line)
******** up_dn_priv.for ********
       Subroutine UpPriv

       Implicit None

       Include '($PrvDef)'
       Include '($JPIDef)'

C External Definitions

       External Sys$SetPrv
       Integer  Sys$SetPrv
       External Sys$GetJpiW
       Integer  Sys$GetJpiW
       External Lib$ExtV
       Integer  Lib$ExtV

C Local Definitions

       Structure /ItmLstDef/
         Integer *2 Buffer_Lg
         Integer *2 Item_Code
	 Integer *4 Buffer_Addr
	 Integer *4 Return_Lg
       End Structure ! ItmLstDef

       Record /ItmLstDef/ ItemList(2)

       Integer *4 Status, Privs(2), OldPrivs(2), ClrPrivs(2), PID
       Logical PrivsAreUp

C Begin

       Privs(1) = 0
       Privs(2) = 0
       Call Lib$InsV (1, Prv$V_Bypass, 1, Privs)
       Call Lib$InsV (1, Prv$V_World,  1, Privs)
       Call Lib$InsV (1, Prv$V_Oper,   1, Privs)

       Status = Sys$SetPrv (%Val(1), Privs, %Val(0), OldPrivs)

       If (.not. Status) Then
	 Call Lib$Stop (Status)
       EndIf

       ClrPrivs(1) = IAnd(Privs(1),.not. OldPrivs(1))
       ClrPrivs(2) = IAnd(Privs(2),.not. OldPrivs(2))

       If ((ClrPrivs(1) .ne. 0) .or. (ClrPrivs(2) .ne. 0)) Then
         PrivsAreUp = .true.
       Else
         PrivsAreUp = .false.
       EndIf

       Return


       Entry DownPriv

       If (PrivsAreUp) Then
         Status = Sys$SetPrv (%Val(0), ClrPrivs, %Val(0),)
       EndIf

       PrivsAreUp = .False.

       Return


       Entry SetUpPriv

       ItemList(1).Item_Code = JPI$_ProcPriv
       ItemList(1).Buffer_Lg = 8
       ItemList(1).Buffer_Addr = %Loc(OldPrivs(1))
       ItemList(1).Return_Lg = 0

       ItemList(2).Item_Code = 0
       ItemList(2).Buffer_Lg = 0

       PID = 0

       Status = Sys$GetJpiW
     $          (,			! efn
     $           PID,			! pidaddr
     $           ,			! prcnam
     $		 ItemList(1),		! itmlist
     $		 ,			! iosb
     $           ,			! astadr
     $				        ! astprm
     $          )

       If (.not. Status) Then
         Call Lib$Stop (%Val(Status))
       EndIf

       OldPrivs(1) = .not. OldPrivs(1)	! Clear all privileges
       OldPrivs(2) = .not. OldPrivs(2)	! not in the process set.

       Status = Sys$SetPrv (%Val(0), OldPrivs(1), %Val(0),)

       If (.not. Status) Then
 	 Call Lib$Stop (%Val(Status))
       EndIf

%%end part d
Michael Dorl (608) 262-0466
dorl@vms.macc.wisc.edu
dorl@wiscmacc.bitnet
