CCFD8%vax2.sussex.ac.uk@CS.UCL.AC.UK (08/07/86)
Somebody wanted to do an inquire with timeout at the ops console. Here is
a kludgey program I whipped up four years ago to do this... It was
actually before lib$set_symbol was around, so it uses horrible cli callback
routines to set a local symbol (which I include for your amusement). At the
end is an example of its use.
Hope it helps
Brian Williams, Uni. of Sussex, England.
________________________________________________________________________________
implicit integer*4(a-z)
integer*4 tech(2)/0,0/
integer*2 text_iosb(4),term_chan
character text_buf*255,terminal*4/'OPA0'/,
1 prompt_msg*200,reply*2,null*1
external io$_readprompt, io$m_timed,
1 ss$_timeout
parameter (timeout=45) ! times out after 45 secs.
status = lib$get_foreign(prompt_msg,,i_s_len) ! get message text
if (.not. status) then
type *,' No prompt!!!'
goto 1000
endif
i_s_len=i_s_len+4
c
c add some bells
c
prompt_msg(i_s_len:i_s_len)=char(7)//char(7)//char(7)//' '
null_len=0
status = sys$assign(terminal, term_chan,,)
5 if (.not. status)then
i=deflocal('INQ$REPLY',null(1:null_len))
goto 1000
endif
io_func = %loc(io$_readprompt) .or.
1 %loc(io$m_timed)
tech(2)=2**13
100 status = sys$qiow (, %val(term_chan),
1 %val(io_func),
1 text_iosb,,,
1 %ref(text_buf), %val(255),
1 %val(timeout),%ref(tech(1)),
1 %ref(prompt_msg), %val(i_s_len))
if (.not. status)goto 5
if (text_iosb(1) .eq. %loc(ss$_timeout))then ! set INQ$REPLY to FALSE
i=deflocal('INQ$REPLY',null(1:null_len))
goto 1000
else
text_len = text_iosb(2)
status = str$upcase(text_buf,text_buf)
if (.not. status) call lib$stop(%val(status))
i=1
if (text_buf(i:i).ne.' ')goto 999
do while (text_buf(i:i).eq.' '.and.i.lt.text_len)
i=i+1
if (text_buf(i:i).ne.' ')goto 999
enddo
goto 100
endif
999 i=deflocal('INQ$REPLY',text_buf(i:text_len))
1000 end
integer*4 function clicallback(name,value)
c include 'sys$library:clidef.for'
parameter cli$k_cliserv = '00000005'x
parameter cli$k_crealog = '00000006'x
parameter cli$k_deflocal= '00000002'x
parameter cli$k_defglobal= '00000003'x
character*(*) name,value
integer*4 block(5),sys$cli
entry crealog(name,value)
block(1) =cli$k_cliserv+256*cli$k_crealog
goto 10
entry deflocal(name,value)
block(1) =cli$k_cliserv+256*cli$k_deflocal
goto 10
entry defglobal(name,value)
block(1) =cli$k_cliserv+256*cli$k_defglobal
10 block(2)=len(name)
block(3)=%loc(name)
block(4)=len(value)
block(5)=%loc(value)
deflocal=sys$cli(block)
return
end
________________________________________________________________________________
$ INQOP:=$SYS$SYSDEVICE:[CCSYSTEM.UTILS]INQOP
$ ! ------------------- QUICK EXIT-------------------
$ INQOP "Do you want to exit now?"
$ IF INQ$REPLY THEN set login/int=1
$ IF INQ$REPLY THEN logout
$ ! ------------------- VERIFY -------------------
$ INQOP "Do you want verify set?"
$ IF INQ$REPLY THEN SET VERIFY
$ ! ------------------- LOGINS -------------------
$ INQOP "Do you want logins set to 1?"
$ logins=40
$ IF INQ$REPLY THEN logins=1
.
.
.
etc