C
C  BULLETIN9.FOR, Version 4/10/91
C  Purpose: Contains subroutines for the bulletin board utility program.
C  Environment: VAX/VMS
C  Usage: Invoked by the BULLETIN command.
C  Programmer: Mark R. London
C
C  Copyright (c) 1990
C  Property of Massachusetts Institute of Technology, Cambridge MA 02139.
C  This program cannot be copied or distributed in any form for non-MIT
C  use without specific written approval of MIT Plasma Fusion Center
C  Management.
C
	SUBROUTINE DELETE_NODE
C
C  SUBROUTINE DELETE_NODE
C
C  FUNCTION: Deletes files sent via ADD/NODES at remote hosts.
C
 
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLUSER.INC'
 
	INCLUDE 'BULLDIR.INC'
 
	COMMON /NODE_INFO/ NODES,LOCAL_NODE_FOUND,NODE_NUM,
     &				NODE_ERROR,POINT_NODE
	CHARACTER*32 NODES(10)
	LOGICAL LOCAL_NODE_FOUND,NODE_ERROR
 
    	CHARACTER INLINE*80
 
	CALL GET_NODE_INFO
 
 	IF (NODE_ERROR) GO TO 940
 
	IF (NODE_NUM.EQ.0.OR.LOCAL_NODE_FOUND) THEN
	   WRITE (6,'('' ERROR: Cannot specify local node.'')')
	   GO TO 999
	END IF
 
	IER = CLI$GET_VALUE('SUBJECT',DESCRIP)
 
	DO POINT_NODE=1,NODE_NUM	   	! Write out command to nodes
	   NLEN = TRIM(NODES(POINT_NODE))	! Length of node name
	   INLINE = 'DELETE/SUBJECT="'//DESCRIP(:TRIM(DESCRIP))
	   WRITE (POINT_NODE+9,'(A)',ERR=940) INLINE
	   READ (POINT_NODE+9,'(A)',ERR=940,END=940) INLINE
	   IF (INLINE.EQ.'END') THEN
	      WRITE (6,'('' Message successfully deleted from node '',A)')
     &				NODES(POINT_NODE)
	   ELSE
	      WRITE (6,'('' Error while deleting message to node '',A)')
     &				NODES(POINT_NODE)
	      WRITE (6,'(A)') INLINE
	   END IF
	END DO
 
	GO TO 999
 
910	WRITE (6,1010)
	GO TO 999
 
940	WRITE (6,1015) NODES(POINT_NODE)
 
999	DO WHILE (NODE_NUM.GT.0)
	   CLOSE(UNIT=9+NODE_NUM)
	   NODE_NUM = NODE_NUM - 1
	END DO
 
	RETURN
 
1010	FORMAT (' ERROR: Deletion aborted.')
1015	FORMAT (' ERROR: Unable to reach node ',A)
 
	END
 
 
 
 
	SUBROUTINE SET_FOLDER_FLAG(SETTING,FLAG,FLAGNAME)
C
C  SUBROUTINE SET_FOLDER_FLAG
C
C  FUNCTION: Sets or clears specified flag for folder
C
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLFOLDER.INC'
 
	INCLUDE 'BULLUSER.INC'
 
	INCLUDE 'BULLFILES.INC'
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
	CHARACTER*(*) FLAGNAME
 
	IF (REMOTE_SET.EQ.3) THEN
	   WRITE (6,'('' ERROR: Command invalid for folder.'')')
	ELSE IF (FLAG.EQ.7.AND..NOT.SETPRV_PRIV()) THEN
	   WRITE (6,'('' ERROR: Privileges required for this command.'')')
	ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
	   CALL OPEN_BULLFOLDER		! Open folder file
 
	   CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
 
	   IF (SETTING) THEN
	      FOLDER_FLAG = IBSET(FOLDER_FLAG,FLAG)
	   ELSE
	      FOLDER_FLAG = IBCLR(FOLDER_FLAG,FLAG)
	   END IF
 
	   CALL REWRITE_FOLDER_FILE
 
	   CALL CLOSE_BULLFOLDER
 
	   WRITE (6,'(1X,A,'' has been modified for folder.'')')
     &		FLAGNAME
	ELSE
	   WRITE (6,'(1X,'' You are not authorized to modify '',A)')
     &		FLAGNAME//'.'
	END IF
 
	RETURN
	END
 
 
 
 
	SUBROUTINE SET_FOLDER_EXPIRE_LIMIT(LIMIT)
C
C  SUBROUTINE SET_FOLDER_EXPIRE_LIMIT
C
C  FUNCTION: Sets folder expiration limit.
C
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLFOLDER.INC'
 
	INCLUDE 'BULLUSER.INC'
 
	INCLUDE 'BULLFILES.INC'
 
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 
	IF (REMOTE_SET.EQ.3) THEN
	   WRITE (6,'('' ERROR: Command invalid for folder. '')')
	ELSE IF (LIMIT.LT.0) THEN
	   WRITE (6,'('' ERROR: Invalid expiration length specified.'')')
	ELSE IF (FOLDER_ACCESS(USERNAME,FOLDER_FLAG,FOLDER_OWNER)) THEN
	   CALL OPEN_BULLFOLDER		! Open folder file
 
	   CALL READ_FOLDER_FILE_KEYNAME(FOLDER,IER)
 
	   F_EXPIRE_LIMIT = LIMIT
 
	   CALL REWRITE_FOLDER_FILE
 
	   CALL CLOSE_BULLFOLDER
	   WRITE (6,'('' Folder expiration date modified.'')')
	ELSE
	   WRITE (6,'('' You are not allowed to modify folder.'')')
	END IF
 
	RETURN
	END
 
 
 
 
 
	SUBROUTINE MERGE
 
	IMPLICIT INTEGER (A-Z)
 
	INCLUDE 'BULLFOLDER.INC'
 
	INCLUDE 'BULLDIR.INC'
 
	CHARACTER*(DIR_RECORD_LENGTH) BULLDIR_ENTRY_SAVE
 
	ENTRY INITIALIZE_MERGE(IER1)
 
	DO WHILE (FILE_LOCK(IER1,IER2))
	   OPEN (UNIT=13,FILE=FOLDER_FILE(:TRIM(FOLDER_FILE))
     &		//'.TMPDIR',STATUS='NEW',FORM='UNFORMATTED',
     &		RECORDTYPE='FIXED',RECORDSIZE=DIR_RECORD_LENGTH/4,
     &		ORGANIZATION='INDEXED',IOSTAT=IER,DISPOSE='DELETE',
     &		KEY=(9:12:INTEGER,1:8:CHARACTER),ACCESS='KEYED')
	END DO
 
	IF (IER1.NE.0) RETURN
 
	NBULL = 0
 
	WRITE(13,IOSTAT=IER1) BULLDIR_HEADER
	CALL CONVERT_HEADER_FROMBIN
 
	TO_POINTER = 1
 
	RETURN
 
	ENTRY ADD_MERGE_TO(IER1)
 
	IER1 = 0
 
	DO WHILE (IER1.EQ.0)
 
	   BULLDIR_ENTRY_SAVE = BULLDIR_ENTRY
 
	   CALL READDIR(TO_POINTER,IER)
 
	   DIFF = COMPARE_BTIM(%REF(BULLDIR_ENTRY_SAVE),MSG_BTIM)
	   IF (DIFF.LT.0.OR.TO_POINTER+1.NE.IER) THEN
	      BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE
	      CALL CONVERT_ENTRY_FROMBIN
	      RETURN
	   END IF
 
	   NBULL = NBULL + 1
	   MSG_NUM = NBULL
 
	   CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	   WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY
 
	   NEWEST_DATE = DATE
	   NEWEST_TIME = TIME
 
	   TO_POINTER = TO_POINTER + 1
 
	   BULLDIR_ENTRY = BULLDIR_ENTRY_SAVE
	END DO
 
	CLOSE (UNIT=13)
 
	RETURN
 
	ENTRY ADD_MERGE_FROM(IER1)
 
	NEWEST_DATE = DATE
	NEWEST_TIME = TIME
 
	DIFF = COMPARE_DATE(NEWEST_EXDATE,EXDATE)
	IF (DIFF.GT.0) THEN
	   NEWEST_EXDATE = EXDATE
	   NEWEST_EXTIME = EXTIME
	ELSE IF (DIFF.EQ.0) THEN
	   DIFF = COMPARE_TIME(NEWEST_EXTIME,EXTIME)
	   IF (DIFF.GT.0) NEWEST_EXTIME = EXTIME
	END IF
 
	IF ((SYSTEM.AND.4).EQ.4) THEN
	   SHUTDOWN = SHUTDOWN + 1
	   SHUTDOWN_DATE = DATE
	   SHUTDOWN_TIME = TIME
	END IF
 
	BLOCK = NBLOCK - LENGTH
 
	NBULL = NBULL + 1
	MSG_NUM = NBULL
 
	CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY
 
	RETURN
 
	ENTRY ADD_MERGE_REST(IER1)
 
	CALL UPDATE_LOGIN(.TRUE.)
 
	DO WHILE (IER1.EQ.0)
 
	   CALL READDIR(TO_POINTER,IER)
	   IF (TO_POINTER+1.NE.IER) THEN
	      READ (13,KEYID=0,KEY=0,IOSTAT=IER1)
	      CALL CONVERT_HEADER_TOBIN
	      REWRITE(13,IOSTAT=IER1) BULLDIR_HEADER
	      IF (IER1.EQ.0) THEN
	         CLOSE (UNIT=13,DISPOSE='KEEP')
	         CALL LIB$RENAME_FILE(FOLDER_FILE(:TRIM(FOLDER_FILE))//
     &		  '.TMPDIR',FOLDER_FILE(:TRIM(FOLDER_FILE))//'.BULLDIR')
	      ELSE
		 CLOSE (UNIT=13)
	      END IF
	      RETURN
	   END IF
 
	   NBULL = NBULL + 1
	   MSG_NUM = NBULL
 
	   CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	   WRITE(13,IOSTAT=IER1) BULLDIR_ENTRY
 
	   NEWEST_DATE = DATE
	   NEWEST_TIME = TIME
 
	   TO_POINTER = TO_POINTER + 1
	END DO
 
	CLOSE (UNIT=13)
 
	RETURN
	END
 
 
 
 
	SUBROUTINE SET_NOKEYPAD
 
	IMPLICIT INTEGER (A-Z)
 
	COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID
 
	COMMON /KEYPAD/ KEYPAD_MODE
 
	INCLUDE '($SMGDEF)'
 
	KEYPAD_MODE = 0
 
	TERM = SMG$M_KEY_TERMINATE
 
	IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,0)
 
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'SET KEYPAD',)
 
	RETURN
	END
 
 
 
 
 
	SUBROUTINE SET_KEYPAD
 
	IMPLICIT INTEGER (A-Z)
 
	COMMON /SMG/ KEYBOARD_ID,KEY_TABLE_ID
 
	COMMON /KEYPAD/ KEYPAD_MODE
 
	INCLUDE '($SMGDEF)'
 
	KEYPAD_MODE = 1
 
	TERM = SMG$M_KEY_TERMINATE
 
	IER = SMG$SET_KEYPAD_MODE(KEYBOARD_ID,1)
 
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF1',,,,'GOLD')
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2',,TERM,'HELP',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF2','GOLD',TERM,'SET NOKEYPAD',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3',,,'EXTRACT ',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF3','GOLD',,'FILE ',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4',,TERM,'SHOW KEYPAD',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PF4','GOLD',TERM,
     &		'SHOW KEYPAD/PRINT',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0',,TERM,
     &		'SHOW FOLDER/FULL',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP0','GOLD',TERM,'SHOW FLAGS',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1',,TERM,'BACK',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP1','GOLD',TERM,'NEXT',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2',,TERM,'PRINT',) 
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP2','GOLD',TERM,'PRINT/NONOTIFY',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3',,TERM,'DIR',)-
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP3','GOLD',TERM,'DIR/FOLDER',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4',,TERM,'CURRENT',)B
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP4','GOLD',TERM,'CURRENT/EDIT ',)t
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5',,TERM,'RESPOND',)E
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP5','GOLD',TERM,'RESP/EDIT/EXT',)E
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP6',,TERM,'LAST',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7',,TERM,'ADD',),
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP7','GOLD',TERM,'ADD/EDIT',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8',,TERM,'REPLY',).
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP8','GOLD',TERM,'REPL/EDIT/EXT',)e
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9',,TERM,'MAIL',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'KP9','GOLD',TERM,'MAIL/NOHEAD',)m
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS',,TERM,'READ/NEW',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'MINUS','GOLD',TERM,'SHOW NEW',)
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA',,TERM,'DIR/NEW',)E
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'COMMA','GOLD',TERM,'INDEX',) 
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD',,TERM,'DELETE',)'
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'PERIOD','GOLD',TERM,'UNDELETE',)w
	IER = SMG$ADD_KEY_DEF(KEY_TABLE_ID,'ENTER','GOLD',,'SELECT ',)E
 
	RETURNI
	END
 )
 I
 N
	SUBROUTINE SHOW_KEYPAD(LIBRARY)
 9
	IMPLICIT INTEGER (A-Z))
	EXTERNAL LIB$PUT_OUTPUT,PRINT_OUTPUTD
	CHARACTER*(*) LIBRARY
 W
	INCLUDE '($HLPDEF)'
  
	IF (CLI$PRESENT('PRINT')) THENN
	   OPEN (UNIT=8,STATUS='NEW',FILE='SYS$LOGIN:KEYPAD.DAT',
     &			IOSTAT=IER)
	   IF (IER.NE.0) THEN
	      WRITE (6,'('' ERROR WHILE OPENING FILE TO PRINTER.'')')
	   ELSE
	      CALL LBR$OUTPUT_HELP(PRINT_OUTPUT,,'KEYPAD'
     &		,LIBRARY,HLP$M_HELP)
	      CLOSE (UNIT=8,DISP='PRINT/DELETE')r
	   END IF
	ELSEI
	   CALL LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,'KEYPAD'
     &		,LIBRARY,HLP$M_HELP)
	END IFU
 '
	RETURN.
	END
 
	INTEGER FUNCTION PRINT_OUTPUT(INPUT)T
	IMPLICIT INTEGER (A-Z))
	CHARACTER*(*) INPUT
	WRITE (8,'(1X,A)',IOSTAT=IER) INPUT(:TRIM(INPUT))
	IF (IER.EQ.0) PRINT_OUTPUT = 1S
	RETURNG
	END
 .
 T
 T
	SUBROUTINE OUTPUT_HELP(PARAMETER,LIBRARY)
Ci
C  SUBROUTINE OUTPUT_HELPm
C.
C  FUNCTION:
C	To create interactive help session.  Prompting is enabled.
C  INPUTS:
C	PARAMETER - Character string. Optional input parameter
C		    containing a list of help keys.
C	LIBRARY   - Character string. Name of help library.A
C
	IMPLICIT INTEGER (A-Z)L
 =
	INCLUDE '($LBRDEF)'
 
	COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN
	COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO
	CHARACTER*80 HELP_INPUT
  
	COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACTu
	CHARACTER*20 KEY(10)m
	DIMENSION KEYL(10)&
 L
	EXTERNAL PUT_OUTPUT
 
	CHARACTER*(*) LIBRARY,PARAMETER
 B
	CHARACTER*80 PROMPT
 _
	DATA DISPLAY_ID/0/,KEYBOARD_ID/0/
 D
	IF (KEYBOARD_ID.EQ.0) THENT
	   IER = SMG$CREATE_VIRTUAL_KEYBOARD(KEYBOARD_ID,,,,20)
	   IER = SMG$CREATE_KEY_TABLE(KEY_TABLE_ID)
	END IFU
 S
	CALL STR$TRIM(HELP_INPUT,PARAMETER,HELP_INPUT_LEN)	! Trim input
 E
	CALL LBR$INI_CONTROL(LINDEX,LBR$C_READ)		! Init library read 
	CALL LBR$OPEN(LINDEX,LIBRARY)			! Specify library nameF
 I
	DO I=1,10					! Initialize key lengthsI
	   KEYL(I) = 0 
	END DOe
 i
	NKEY = 0					! Number of help keysR
 E
	DO WHILE (1)		! Do until CTRL-Z entered or no more keys
  
	   HELP_PAGE = 0				! Init line counter
	   NEED_ERASE = .TRUE.				! Need to erase screen=
 M
	   OLD_NKEY = NKEY				! Save old key count 
	   EXACT = .TRUE.				! Exact key match 
 d
	   DO WHILE (NKEY.LT.10.AND.HELP_INPUT_LEN.GT.0.AND.6
     &					   HELP_INPUT(:1).NE.'?')
							! Break input into keys
	      NKEY = NKEY + 1				! Increment key counter
 I
	      DO WHILE (HELP_INPUT(1:1).EQ.' '.AND.HELP_INPUT_LEN.GT.0)
		 HELP_INPUT = HELP_INPUT(2:HELP_INPUT_LEN)	! Strip spacesE
		 HELP_INPUT_LEN = HELP_INPUT_LEN - 1	! at start of input
	      END DOR
 E
	      NEXT_KEY = 21
 I
	      DO WHILE (NEXT_KEY.LE.HELP_INPUT_LEN		! Search forT
     &		  .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.' '	! space or
     &		  .AND.HELP_INPUT(NEXT_KEY:NEXT_KEY).NE.'/')	! backslash
		 NEXT_KEY = NEXT_KEY + 1	! indicating start of next keyE
	      END DOD
 
	      IF (NEXT_KEY.GT.HELP_INPUT_LEN) THEN	! Found the last key
		 KEY(NKEY) = HELP_INPUT(:HELP_INPUT_LEN)	! Key stringB
		 KEYL(NKEY) = HELP_INPUT_LEN			! Key lengthT
		 HELP_INPUT_LEN = 0
	      ELSE					! Found the next key
		 KEY(NKEY) = HELP_INPUT(:NEXT_KEY-1)
		 HELP_INPUT = HELP_INPUT(NEXT_KEY:HELP_INPUT_LEN) 
		 KEYL(NKEY) = NEXT_KEY - 1
		 HELP_INPUT_LEN = HELP_INPUT_LEN - NEXT_KEY + 1_
	      END IFR
	   END DO
	   HELP_INPUT_LEN = 0
	   IER = LBR$GET_HELP(LINDEX,,PUT_OUTPUT,,	! Display help
     &		   KEY(1)(:KEYL(1)),KEY(2)(:KEYL(2)),
     &		   KEY(3)(:KEYL(3)),KEY(4)(:KEYL(4)),KEY(5)(:KEYL(5)),
     &		   KEY(6)(:KEYL(6)),KEY(7)(:KEYL(7)),KEY(8)(:KEYL(8)),
     &		   KEY(9)(:KEYL(9)),KEY(10)(:KEYL(10)))R
 T
	   IF (IER.EQ.0.AND.HELP_INPUT_LEN.GT.0) IER = 1R
		! IER = 0 special case means input given to full screen prompt
 M
	   IF (KEY(NKEY).EQ.'*'.OR..NOT.EXACT) THEN	! If not exact match
	      DO I=OLD_NKEY+1,NKEY			! then don't updateD
		 KEYL(I) = 0				! new keys
	      END DO 
	      NKEY = OLD_NKEY
	   END IF
 F
	   IF (IER.AND.NKEY.GT.0.AND.OTHERINFO.EQ.0) THEN ! No subtopics?
	      KEYL(NKEY) = 0				! Back up one key level
	      NKEY = NKEY - 1
	   END IF
 H
	   DO WHILE (HELP_INPUT_LEN.EQ.0.AND.IER.AND.NKEY.GE.0)
	      IF (NKEY.EQ.0) THEN	! If top level, prompt for topic
	         IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID,
     &		   HELP_INPUT,'Topic? ',HELP_INPUT_LEN)
	      ELSE			! If not top level, prompt for subtopicL
		 LPROMPT = 0		! Create subtopic prompt line0
		 DO I=1,NKEY		! Put spaces in between keys
		    PROMPT = PROMPT(:LPROMPT)//KEY(I)(:KEYL(I))//' '
		    LPROMPT = LPROMPT + KEYL(I) + 1_
		 END DON
		 PROMPT = PROMPT(:LPROMPT)//'Subtopic? '
		 LPROMPT = LPROMPT + 10 
	         IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID,
     &		   HELP_INPUT,PROMPT(:LPROMPT),HELP_INPUT_LEN)
	      END IFD
	      CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN)
	      IF (IER.AND.HELP_INPUT_LEN.EQ.0) THEN	! If RETURN entered
		 KEYL(NKEY) = 0				! Back up one key level
		 NKEY = NKEY - 1
	      END IFK
	   END DO
 (
	   IF (.NOT.IER.OR.NKEY.LT.0) THEN	! If CTRL-Z above top level,
	      CALL LIB$PUT_OUTPUT(' ')		! Skip line
	      CALL LBR$CLOSE(LINDEX)		! then close library,
	      RETURN				! and end help session.
	   END IF
 P
	END DOE
  
	END
 
 C
 O
	INTEGER FUNCTION PUT_OUTPUT(INPUT,INFO,DATA,LEVEL)/
CY
C  FUNCTION PUT_OUTPUT
CM
C  FUNCTION:
C	Output routine for input from LBR$GET_HELP.  DisplaysR
C	help text on terminal with full screen prompting.G
C  INPUTS:
C	INPUT - Character string.  Line of input text.
C	INFO  - Longword.  Contains help flag bits._
C	DATA  - Longword.  Not presently used.
C	LEVEL - Longword.  Contains current key level.
CK
	IMPLICIT INTEGER (A-Z)I
 U
	INCLUDE '($HLPDEF)'
 A
	COMMON /LEVELS/ KEY,KEYL,NKEY,OLD_NKEY,EXACT
	CHARACTER*20 KEY(10)_
	DIMENSION KEYL(10)
 
	COMMON /HELP/ HELP_PAGE,HELP_INPUT,HELP_INPUT_LEN
	COMMON /HELP/ NEED_ERASE,KEYBOARD_ID,KEY_TABLE_ID,OTHERINFO
	CHARACTER*80 HELP_INPUT
 E
	COMMON /PAGE/ PAGE_LENGTH,PAGE_WIDTH,PAGING
 G
	CHARACTER INPUT*(*)
 ,
	CHARACTER SPACES*20
	DATA SPACES /' '/
 K
	OTHERINFO = INFO.AND.HLP$M_OTHERINFOI
 =
	IF ((INFO.AND.HLP$M_NOHLPTXT).NE.0) THEN	! Key cannot be found=
	   NEED_ERASE = .FALSE.				! Don't erase screen
	   IF (HELP_PAGE.EQ.0) THEN		! If first line of help text
	      DO I=OLD_NKEY+1,NKEY		! remove any new keys that=
		 KEYL(I) = 0			! were inputted, as they are,
	      END DO				! not valid, as no matchT
	      NKEY = OLD_NKEY			! could be found.
	   END IF
	ELSE IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0.AND.NKEY.GT.0.AND.
     &		 LEVEL.GT.OLD_NKEY.AND.KEY(NKEY)(:KEYL(NKEY)).NE.'*'.AND.E
     &		 %LOC(INPUT).NE.0) THEN		! If text contains key namesF
			! Update if not wildcard search and they are new keys
	   IF (KEYL(LEVEL).GT.0) THEN		! If key already updated
	      EXACT = .FALSE.		! Must be more than one match possible
	   END IF			! so indicate not exact match.R
	   START_KEY = 1		! String preceeding spaces.
	   DO WHILE (INPUT(START_KEY:START_KEY).EQ.' ')
	      START_KEY = START_KEY + 1
	   END DO
	   KEY(LEVEL) = INPUT(START_KEY:)			! Store new key
	   CALL STR$TRIM(KEY(LEVEL),KEY(LEVEL),KEYL(LEVEL))	! & key length
	ELSE IF (HELP_PAGE.EQ.0) THEN		! If first line of text,
	   DO I=OLD_NKEY+1,NKEY			! remove any new keys thatR
	      KEYL(I) = 0			! were just inputted, allowing8
	   END DO				! this routine to fill them.
	END IFD
 K
	IF (NEED_ERASE) THEN			! Need to erase screen?K
	   IER = LIB$ERASE_PAGE(1,1)		! i.e. start of new topic.R
	   NEED_ERASE = .FALSE.
	END IFN
 ,
	HELP_PAGE = HELP_PAGE + 1		! Increment screen counter
	IF (PAGING.AND.HELP_PAGE.GT.PAGE_LENGTH-2) THEN		! End of page?
	   HELP_PAGE = 0			! Reinitialize screen counterD
	   CALL LIB$PUT_OUTPUT(' ')	! Skip line and prompt for next screenF
	   IER = SMG$READ_COMPOSED_LINE(KEYBOARD_ID,KEY_TABLE_ID,
     &		HELP_INPUT,'Press RETURN to continue ... ',HELP_INPUT_LEN)
	   CALL STR$TRIM(HELP_INPUT,HELP_INPUT,HELP_INPUT_LEN)	! Trim input
	   IF (.NOT.IER.OR.HELP_INPUT_LEN.GT.0) THEN	! CTRL-Z or Text input?A
	      EXACT = .TRUE.	! If more than one match was found and being
				! displayed, text input specifies that the
				! current displayed match is desired.N
	      PUT_OUTPUT = 0	! Stop any more of current help display.
	   ELSE					! Else if RETURN enteredR
	      IER = LIB$ERASE_PAGE(1,1)		! Erase display 
	      NSPACES = LEVEL*2		! Number of spaces to indent outputA
	      IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2 
		! Key name lines are indented 2 less than help description.
	      IF (NSPACES.GT.0) THEN	! Add spaces if present to outputI
		 PUT_OUTPUT =  LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT)
	      ELSE			! Else just output text.
		 PUT_OUTPUT =  LIB$PUT_OUTPUT(INPUT)
	      END IFP
	      HELP_PAGE = 1		! Increment page counter.B
	   END IF
	ELSE				! Else if not end of page
	   NSPACES = LEVEL*2		! Just output text line
	   IF ((INFO.AND.HLP$M_KEYNAMLIN).NE.0) NSPACES = NSPACES - 2
	   IF (NSPACES.GT.0) THEN
	      PUT_OUTPUT = LIB$PUT_OUTPUT(SPACES(:NSPACES)//INPUT) 
	   ELSE
	      PUT_OUTPUT = LIB$PUT_OUTPUT(INPUT)e
	   END IF
	END IFP
 I
	RETURN 
	END
 =
 I
 U
 '
	SUBROUTINE SHOW_VERSION
 /
	IMPLICIT INTEGER (A-Z)P
 P
	CHARACTER VERSION*10,DATE*23S
 E
	CALL READ_HEADER(VERSION,DATE)
 A
	WRITE (6,'(A)') ' BULLETIN Version '//VERSION(:TRIM(VERSION))
 X
	WRITE (6,'(A)') ' Linked on '//DATE(:TRIM(DATE))
 
	RETURN 
	END
 T
 
 C
 A
 R
 )
	SUBROUTINE TAG(ADD_OR_DEL)A
 R
	IMPLICIT INTEGER (A-Z)P
 _
	INCLUDE 'BULLDIR.INC'
 I
	COMMON /TAGS/ BULL_TAG,READ_TAG
	DATA BULL_TAG /.FALSE./,READ_TAG /.FALSE./,
 )
	COMMON /POINT/ BULL_POINT
 E
	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER
 P
	EXTERNAL CLI$_ABSENTE
 C
	IF (.NOT.BULL_TAG) THEN
	   CALL OPEN_NEW_TAG(IER)
	   IF (.NOT.IER) RETURN
	END IFR
 	
	IF (.NOT.CLI$PRESENT('NUMBER')) THEN0
	   IF (BULL_POINT.EQ.0) THEN	! No.  Have we just read a bulletin?
	      WRITE(6,1010)		! No, then error. 
	      RETURN 
	   ELSE IF (ADD_OR_DEL) THEN 
	      CALL ADD_TAG(IER)
	   ELSE
	      CALL DEL_TAG(IER)
	      IF (IER.NE.0) THENe
		 WRITE (6,'('' ERROR: Message was not marked.'')')
	      END IFX
	   END IF
	   RETURN
	END IF 
 d
	CALL OPEN_BULLDIR_SHAREDA
 H
	IER1 = 0E
	DO WHILE (CLI$GET_VALUE('NUMBER',BULL_PARAMETER,LEN_P)	
     &	    .NE.%LOC(CLI$_ABSENT).AND.IER1.EQ.0) ! Get the specified messages
 
	   DECODE(LEN_P,'(I<LEN_P>)',BULL_PARAMETER) MESSAGE_NUMBER
 
	   CALL READDIR(MESSAGE_NUMBER,IER)	! Get info for bulletin
 H
	   IF (IER.NE.MESSAGE_NUMBER+1) THEN	! Was bulletin found? 
	      WRITE(6,1030)			! If not, then error out 
	   ELSE IF (ADD_OR_DEL) THENE
	      CALL ADD_TAG(IER1) 
	   ELSE
	      CALL DEL_TAG(IER)
	      IF (IER.NE.0) THEN 
		 WRITE (6,'('' ERROR: Message '',I,/
     &				'' was not marked.'')') MESSAGE_NUMBER
	      END IFn
	   END IF
	END DOD
 
	CALL CLOSE_BULLDIRE
 T
	RETURNU
 E
1010	FORMAT(' ERROR: You have not read any message.')(
1030	FORMAT(' ERROR: Message was not found.') 
 P
	END
 N
 !
 y
	SUBROUTINE ADD_TAG(IER)
  
	IMPLICIT INTEGER (A-Z)n
 h
	INCLUDE '($FORIOSDEF)'=
 L
	INCLUDE 'BULLDIR.INC'
 L
	INCLUDE 'BULLFOLDER.INC'E
 E
	CHARACTER*12 TAG_KEY(
 Y
	WRITE (13,IOSTAT=IER) TAG_KEY(FOLDER_NUMBER,MSG_KEY)N
 _
	IF (IER.EQ.FOR$IOS_INCKEYCHG) THEN
	   WRITE (6,'('' Message was already marked.'')')
 	ELSE IF (IER.NE.0) THENe
	   WRITE (6,'('' ERROR: Unable to add mark.'')')
	   CALL ERRSNS(IDUMMY,IER1)
	   IF (IER1.EQ.0) THENY
	      WRITE (6,'('' IOSTAT error = '',I)') IER7
	   ELSE
	      CALL SYS_GETMSG(IER1)
	   END IF
	END IFY
 0
	RETURN
	END
 E
 Q
 A
 H
	SUBROUTINE DEL_TAG(IER)
 
	IMPLICIT INTEGER (A-Z)m
 s
	INCLUDE 'BULLDIR.INC'
  
	INCLUDE 'BULLFOLDER.INC'Y
 Q
	CHARACTER*12 TAG_KEYN
 I
	DO WHILE (REC_LOCK(IER))D
	   READ (13,KEYEQ=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER) 
	END DO
	IF (IER.NE.0) RETURNN
  
	DELETE (UNIT=13,IOSTAT=IER)
 F
	IF (IER.NE.0) THENN
	   WRITE (6,'('' ERROR: Unable to delete mark.'')')
	   CALL ERRSNS(IDUMMY,IER1)
	   IF (IER1.EQ.0) THEN-
	      WRITE (6,'('' IOSTAT error = '',I)') IERE
	   ELSE
	      CALL SYS_GETMSG(IER1)
	   END IF
	END IFo
 e
	RETURNp
	END
 i
 
  
  
 E
	SUBROUTINE OPEN_OLD_TAG
 Y
	IMPLICIT INTEGER (A-Z) 
 &
	INCLUDE '($FORIOSDEF)',
 P
	INCLUDE 'BULLUSER.INC'	
  
	COMMON /TAGS/ BULL_TAG,READ_TAG
 L
	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER
 p
	IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)R
	IF (.NOT.IER) RETURN/
 '
	NTRIES = 0P
  
	DO WHILE (FILE_LOCK(IER,IER1).AND.NTRIES.LE.30)
	   OPEN (UNIT=13,FILE='BULL_MARK:'//T
     &	     USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='OLD',
     &	     ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,)
     &	     ORGANIZATION='INDEXED',IOSTAT=IER,
     &	     KEY=(1:12:CHARACTER))N
	   NTRIES = NTRIES + 1A
	END DON
 _
	IF (IER.NE.0.AND.IER.NE.FOR$IOS_FILNOTFOU) THEN
	   WRITE (6,'('' Unable to open mark file.'')')
	   IF (IER1.EQ.0) CALL ERRSNS(IDUMMY,IER1)T
	   IF (IER1.EQ.0) THEN 
	      WRITE (6,'('' IOSTAT error = '',I)') IERU
	   ELSE
	      CALL SYS_GETMSG(IER1)
	   END IF
	   RETURN
	END IFr
 
	IF (IER.EQ.0) BULL_TAG = .TRUE.
 o
	RETURNN
	END
 
 D
 E
  
	SUBROUTINE OPEN_NEW_TAG(IER)N
 O
	IMPLICIT INTEGER (A-Z)A
 L
	INCLUDE 'BULLUSER.INC'U
 U
	COMMON /TAGS/ BULL_TAG,READ_TAG
 i
	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER
 f
	CHARACTER*64 BULL_MARK 
 P
	IER = SYS_TRNLNM('BULL_MARK',BULL_MARK)
	IF (.NOT.IER) THEN 
	   WRITE (6,'('' ERROR: BULL_MARK must be defined.'',
     &		''  See HELP MARK.'')') 
	   RETURN
	ELSEn
	   IER1 = SYS_TRNLNM_SYSTEM('BULL_MARK',BULL_PARAMETER)
	   IF (.NOT.IER1.OR.BULL_MARK.NE.BULL_PARAMETER) THEN
	      IER = SYS_TRNLNM('BULL_MARK',BULL_PARAMETER)Y
	      CALL DISABLE_PRIVSH
	      IER1 = 0U
	   END IF
	   OPEN (UNIT=13,FILE='BULL_MARK:'//D
     &	        USERNAME(:TRIM(USERNAME))//'.BULLMARK',STATUS='NEW',G
     &	        ACCESS='KEYED',RECORDTYPE='FIXED',SHARED,
     &	        RECORDSIZE=3,
     &	        FORM='UNFORMATTED',ORGANIZATION='INDEXED',IOSTAT=IER,
     &	        KEY=(1:12:CHARACTER))
	   IF (.NOT.IER1) CALL ENABLE_PRIVS
	   IF (IER.NE.0) THEN
	      WRITE (6,'('' Cannot create mark file.'')')
	      CALL ERRSNS(IDUMMY,IER1)L
	      IF (IER1.EQ.0) THEN
	         WRITE (6,'('' IOSTAT error = '',I)') IER
		 IER = 0
	      ELSE	
	         CALL SYS_GETMSG(IER1) 
		 IER = IER1K
	      END IF 
	   ELSE
	      BULL_TAG = .TRUE.
	      IER = 1
	   END IF
	END IF.
 N
	RETURN&
	END
 G
 L
 K
	CHARACTER*12 FUNCTION TAG_KEY(FOLDER_NUMBER,MSG_KEY)O
 N
	IMPLICIT INTEGER (A-Z)t
 n
	CHARACTER*(*) MSG_KEY
 t
	CALL LIB$MOVC3(4,FOLDER_NUMBER,%REF(TAG_KEY))
  
	CALL GET_MSGKEY(%REF(MSG_KEY),TAG_KEY(5:))u
 t
	RETURN 
	END
 .
 S
 	
 u
	SUBROUTINE GET_FIRST_TAG(FOLDER_NUMBER,IER,MESSAGE)
 i
	IMPLICIT INTEGER (A-Z) 
 T
	INCLUDE 'BULLDIR.INC'
 e
	COMMON /TAGS/ BULL_TAG,READ_TAG
 R
	CHARACTER*12 TAG_KEY,INPUT_KEYS
 T
	IF (.NOT.BULL_TAG) THEN
	   CALL OPEN_NEW_TAG(IER)
	   IF (.NOT.IER) RETURN
	END IF 
 A
	MSG_KEY = BULLDIR_HEADERL
 L
	HEADER = .TRUE.
	GO TO 10
 E
	ENTRY GET_THIS_TAG(FOLDER_NUMBER,IER,MESSAGE)
 x
	DO WHILE (REC_LOCK(IER))Y
	   READ (13,KEY=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER)u
     &					INPUT_KEY
	END DO 
 	
	IF (IER.EQ.0) THENi
	   UNLOCK 13I
	   MESSAGE = MSG_NUM)
	END IF 
 d
	RETURN 
 e
	ENTRY GET_THIS_OR_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE)
 p
	I = 1
	DO WHILE (I.LT.9)
	   ITEST = ICHAR(MSG_KEY(I:I))L
	   IF (ITEST.GT.0) THEN
	      MSG_KEY(I:I) = CHAR(ITEST-1)G
	      I = 9
	   ELSE
	      I = I + 1
	   END IF
	END DO 
 n
	ENTRY GET_NEXT_TAG(FOLDER_NUMBER,IER,MESSAGE)
  
	HEADER = .FALSE.p
 p
10	DO WHILE (REC_LOCK(IER)) 
	   READ (13,KEYGT=TAG_KEY(FOLDER_NUMBER,MSG_KEY),IOSTAT=IER)I
     &					INPUT_KEY
	END DO.
 '
	DO WHILE (1))
	   IF (IER.EQ.0) THEN
	      CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),MSG_KEY)F
	      CALL LIB$MOVC3(4,%REF(INPUT_KEY),FOLDER1_NUMBER)i
	   END IF
 E
	   IF (FOLDER1_NUMBER.NE.FOLDER_NUMBER.OR.IER.NE.0) THEN
	      IER = 1
	      UNLOCK 13
	      RETURN	
	   ELSE
	      I = 1
	      DO WHILE (I.LT.9)
		 ITEST = ICHAR(MSG_KEY(I:I))
	         IF (ITEST.GT.0) THEN
		    MSG_KEY(I:I) = CHAR(ITEST-1)
		    I = 9E
		 ELSE(
		    I = I + 1p
		 END IF 
	      END DOL
	      CALL GET_MSGKEY(MSG_BTIM,MSG_KEY)
	      INQUIRE (UNIT=2,OPENED=IER)
	      IF (.NOT.IER) THEN 
	         CALL OPEN_BULLDIRd
	         CALL READDIR_KEYGE(IER)
	         CALL CLOSE_BULLDIR
	      ELSEs
	         CALL READDIR_KEYGE(IER)U
	      END IFT
	      CALL GET_MSGKEY(%REF(INPUT_KEY(5:)),INPUT_KEY(5:))p
	      IF (IER.NE.0.AND.MSG_KEY.EQ.INPUT_KEY(5:)) THEN
	         UNLOCK 13_
		 MESSAGE = MSG_NUM
		 IF (HEADER) THENN
		    MESSAGE = MESSAGE - 1e
		    MSG_KEY = BULLDIR_HEADER
		 END IFu
		 IER = 0
	         RETURN
	      ELSEN
		 DELETE (UNIT=13)=
		 DO WHILE (REC_LOCK(IER)).
	            READ (13,IOSTAT=IER) INPUT_KEYT
	 	 END DO
	      END IF
	   END IF
  
	END DOU
  
	END
 U
 T
 P
 e
  
 N
	SUBROUTINE FULL_DIR(INDEX_COUNT)
C
C	Add INDEX command to BULLETIN, display directories of ALLA
C	folders. Added per request of a faculty member for his private
C	board. Changes to BULLETIN.FOR should be fairly obvious.
CN
C	Brian Nelson, Brian@uoft02.bitnet (or .ccnet, node 8.2):
CM
	IMPLICIT INTEGER (A-Z)E
 
	INCLUDE 'BULLDIR.INC'
	INCLUDE 'BULLFILES.INC'
	INCLUDE 'BULLFOLDER.INC'A
	INCLUDE 'BULLUSER.INC'I
 N
	COMMON /POINT/ BULL_POINT
 ,
	COMMON /TAGS/ BULL_TAG,READ_TAG
 A
	DATA FOLDER_Q1/0/
 C
	BULL_POINT = 0L
 I
	IF (NUM_FOLDERS.GT.0.AND..NOT.CLI$PRESENT('RESTART')T
     &		.AND.INDEX_COUNT.EQ.1) THENL
	   INDEX_COUNT = 2.
	   DIR_COUNT = 0
	END IFO
 _
	IF (INDEX_COUNT.EQ.1) THENR
	  CALL INIT_QUEUE(FOLDER_Q1,FOLDER1_COM)N
 N
	  FOLDER_Q = FOLDER_Q1U
 P
	  SUBSCRIBE = CLI$PRESENT('SUBSCRIBE')a
	  IF (SUBSCRIBE) THEN
	     CALL NEWS_GET_SUBSCRIBE(0,F1_END)R
	     SUBNUM = 1
	     CALL OPEN_BULLNEWS_SHARED_
	  ELSE
	     CALL OPEN_BULLFOLDER_SHARED
	  END IFI
 N
	  NUM_FOLDERS = 0
	  IER = 0
	  DO WHILE (IER.EQ.0)			! Copy all bulletins from file 
	    IF (SUBSCRIBE) THEN
	       IER = 1L
	       DO WHILE (SUBNUM.NE.0.AND.IER.NE.0)G
	          CALL NEWS_GET_SUBSCRIBE(SUBNUM,F1_END) 
		  IF (SUBNUM.NE.0) THENI
	             CALL READ_FOLDER_FILE_KEYNUM_TEMP(SUBNUM,IER)'
		     IF (IER.NE.0) SUBNUM = -1
		  END IF
	       END DO
	       IF (SUBNUM.EQ.0) IER = 1
	    ELSEn
	       CALL READ_FOLDER_FILE_TEMP(IER)E
	    END IFt
	    IF (IER.EQ.0) THEN6
	      IF (BTEST(FOLDER1_FLAG,0).AND..NOT.SETPRV_PRIV()) THENE
		 FOLDER1_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))(
     &					//FOLDER1
	         CALL CHECK_ACCESSE
     &		  (FOLDER1_FILE(:TRIM(FOLDER1_FILE))//'.BULLFIL',S
     &		   USERNAME,READ_ACCESS,-1)F
	      ELSE
		 READ_ACCESS = 1
	      END IFU
	      IF (READ_ACCESS) THEN
	         NUM_FOLDERS = NUM_FOLDERS + 1A
	         CALL WRITE_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)O
	      END IFE
	    END IFI
	  END DO 
 Z
	  CALL CLOSE_BULLFOLDER			! We don't need file anymoreN
 
	  FOLDER_Q = FOLDER_Q1			! Init queue pointer to header
	  WRITE (6,1000)S
	  IF (SUBSCRIBE) THEN
	     WRITE (6,1025)
	  ELSEE
	     WRITE (6,1020)
	  END IFR
	  DO J = 1,NUM_FOLDERSl
	   CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)
	   IF (SUBSCRIBE) THENa
	      WRITE (6,1035) FOLDER1_DESCRIP(:72),F1_NBULL(
	   ELSE
	      WRITE (6,1030) FOLDER1,F1_NBULL, 
     &		FOLDER1_DESCRIP(:MIN(TRIM(FOLDER1_DESCRIP),46)) 
	   END IF
	  END DO
	  WRITE (6,1060)
	  FOLDER_Q = FOLDER_Q1			! Init queue pointer to header
	  INDEX_COUNT = 2
	  DIR_COUNT = 0
	  READ_TAG = .FALSE.R
	  IF (CLI$PRESENT('MARKED')) READ_TAG = .TRUE. 
	  RETURNE
	ELSE IF (INDEX_COUNT.EQ.2) THEN
	 IF (DIR_COUNT.LE.0) THEN
	  F1_NBULL = 0
	  DO WHILE (NUM_FOLDERS.GT.0.AND.F1_NBULL.EQ.0)
	     NUM_FOLDERS = NUM_FOLDERS - 1 
	     CALL READ_QUEUE(%VAL(FOLDER_Q),FOLDER_Q,FOLDER1_COM)
	     IF (F1_NBULL.GT.0) THEN1
	      FOLDER_NUMBER = -1(
	      CALL SELECT_FOLDER(.FALSE.,IER)
	      IF (.NOT.IER) F1_NBULL = 0
	     END IF
	  END DO
 T
	  IF (F1_NBULL.EQ.0) THEN
	     WRITE (6,1050)
	     INDEX_COUNT = 0N
	     RETURN
	  END IFE
	 END IF
     
	 IF (READ_TAG) THEN
	    CALL GET_FIRST_TAG(FOLDER_NUMBER,IER,BULL_POINT)O
	 END IF
 U
	 CALL DIRECTORY(DIR_COUNT)R
	 IF (DIR_COUNT.GT.0) RETURN
 S
	 IF (NUM_FOLDERS.GT.0) THEN
	    WRITE (6,1040))
	 ELSE
	    INDEX_COUNT = 0
	 END IF
	END IFO
 I
	RETURNA
 N
1000	FORMAT (' The following folders are present'/)
1020	FORMAT (' Name                       Count Description'/)
1025	FORMAT (' Name',70X,'Count'/)
1030	FORMAT (1X,A,1X,I6,1X,A) 
1035	FORMAT (1X,A,1X,I6)
1040	FORMAT (' Type Return to continue to the next folder...')
1050	FORMAT (' End of folder search.')
1060	FORMAT (' Type Return to continue...')6
 '
	END
 t
 p
 m
  
 e
	SUBROUTINE SHOW_USER.
CC
C  SUBROUTINE SHOW_USER
C 
C  FUNCTION: Shows information for specified users.o
C 
	IMPLICIT INTEGER (A-Z) 
  
	INCLUDE 'BULLFOLDER.INC' 
  
	INCLUDE 'BULLUSER.INC'
 
	INCLUDE 'BULLDIR.INC'
 T
	COMMON /POINT/ BULL_POINT
 D
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
 I
	COMMON /BULLPAR/ BULL_PARAMETER,LEN_P
	CHARACTER*64 BULL_PARAMETER
 _
	COMMON /CTRLC_FLAG/ FLAGB
 P
	DIMENSION NOLOGIN_BTIM(2),START_BTIM(2)
 P
	CHARACTER DATETIME*17
  
	DIMENSION LAST(2,FOLDER_MAX)N
	INTEGER*2 LAST2(4,FOLDER_MAX)
	EQUIVALENCE (LAST,LAST2)6
 '
	ALL = CLI$PRESENT('NOLOGIN').OR.CLI$PRESENT('ALL')e
     &				.OR.CLI$PRESENT('LOGIN')
 
	SETPRV = SETPRV_PRIV()		! SETPRV_PRIV rewrites TEMP_USER 
 F
	IF (.NOT.ALL) THENA
	   IER = CLI$GET_VALUE('USERNAME',TEMP_USER)N
	   IF (.NOT.IER) TEMP_USER = USERNAME
	END IFA
 _
	IF (.NOT.SETPRV.AND.(ALL.OR.USERNAME.NE.TEMP_USER)) THENE
	   WRITE (6,'('' ERROR: No privs to use command.'')')
	   RETURN
	END IFS
 E
	CALL SYS_BINTIM('5-NOV-2956 00:00:00.00',NOLOGIN_BTIM)A
 ,
	FOLDER_PRESENT = CLI$PRESENT('FOLDER') 
  
	IF (FOLDER_PRESENT) THENA
	   IER = CLI$GET_VALUE('FOLDER',FOLDER1_NAME)
	   IF (.NOT.IER) FOLDER1_NAME = FOLDER_NAME
	   NEWS = INDEX(FOLDER1_NAME,'.').GT.0.OR.(FOLDER1_NAME(:1)
     &			.GE.'a'.AND.FOLDER1_NAME(:1).LE.'z')M
           IF (.NOT.NEWS) THEN
	      CALL OPEN_BULLFOLDER_SHARED
	   ELSE
	      CALL OPEN_BULLNEWS_SHARED
	      CALL LOWERCASE(FOLDER1_NAME)
	   END IF
	   CALL READ_FOLDER_FILE_KEYNAME_TEMP
     &				(FOLDER1_NAME(:TRIM(FOLDER1_NAME)),IER).
	   CALL CLOSE_BULLFOLDERL
	   IF (IER.NE.0) THEN
	      WRITE (6,'('' ERROR: Folder not found.'')')
	      RETURN
	   END IF
	END IFG
 Y
	SINCE = CLI$PRESENT('SINCE').OR.CLI$PRESENT('START') 
	IF (CLI$GET_VALUE('SINCE',BULL_PARAMETER,LEN_P)) THEN
	   IF (.NOT.NEWS) THENu
	      IER = SYS_BINTIM(BULL_PARAMETER,START_BTIM)
	      IF (.NOT.IER) THENA
	         WRITE (6,'('' ERROR: Invalid date specified.'')'),
		 RETURNR
	      END IF 
	   ELSE
	      WRITE (6,'('' ERROR: /SINCE not valid with NEWS group.'')')
	      RETURNR
	   END IF
	ELSE IF (CLI$GET_VALUE('START',BULL_PARAMETER,LEN_P)) THEN
	   IF (NEWS) THEN
	      IER = OTS$CVT_TI_L(BULL_PARAMETER(:LEN_P), 
     &				    STARTMSG,,%VAL(1))
	      IF (.NOT.IER) THENR
		 WRITE (6,'('' ERROR: Invalid number specified.'')')
		 RETURNR
	      END IF 
	   ELSE
	      WRITE (6,'('' ERROR: /START not valid with folder.'')')
	      RETURN_
	   END IF
	ELSE IF (SINCE) THEN
	   IF (BULL_POINT.EQ.0) THEN 
	      WRITE (6,'('' ERROR: No current message.'')')
	      RETURNY
	   ELSE IF (NEWS) THEN 
	      STARTMSG = BULL_POINT
	   ELSE
	      START_BTIM(1) = MSG_BTIM(1)
	      START_BTIM(2) = MSG_BTIM(2)
	   END IF
	ELSE IF (.NOT.NEWS) THENL
	   CALL SYS_BINTIM('6-NOV-1956 00:00:00.00',START_BTIM)
	ELSEK
	   STARTMSG = 1
	END IF	
 P
	CALL DISABLE_CTRL
	CALL DECLARE_CTRLC_AST(
	IF (FOLDER_PRESENT) THEN 
	   CALL OPEN_BULLINF_SHARED
	   IER = 0 
	   DO WHILE (IER.EQ.0.AND.FLAG.NE.1)O
	      IF (ALL) THEN
	         DO WHILE (REC_LOCK(IER))
	            READ (9,IOSTAT=IER) TEMP_USER,LAST
	         END DO
	      ELSE	
		 IF (NEWS) THENI
		    LU = TRIM(TEMP_USER)
		    TEMP_USER(LU:LU) = CHAR(128.OR.ICHAR(TEMP_USER(LU:LU)))H
		    IF (LU.GT.1) THENC
		       TEMP_USER(LU-1:LU-1) =S
     &			        CHAR(128.OR.ICHAR(TEMP_USER(LU-1:LU-1)))L
		    ELSE
		       TEMP_USER(2:2) = CHAR(128.OR.ICHAR(TEMP_USER(2:2)))
	 	    END IFT
	 	 END IF
	         DO WHILE (REC_LOCK(IER))
	            READ (9,KEY=TEMP_USER,IOSTAT=IER) TEMP_USER,LASTS
	         END DO
	      END IF 
	      UNLOCK 9I
	      IF (IER.EQ.0) THEN%
	         LU = TRIM(TEMP_USER)
		 I = MAX(LU,2)
		 DO WHILE (I.GT.0.AND..NOT.BTEST(ICHAR(TEMP_USER(I:I)),7))
		    I = I - 1G
		 END DO 
		 IF (NEWS.AND.I.GE.LU.AND.I.NE.1.AND. 
     &		     BTEST(ICHAR(TEMP_USER(I-1:I-1)),7)) THEN=
		    TEMP_USER(I:I) = CHAR(ICHAR(TEMP_USER(I:I)).AND.127)
		    TEMP_USER(I-1:I-1) =
     &				 CHAR(ICHAR(TEMP_USER(I-1:I-1)).AND.127)
		    I = 0E
		    NEWSMSG = 1
		    DO WHILE (LAST2(1,NEWSMSG).NE.NEWS_FOLDER1_NUMBERN
     &					.AND.NEWSMSG.LE.FOLDER_MAX)
		       NEWSMSG = NEWSMSG + 1
	            END DO	
		    IF (NEWSMSG.LE.FOLDER_MAX) THEN 
		       FOUND = LAST(2,NEWSMSG).GE.STARTMSG
		    ELSE
		       FOUND = .FALSE.
		    END IF
		 ELSE IF (.NOT.NEWS.AND.I.EQ.0) THEN
		    FOUND = COMPARE_BTIM
     &			(START_BTIM,LAST(1,FOLDER1_NUMBER+1)).LE.0L
		 ELSE'
		    FOUND = .FALSE.I
		 END IFU
		 IF (FOUND.AND.NEWS) THENO
	            WRITE (6,'(1X,A,'' latest message read '',G
     &			I<LOG10(REAL(LAST(2,NEWSMSG)))+1>,''.'')')I
     &			TEMP_USER(:TRIM(TEMP_USER)),LAST(2,NEWSMSG)
		 ELSE IF (FOUND) THENE
		    CALL SYS$ASCTIM(,DATETIME,LAST(1,FOLDER1_NUMBER+1),)
	            WRITE (6,'(1X,A,'' latest message read '',A,''.'')')F
     &				TEMP_USER(:TRIM(TEMP_USER)),DATETIME
		 ELSE IF (.NOT.ALL) THEN
	            WRITE (6,'('' User has never read or not subscribed'',,
     &			'' to specified folder.'')')O
	         END IF
	      END IF 
	      IF (.NOT.ALL) THENA
		 IF (IER.NE.0) THEN 
		    WRITE (6,'('' User info does not exist.'')')
		 END IFl
		 IER = 2
	      END IF 
	   END DO
	   CALL CLOSE_BULLINF
	ELSE IF (.NOT.ALL) THEN
	   CALL OPEN_BULLUSER_SHARED 
	   CALL READ_USER_FILE_KEYNAME(TEMP_USER,IER)
	   IF (IER.EQ.0) THEN
	      IF (COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM).GE.0) THEN
	         WRITE (6,'('' NOLOGIN set for specified user.'')')
	      ELSEU
	         CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,)
	         WRITE (6,'('' User last logged in at '',A,''.'')')
     &						DATETIME
	      END IFD
	   ELSE
	      WRITE (6,'('' Entry for specified user not found.'')')E
	   END IF
	   CALL CLOSE_BULLUSER
	ELSE 
	   CALL OPEN_BULLUSER_SHARED 
	   CALL READ_USER_FILE(IER)
	   DO WHILE (IER.EQ.0.AND.FLAG.NE.1),
	      CALL READ_USER_FILE(IER)	
	      IF (IER.EQ.0.AND.TEMP_USER(:1).NE.':'.AND.C
     &				TEMP_USER(:1).NE.'*') THEN
		 IER1 = COMPARE_BTIM(LOGIN_BTIM,NOLOGIN_BTIM)O
		 IF (.NOT.CLI$PRESENT('LOGIN').AND.IER1.GE.0) THEN
	            WRITE (6,'('' NOLOGIN set for '',A,''.'')')
     &					TEMP_USER(:TRIM(TEMP_USER))
		 ELSE IF (.NOT.CLI$PRESENT('NOLOGIN').AND.IER1.LT.0.AND.
     &			  COMPARE_BTIM(START_BTIM,LOGIN_BTIM).LE.0) THENE
	            CALL SYS$ASCTIM(,DATETIME,LOGIN_BTIM,)O
	            WRITE (6,'(1X,A,'' last logged in at '',A,''.'')')
     &				TEMP_USER(:TRIM(TEMP_USER)),DATETIME
		 END IFC
	      END IFL
	   END DO
	   CALL CLOSE_BULLUSERO
	END IFN
	CALL CANCEL_CTRLC_AST
	CALL ENABLE_CTRLO
 R
	RETURN)
	END
  
 N
 F
  
	SUBROUTINE INIT_MESSAGE_ADD(IN_FOLDER,IN_FROM,IN_DESCRIP,IER)
Ce
C  SUBROUTINE INIT_MESSAGE_ADD
C=
C  FUNCTION:  Opens specified folder in order to add message.T
CA
C  INPUTS:
C	IN_FOLDER  - Character string containing folder name
C	IN_FROM	   - Character string containing name of owner of message.
C		     If empty, the message is searched for either a
C		     Reply-to: field or a From: field.  If none, then
C		     the owner of the process is used.  If IN_FROMF
C		     ends with a %, it is assumed that it is simply
C		     the prefix that should be when responding to the
C		     address via MAIL.  I.e. the PMDF interface sends
C		     IN%, so when the From: field is found, the message
C		     owner becomes IN%"from-address".
C	IN_DESCRIP - Character string containing subject of message.
C		     If empty, the message is searched for a line
C		     which starts with "Subj:" or "Subject:".
C  OUTPUTS:L
C	IER - Error status.  True if properly connected to folder.
C		False if folder not found.f
Ce
	IMPLICIT INTEGER (A - Z)R
  
	INCLUDE 'BULLFILES.INC'
  
	INCLUDE 'BULLFOLDER.INC'F
 A
	INCLUDE 'BULLDIR.INC'
 0
	COMMON /BCP/ BULLCP
	LOGICAL BULLCPA
 1
	COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROt
	CHARACTER*12 PROTOCOL
	DATA LPRO/0/0
 R
	COMMON /DIGEST/ LDESCR,FIRST_BREAKF
 A
	CHARACTER*(*) IN_FOLDER,IN_FROM,IN_DESCRIP
 
	COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPE
	COMMON /MAIN_HEADER_INFO/ INEXDATEn
	CHARACTER*(LINE_LENGTH) INFROM,INDESCRIPE
 A
	COMMON /TEXT_PRESENT/ TEXTR
 C
	COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM
	CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROMO
 R
	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(LINE_LENGTH) OLD_BUFFERT
 L
	COMMON /OLD_BUFFER_FROM/ OLD_BUFFER_FROMM
	DATA OLD_BUFFER_FROM /.FALSE./N
 N
	BULLCP = 1			! Inhibit folder cleanup subprocessT
 *
	CALL OPEN_BULLFOLDER			! Get folder fileT
 R
	CALL READ_FOLDER_FILE_KEYNAME(IN_FOLDER(:TRIM(IN_FOLDER)),IER)I
 E
	CALL CLOSE_BULLFOLDER
 E
	IF (IER.NE.0) THEN	
	   CALL ERRSNS(IDUMMY,IER)
	   RETURN
	ELSEI
	   IER = 1_
	END IFi
  
	ENTRY INIT_MESSAGE_ADD_BBOARD(IN_FROM,IN_DESCRIP,IER)
 U
	TEXT = .FALSE.			! No text written, as of yet
 E
	FIRST_BREAK = .TRUE.
 
	IF (FOLDER_NUMBER.EQ.0) THEN	! If GENERAL folder)
	   FOLDER_SET = .FALSE.		! indicate it 
	ELSE				! Else it's another folderD
	   FOLDER_SET = .TRUE.		! indicate it
	END IF0
 O
	FOLDER_FILE = FOLDER_DIRECTORY(:TRIM(FOLDER_DIRECTORY))//
     &		FOLDER			! set folder file names
 $
	ENTRY INIT_MESSAGE_ADD_DIGEST(IN_FROM,IN_DESCRIP,IER)
 _
	CALL OPEN_BULLDIR		! Open directory file1
 M
	CALL OPEN_BULLFIL		! Open data file
 	
	CALL READDIR(0,IER1)		! Get NBLOCKM
	IF (IER1.EQ.0) NBLOCK = 0	! If new file, NBLOCK is 0F
 E
	NBLOCK = NBLOCK + 1
	LENGTH = NBLOCK			! Initialize line count
 E
	LEN_FROM = TRIM(IN_FROM)N
 F
	IF (IN_FROM(LEN_FROM:LEN_FROM).EQ.'%') THEN	! Just protocol
	   PROTOCOL = IN_FROM(:LEN_FROM)//'"'
	   LPRO = LEN_FROM + 1F
	   LEN_FROM = 0
	END IFI
 (
	IF (LEN_FROM.GT.0) THEN
	   INFROM = IN_FROM
	   IF (.NOT.BTEST(FOLDER_FLAG,5)) THENC
	      CALL STORE_FROM(INFROM,LEN_FROM)'
	   ELSE	IF (INDEX(INFROM,'%"').GT.0) THEN	! Store any protocolF
	      LPRO = INDEX(INFROM,'%"') + 1
	      PROTOCOL = INFROM(:LPRO)
	   END IF
	   LEN_DESCRP = TRIM(IN_DESCRIP)'
	   IF (LEN_DESCRP.GT.0) THENe
	      INDESCRIP = IN_DESCRIPD
	      IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
	         CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)R
	      END IF
	   ELSE
	      DESCRIP = ' '
	   END IF
	ELSEP
	   OPEN (UNIT=3,STATUS='SCRATCH',FILE='SYS$LOGIN:BULL.SCR',
     &		FORM='FORMATTED',RECL=LINE_LENGTH,IOSTAT=IER1)
	   IF (IER1.NE.0) THEN
	      OPEN (UNIT=3,STATUS='SCRATCH',FILE='BULL.SCR',
     &		FORM='FORMATTED',RECL=LINE_LENGTH)
	   END IF
	   SAVE_IN_DESCRIP = IN_DESCRIP
	   SAVE_IN_FROM = ' '
	END IFN
 F
	OLD_BUFFER = ' 'T
 
	OLD_BUFFER_FROM = .FALSE.
  
	INEXDATE = .FALSE.'
 R
	RETURNr
	END
 a
 '
 )
	SUBROUTINE WRITEOUT_STORED 
 W
	CHARACTER*255 BUFFERS
  
	REWIND (UNIT=3)
 
	IER = 0
	DO WHILE (IER.EQ.0)
	   READ (3,'(A)',IOSTAT=IER) BUFFER
	   IF (IER.EQ.0) THEN
	      CALL WRITE_MESSAGE_LINE(BUFFER)
	   END IF
	END DO'
 A
	CLOSE (UNIT=3)
  
	RETURN=
	END
 I
 
 
	SUBROUTINE WRITE_MESSAGE_LINE(BUFFER)
C(
C  SUBROUTINE WRITE_MESSAGE_LINE
CL
C  FUNCTION:  Writes one line of message into folder.Q
CA
C  INPUTS:
C	BUFFER - Character string containing line to be put into message. 
C 
 A
	IMPLICIT INTEGER (A-Z)R
 S
	INCLUDE 'BULLDIR.INC'
  
	INCLUDE 'BULLFOLDER.INC'
  
	COMMON /MAIL_PROTOCOL/ PROTOCOL,LPRO(
	CHARACTER*12 PROTOCOL
 T
	COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPL
	COMMON /MAIN_HEADER_INFO/ INEXDATE2
	CHARACTER*(LINE_LENGTH) INFROM,INDESCRIPL
 
	COMMON /DIGEST/ LDESCR,FIRST_BREAK.
	DATA FIRST_BREAK/.TRUE./ 
 E
	COMMON /TEXT_PRESENT/ TEXT 
 W
	COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM
	CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROM
  
	CHARACTER*(*) BUFFERC
 I
	COMMON /LAST_BUFFER/ OLD_BUFFER
	CHARACTER*(LINE_LENGTH) OLD_BUFFERX
 ,
	COMMON /OLD_BUFFER_FROM/ OLD_BUFFER_FROMR
	DATA OLD_BUFFER_FROM /.FALSE./ 
 G
	COMMON /DATE/ DATE_LINE
	CHARACTER*(LINE_LENGTH) DATE_LINE
  
	CHARACTER*23 TODAYS
 I
	LEN_BUFFER = TRIM(BUFFER)
 U
	IF (LEN_FROM.EQ.0) THEN
	   WRITE (3,'(A)') BUFFER(:LEN_BUFFER):
	   IF (OLD_BUFFER_FROM.AND.BUFFER(:1).EQ.' ') THEN.
	      SAVE_IN_FROM = 
     &		SAVE_IN_FROM(:TRIM(SAVE_IN_FROM))//BUFFER.
	      OLD_BUFFER_FROM = .FALSE.
	   ELSE IF (BUFFER(:5).EQ.'From:') THEN
	      IF (LEN_BUFFER.GE.7) SAVE_IN_FROM = BUFFER(7:)S
	      OLD_BUFFER_FROM = .TRUE.F
	      RETURNE
	   ELSE IF (BUFFER(:9).EQ.'Subject: ') THEN
	      LDESCR = LEN_BUFFER - 9
	      INDESCRIP = BUFFER(10:)
	   ELSE IF (BUFFER(:9).EQ.'Reply-to:'.AND.SAVE_IN_FROM.EQ.' ') THEN
	      IF (LEN_BUFFER.GE.11) SAVE_IN_FROM = BUFFER(11:)U
	      OLD_BUFFER_FROM = .TRUE. 
	      RETURNE
	   ELSE IF (LEN_BUFFER.EQ.0) THEN
	      IF (SAVE_IN_FROM.EQ.' ') CALL GETUSER(SAVE_IN_FROM)
	      LEN_FROM = TRIM(SAVE_IN_FROM)
	      IF (LEN_FROM.GT.0) THEN
		 OLD_BUFFER_FROM = .FALSE.
		 INFROM = SAVE_IN_FROM
		 IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
		    CALL STORE_FROM(INFROM,LEN_FROM)
		 ELSE IF (INDEX(INFROM,'%"').GT.0) THENI
		    LPRO = INDEX(INFROM,'%"') + 1 
		    PROTOCOL = INFROM(:LPRO)
		 END IF 
		 IF (LDESCR.GT.0) THEN
		    LEN_DESCRP = LDESCR'
	            CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)
		 ELSEE
	            LEN_DESCRP = TRIM(SAVE_IN_DESCRIP)s
	            IF (LEN_DESCRP.GT.0) THEN
	               INDESCRIP = SAVE_IN_DESCRIP 
	               IF (.NOT.BTEST(FOLDER_FLAG,5)) THENL
	                  CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)
	               END IF
	            ELSEI
		       DESCRIP = ' '
		    END IF
		 END IFE
	         CALL WRITEOUT_STORED
	      END IFc
	   END IF
	   OLD_BUFFER_FROM = .FALSE.A
	   RETURN
	END IFM
	IF (BTEST(FOLDER_FLAG,5)) THEN6
	   IF (INDEX(BUFFER,'-------------').EQ.1) THEN
	      BREAK = .TRUE.E
	      DO I=1,LEN_BUFFER
		 IF (BUFFER(I:I).NE.'-') BREAK = .FALSE.
	      END DO 
	   ELSE
	      BREAK = .FALSE.
	   END IF
	   IF (BREAK) THENA
	      IF (.NOT.FIRST_BREAK) THEN
		 CALL FINISH_MESSAGE_ADD
	         CALL INIT_MESSAGE_ADD_DIGEST(INFROM,INDESCRIP,IER)
	      ELSEU
		 FIRST_BREAK = .FALSE.
	      END IF(
	      LFROM = 0
	      LDESCR = 0T
	      RETURNO
	   ELSE IF (.NOT.FIRST_BREAK) THEN(
	      IF (LDESCR.EQ.0) THEN
	         IF (BUFFER(:9).EQ.'Subject: ') THEN,
		    LDESCR = LEN_BUFFER - 9:
	            CALL STORE_DESCRP(BUFFER(10:),LDESCR)
		    IF (LFROM.EQ.0) THEN
		       LFROM = LEN_FROM_
	               CALL STORE_FROM(INFROM,LFROM) 
		    END IF
		 ELSE IF (BUFFER(:6).EQ.'From: ') THEN
		    LFROM = LEN_BUFFER - 6
		    IF (LFROM.LE.0) THEN
		       LFROM = TRIM(SAVE_IN_FROM)	
		       IF (LPRO.GT.0) THEN
		          LFROM = LFROM + LPRO + 1
	                  CALL STORE_FROM(PROTOCOL(:LPRO)//
     &			   SAVE_IN_FROM//'"',LFROM)
		       ELSEA
	                  CALL STORE_FROM(SAVE_IN_FROM,LFROM)
		       END IFA
		    ELSE IF (LPRO.GT.0) THEN
		       LFROM = LFROM + LPRO + 1e
	               CALL STORE_FROM(PROTOCOL(:LPRO)// 
     &			BUFFER(7:LEN_BUFFER)//'"',LFROM)a
		    ELSE
	               CALL STORE_FROM(BUFFER(7:),LFROM)p
		    END IF
		 END IFe
		 RETURNr
	      END IFl
	   ELSE
	      RETURNe
	   END IF
	END IF	
  
	IF (LEN_BUFFER.EQ.0) THEN		! If empty lineO
	   CALL STORE_BULL(1,' ',NBLOCK)	! just store one space
	ELSE 
	   IF (LEN_DESCRP.EQ.0) THENn
	      IF (BUFFER(:9).EQ.'Subject: ') THEN
		 DESCRIP = BUFFER(INDEX(BUFFER,' ')+1:)N
		 LEN_DESCRP = LEN_BUFFER
	      END IFs
	   END IF
	   IF (.NOT.INEXDATE) THENe
	      IF (BUFFER(:9).EQ.'Expires: '.OR.
     &		  BUFFER(:11).EQ.'X-Expires: ') THEN
		 I = INDEX(BUFFER,' ')+1
		 NODATE = .FALSE. 
		 DO J=I,LEN_BUFFER
		    IF (BUFFER(J:J).EQ.','.OR.BUFFER(J:J).EQ.'-') THEN
		       BUFFER(J:J) = ' '
		    END IF
		 END DOt
	         CALL STR$UPCASE(BUFFER(I:),BUFFER(I:))
		 NODATE = .TRUE.
		 I = INDEX(BUFFER,' ')+1
		 EXDATE(3:3) = '-'
		 EXDATE(7:7) = '-'
		 DO WHILE (I.LE.LEN_BUFFER)A
		    IF (BUFFER(I:I).GE.'0'.AND.BUFFER(I:I).LE.'9') THEN 
		       IF (NODATE) THENR
			  IF (INDEX(BUFFER(I:),' ').EQ.2) THEN
			     EXDATE(1:2) = '0'//BUFFER(I:I)
			     I = I + 1M
			  ELSEI
			     EXDATE(1:2) = BUFFER(I:I+1)S
			     I = I + 2_
			  END IFI
			  NODATE = .FALSE.I
		       ELSEO
			  IF (LEN_BUFFER-I.EQ.1.OR.
     &			     INDEX(BUFFER(I:),' ').EQ.3) THEN   ! No century?
			     IER = SYS$ASCTIM(,TODAY,,)	   ! Get today's date
			     YEAR = INDEX(TODAY(6:),'-')R
			     EXDATE(8:) = TODAY(6+YEAR:7+YEAR)//BUFFER(I:I+1)
			     I = I + 2F
			  ELSED
			     EXDATE(8:) = BUFFER(I:I+3)
			     I = I + 4i
			  END IFe
		       END IF
		    ELSE IF (BUFFER(I:I).GE.'A'.AND.BUFFER(I:I).LE.'Z') THEN
		       EXDATE(4:6) = BUFFER(I:I+2)
		       I = I + 3
		    ELSE
		       I = I + 1
		    END IF
		 END DOL
		 INEXDATE = .TRUE.
	      END IFS
	   END IF
	   CALL STORE_BULL(MIN(LEN_BUFFER,LINE_LENGTH),BUFFER,NBLOCK)
	   TEXT = .TRUE.X
	END IFE
 	
	RETURN 
	END
 a
 f
 t
 E
	SUBROUTINE FINISH_MESSAGE_ADD
CF
C  SUBROUTINE FINISH_MESSAGE_ADD
Cf
C  FUNCTION:  Writes message entry into directory file and closes folder
Cr
C  NOTE:  Only should be run if INIT_MESSAGE_ADD was successful.
CE
 I
	IMPLICIT INTEGER (A-Z)I
 O
	INCLUDE 'BULLDIR.INC'
 	
	INCLUDE 'BULLFOLDER.INC'n
 s
	COMMON /DIGEST/ LDESCR,FIRST_BREAKI
 R
	COMMON /TEXT_PRESENT/ TEXT 
 N
	COMMON /MAIN_HEADER_INFO/ INFROM,INDESCRIP,LEN_FROM,LEN_DESCRPd
	COMMON /MAIN_HEADER_INFO/ INEXDATE!
	CHARACTER*(LINE_LENGTH) INFROM,INDESCRIPI
 e
	COMMON /SAVE_IN/ SAVE_IN_DESCRIP,SAVE_IN_FROM
	CHARACTER*(LINE_LENGTH) SAVE_IN_DESCRIP,SAVE_IN_FROMO
  
	CHARACTER*23 TODAYI
 I
	DIMENSION BIN_EXTIME(2)
 '
	IF (LEN_FROM.EQ.0) THEN
	   CALL GETUSER(FROM)
	   INFROM = FROM 
	   LEN_FROM = TRIM(INFROM)_
	   LEN_DESCRP = TRIM(SAVE_IN_DESCRIP)
	   IF (LEN_DESCRP.GT.0) THEN
	      INDESCRIP = SAVE_IN_DESCRIP
	      IF (.NOT.BTEST(FOLDER_FLAG,5)) THEN
	         CALL STORE_DESCRP(INDESCRIP,LEN_DESCRP)o
	      END IFF
	   ELSE
	      DESCRIP = ' '
	   END IF
	   CALL WRITEOUT_STORED
	END IFN
 F
	CALL FLUSH_BULL(NBLOCK)
 S
	CALL CLOSE_BULLFIL			! Finished adding bulletin
 R
	IF ((BTEST(FOLDER_FLAG,5).AND.LDESCR.EQ.0).OR.	! End of digest msg 
     &				.NOT.TEXT) THEN	! or no message text found
	   CALL CLOSE_BULLDIR			! then don't add message entry
	   RETURN
	END IFU
 S
	EXTIME = '00:00:00.00'U
	IF (INEXDATE) THENM
	   IER = SYS_BINTIM(EXDATE//' '//EXTIME,BIN_EXTIME)
	   IF (IER) THEN			! If good date format'
	      IER = SYS$ASCTIM(,TODAY,,)	! Get today's date
	      IER = COMPARE_DATE(EXDATE,TODAY(:11)) ! Compare date with today's
	      IF ((IER.GT.F_EXPIRE_LIMIT.AND.F_EXPIRE_LIMIT.GT.0) ! Too great?A
     &		.OR.IER.LE.0) THEN		! or expiration date not future)
	         INEXDATE = .FALSE.		! Don't use it
	      END IF 
	   ELSE
	      INEXDATE = .FALSE.		! Don't use it)
	   END IF
	END IFO
 T
	IF (.NOT.INEXDATE) THEN
	   IF (FOLDER_BBEXPIRE.EQ.-1) THEN	! Folder has expiration time?D
	      EXDATE = '5-NOV-2000'		! no, so set date far in futureB
	      SYSTEM = 2			! indicate permanent message
	   ELSE					! Else set expiration date 
	      CALL GET_EXDATE(EXDATE,FOLDER_BBEXPIRE)
	      SYSTEM = 0-
	   END IF
	END IFt
 i
	LENGTH = NBLOCK - LENGTH + 1		! Number of records
 E
	CALL ADD_ENTRY				! Add the new directory entry
 '
	CALL CLOSE_BULLDIR			! Totally finished with addC
 L
	CALL UPDATE_FOLDERR
 C
	RETURNC
	END
 I
 E
 R
 F
	SUBROUTINE STORE_FROM(IFROM,LEN_INFROM)
 M
	IMPLICIT INTEGER (A-Z)E
 T
	COMMON /MAIL_PROTOCOL/ PROTOCOL,LPROE
	CHARACTER*12 PROTOCOL
 /
	INCLUDE 'BULLDIR.INC'
  
	CHARACTER*(*) IFROM
 
	CHARACTER*(LINE_LENGTH) INFROM
 M
	INFROM = IFROME
 _
	IF (LPRO.GT.0) THEN			! Protocol present?
	   I = INDEX(INFROM,'%"') + 2		! Make usable for VMS MAIL
	   IF (I.EQ.2) THEN
	      INFROM = PROTOCOL(:LPRO)//INFROM(:LEN_INFROM)//'"'
	      I = LPRO + 1R
	      LEN_INFROM = LEN_INFROM + LPRO + 1 
	   END IF
	   DO WHILE (I.LT.LEN_INFROM)
	      IF (INFROM(I:I).EQ.'"') THEN
		 INFROM(I:I) = ''''I
	      ELSE IF (INFROM(I:I).EQ.'\') THEN
		 INFROM(I+1:) = '\'//INFROM(I+1:) 
		 LEN_INFROM = LEN_INFROM + 1
		 I = I + 1
	      ELSE IF (INFROM(I:I).EQ.'''') THENN
		 INFROM(I:) = '\s'//INFROM(I+1:)
		 LEN_INFROM = LEN_INFROM + 1
		 I = I + 2
	      END IF 
	      I = I + 1
	   END DO
	END IF
  
	DO I=1,LEN_INFROM			! Remove control characters
	   IF (INFROM(I:I).LT.' ') INFROM(I:I) = ' 'R
	END DOL
 I
	DO WHILE (LEN_INFROM.GT.0.AND.INFROM(:1).EQ.' ') 
	   INFROM = INFROM(2:)D
	   LEN_INFROM = LEN_INFROM - 1 
	END DO9
 Q
	TWO_SPACE = INDEX(INFROM,'  ')'
	DO WHILE (TWO_SPACE.GT.0.AND.TWO_SPACE.LT.LEN_INFROM)
	   INFROM = INFROM(:TWO_SPACE)//INFROM(TWO_SPACE+2:)T
	   LEN_INFROM = LEN_INFROM - 10
	   TWO_SPACE = INDEX(INFROM,'  ')
	END DOG
 S
	CALL STORE_BULL(6+LEN_INFROM,'From: '//INFROM(:LEN_INFROM),
     &		NBLOCK)0
 H
	IF (INDEX(INFROM,'%"').GT.0)		! Strip off protocol program	
     &		INFROM = INFROM(INDEX(INFROM,'%"')+2:)
 O
	IF (INDEX(INFROM,'::').GT.0)		! Strip off node name
     &		INFROM = INFROM(INDEX(INFROM,'::')+2:)	! I.e. HOST::USER
 =
	CALL GET_FROM(INFROM,LEN_INFROM)L
 C
	RETURNH
	END
  
 _
	SUBROUTINE GET_FROM(INFROM,LEN_INFROM)_
 C
	IMPLICIT INTEGER (A-Z)
 E
	INCLUDE 'BULLDIR.INC'
 R
	CHARACTER*(*) INFROMP
 
	DO WHILE (INDEX(INFROM,'!').GT.0.AND.	! Unix address go backwards.A
     &		INDEX(INFROM,'!').LT.INDEX(INFROM,'@'))L
	   INFROM = INFROM(INDEX(INFROM,'!')+1:)	! I.e. host!user
	END DON
 S
	DO WHILE (INDEX(INFROM,'<').GT.0.AND.	! Name may be of form
     &		INDEX(INFROM,'@').GT.INDEX(INFROM,'<'))A
	   INFROM = INFROM(INDEX(INFROM,'<')+1:)! personal-name <net-name> 
	END DO
  
	DO WHILE (INDEX(INFROM,'(').GT.0.AND.	! personal-name (net-name)U
     &		INDEX(INFROM,'@').GT.INDEX(INFROM,'(')).
	   INFROM = INFROM(INDEX(INFROM,'(')+1:)F
	END DON
 -
	I = 1	! Trim username to start at first alpha character
	DO WHILE (I.LE.LEN_INFROM.AND.(INFROM(I:I).EQ.' '.OR.
     &		INFROM(I:I).EQ.'%'.OR.INFROM(I:I).EQ.'.'.OR.
     &		INFROM(I:I).EQ.'@'.OR.INFROM(I:I).EQ.'<'.OR.
     &		INFROM(I:I).EQ.'"'.OR.INFROM(I:I).EQ.'''')) 
	   I = I + 1 
	END DO0
	INFROM = INFROM(I:)
  
	I = 1		! Trim username to end at a alpha character 
	DO WHILE (I.LE.12.AND.INFROM(I:I).NE.' '.AND.
     &		INFROM(I:I).NE.'%'.AND.INFROM(I:I).NE.'.'.AND.
     &		INFROM(I:I).NE.'@'.AND.INFROM(I:I).NE.'<'.AND.
     &		INFROM(I:I).NE.'"'.AND.INFROM(I:I).NE.'''')
	   I = I + 1 
	END DOE
	FROM = INFROM(:I-1)
  
	DO J=2,I-1E
	   IF ((FROM(J:J).GE.'A'.AND.FROM(J:J).LE.'Z').AND.
     &	       ((FROM(J-1:J-1).GE.'A'.AND.FROM(J-1:J-1).LE.'Z').OR.
     &	        (FROM(J-1:J-1).GE.'a'.AND.FROM(J-1:J-1).LE.'z'))) THENP
	      FROM(J:J) = CHAR(ICHAR(FROM(J:J))-ICHAR('A')+ICHAR('a')) 
	   END IF
	END DO/
 ,
	RETURN	
	END
 S
 
  
  
	SUBROUTINE STORE_DESCRP(INDESCRIP,LEN_DESCRP)
  
	IMPLICIT INTEGER (A-Z)I
 L
	INCLUDE 'BULLDIR.INC'
 R
	CHARACTER*(*) INDESCRIP
  
	CALL CONVERT_TABS(INDESCRIP,LEN_DESCRP)
 
	DO I=1,LEN_DESCRP			! Remove control characters
	   IF (INDESCRIP(I:I).LT.' ') INDESCRIP(I:I) = ' 'M
	END DO 
  
	DO WHILE (LEN_DESCRP.GT.0.AND.INDESCRIP(:1).EQ.' ')
	   INDESCRIP = INDESCRIP(2:)D
	   LEN_DESCRP = LEN_DESCRP - 1H
	END DOe
 y
	IF (LEN_DESCRP.GT.LEN(DESCRIP)) THENK
				! Is length > allowable subject length?_
	   CALL STORE_BULL(6+LEN_DESCRP,'Subj: '//'
     &		INDESCRIP(:LEN_DESCRP),NBLOCK)
	END IFR
 '
	DESCRIP = INDESCRIP(:MIN(LEN_DESCRP,LEN(DESCRIP))) 
 N
	RETURN 
	END
 I
 D
 )
 E
 
	SUBROUTINE STRIP_HEADER(BUFFER,BLEN,IER) 
C&
C  SUBROUTINE STRIP_HEADER
C'
C  FUNCTION:  Indicates whether line is part of mail message header.
CU
C  INPUTS:
C	BUFFER	- Character string containing input line of message.F
C	BLEN	- Length of character string.  If = 0, initialize subroutine.
CR
C  OUTPUTS::
C	IER	- If true, line should be stripped.  Else, end of header.)
C'
	IMPLICIT INTEGER (A - Z)	
  
	INCLUDE 'BULLDIR.INC'
 	
	INCLUDE 'BULLFOLDER.INC'A
 B
	COMMON /DATE/ DATE_LINE
	CHARACTER*(LINE_LENGTH) DATE_LINE
 D
	COMMON /REMOTE_FOLDER/ REMOTE_SET,REMOTE_UNIT
  
	CHARACTER*(*) BUFFER 
  
	IF (TRIM(BUFFER).EQ.0) THEN
			! If STRIP not set for folder or empty line
	   IER = .FALSE.	
	   CONT_LINE = .FALSE. 
	   RETURN
	END IFL
 B
	IF (BLEN.EQ.0) THEN
	   DATE_LINE = ' 'R
	   CONT_LINE = .FALSE.N
	END IF?
 	
	IER = .TRUE.$
 T
	IF (CONT_LINE.AND.(BUFFER(:1).EQ.' '.OR.   ! If line is continuationR
     &		BUFFER(:1).EQ.CHAR(9))) RETURN	   ! of previous header line 
  
	I = 1
	DO WHILE (I.LE.BLEN.AND.BUFFER(I:I).NE.' ')
	   IF (BUFFER(I:I).EQ.':') THEN	! Header line found
	      CONT_LINE = .TRUE.	! Next line might be continuation
	      IF (REMOTE_SET.NE.3.AND.BUFFER(:5).EQ.'Date:') THEN
		 DATE_LINE = 'Message sent'//BUFFER(5:BLEN)E
		 IF (DATE_LINE(TRIM(DATE_LINE):).NE.'.') THEN 
		    DATE_LINE(TRIM(DATE_LINE)+1:) = '.'L
	         END IF
	      END IFE
	      RETURNE
	   ELSE
	      I = I + 1
	   END IF
	END DOO
 N
	IER = .FALSE.
	CONT_LINE = .FALSE.
 I
	RETURNA
	END
