	program sendme
c  sends message to all terminals owned by caller's username
c  needs no privileges since only sends to your own username
c  message line truncated at 132 characters.
c  error handling bad since call exit(stat) puts messages into NETSERVER.LOG
c  instead of outputting anywhere immediately useful.
	implicit integer*4 (A-Z)
	include '($libdef)'
	include '($rmsdef)'
	include '($jpidef)'
	include '($brkdef)'

	character*12 username
	integer username_len, forstat, stat
	integer*2 iosb(4)
	character*132 line,message
	parameter bell=char(7)
	data carcon='8d8d0000'x	! CR posfix, CR prefix  to match SEND command

c  perform the system service call to get my own username
	pid=0
c  supposed to trim trailing blanks but doesn't   ????
	stat=lib$getjpi(jpi$_username,pid,,,username,username_len)
	if(.not.stat) call exit(stat)
	username_len=index(username//' ',' ') - 1  ! add blank so sure to find

	stat=lib$get_foreign(line,'_Message: ',len,)
	if( .not.stat .and. (stat.ne.rms$_eof) .and.
	1		    (stat.ne.lib$_inpstrtru) ) call exit(stat)
	call unquote(line,message,messlen)

	stat=sys$brkthruw(,	! event flag
	1		bell//'('//username(1:username_len)//') '
	1		//message(1:messlen),	! message 
	1		username,	! sendto
	1		%val(brk$c_username),	! sendtype
	1		iosb,	! IOSB
	1		carcon,	! carriage-control
	1		,	! flags
	1		,,,)	! reqid,timout,astadr,astprm
	if( (.not.stat) .or. (.not.iosb(1)) )  then
		print '( 4(1x,z4) )', iosb
	endif
	call exit(stat)
	end

      subroutine unquote( instr, outstr, outlen )
c  deletes single quotes and converts pairs to single quotes
c  if not in quotes compresses leading and internal spaces and capitalizes
c  strips trailing spaces
c  note: length integer*2
      character*1 ch, last
      character*(*) instr, outstr
      integer*2 outlen, ip, op
      logical*1 inq
 
      inq = .false.		! .true. if in quotes
      last = ' '
      op = 0			! output pointer
 
      do ip = 1, len( instr )	! input pointer
         ch = instr( ip:ip )
         if ( ch .eq. '"' ) then
            if ( .not. inq .and. last .eq. '"' ) then
               op = op + 1
               outstr( op:op ) = '"'
            end if
            inq = .not. inq
         else if ( inq ) then	! copy unchanged if in quotes
            op = op + 1
            outstr( op:op ) = ch
         else if ( ch .eq. ' ' .and. last .eq. ' ' ) then   ! compress spaces
            continue
         else if ( 'a' .le. ch .and. ch .le. 'z' ) then		! capitalize
            op = op + 1
            outstr( op:op ) = char( ichar( ch ) - 32 )
         else			! copy unchanged if not special
            op = op + 1
            outstr( op:op ) = ch
         end if
         last = ch
      end do
 
c  if passed outlen, then set it stripping trailing blank
      if ( %loc( outlen ) .ne. 0 ) then
         if ( last .eq. ' ' .and. .not. inq ) then
            outlen = op - 1
         else
            outlen = op
         end if
      end if
 
      return
 
      end
