-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+ X subroutine qiosend (buffer,length) X implicit none X include 'netio.inc' X include 'structures.inc' X character *(*) buffer X character *32 string X integer *4 status,sys$qiow,func,length X integer *2 iochan X logical *4 qcflag,qqflag X record /iosb_type/ iosb X common /info/ iochan,qcflag,qqflag X X if (.not.qcflag) then X call output_error('You are not connected to a server - '// X + 'use the /SERVER command.') X return X endif X func = io$_send X status = sys$qiow(,%val(iochan),%val(func),%ref(iosb),,, X + %ref(buffer),%val(length),,,,) X if (.not.status) call lib$signal(%val(status)) X if (.not.iosb.status) call iosb_error(iosb.status,.false.) X end X X X subroutine qioreceive X implicit none X include 'netio.inc' X include 'structures.inc' X character *4096 part X integer *4 status,sys$qio,func,length,plen X integer *2 iochan X logical *4 qcflag,qqflag X record /multirec/ multi X external ast_comp X common /info/ iochan,qcflag,qqflag X common /incomplete/ part,plen X X func = io$_receive X multi.iosb.bytecount = 0 X if (qcflag.and..not.qqflag) then X status = sys$qio(,%val(iochan),%val(func),%ref(multi.iosb), X + ast_comp,multi,%ref(multi.buffer),%val(4096),,,,) X if (.not.status) call lib$signal(%val(status)) X endif X end X X X subroutine ast_comp (multi) X implicit none X include 'structures.inc' X integer *2 iochan X logical *4 qcflag,qqflag X record /multirec/ multi X common /info/ iochan,qcflag,qqflag X X multi.iosb.other = 0 X if (.not.multi.iosb.status) X + call iosb_error(multi.iosb.status,.false.) X if (multi.iosb.bytecount.gt.0) then X call lineset(multi.buffer,multi.iosb.bytecount) X call qioreceive X else if (qcflag.and..not.qqflag) then X call output_error('The connection has been closed by '// X + 'the server.') X call output_text('* Use the /SERVER command to reconnect or '// X + 'select a different server.') X endif X end X X X******************************* INPUT ROUTINES ***************************** V**** X X X subroutine notification X implicit none X include 'constants.inc' X include 'structures.inc' X character *512 line X integer *4 i,llen X integer *2 iochan X logical *4 nflag,qcflag,qqflag X record /notedef/ note(maxnotify) X common /info/ iochan,qcflag,qqflag X common /notify/ nflag,note X X if (.not.nflag) return X line = 'ISON' X llen = 4 X do i = 1,maxnotify X if (note(i).nlen.ne.0) then X line = line(1:llen)//' '//note(i).nick X llen = llen + 1 + note(i).nlen X endif X enddo X if (llen.gt.4) call qiosend(line(1:llen)//char(13),llen+1) X call launch_notify X end X X X subroutine interactive X implicit none X include '($smgdef)' X include '($smgmsg)' X include 'constants.inc' X include 'structures.inc' X character *512 buffer,sbuf,oldbuf(0:cmdbuf) X character *256 chlnam(maxchn),prime X character *144 logfile X character *8 kname X integer *4 i,disp,past,keyb,spos,curr,olen(0:cmdbuf) X integer *4 length,code,status,smg$read_keystroke,level X integer *4 chllen(maxchn),primelen,ccount,lpos,oldchars X integer *4 lines,bol,eol,ls,cut,lglen,llun,klen X integer *2 iochan X logical *4 bflag,eflag,mflag,lflag,wflag,nflag,sflag,dflag X logical *4 treset,qcflag,qqflag X record /keydef/ key(maxkey) X record /aliasdef/ alias(maxalias) X record /notedef/ note(maxnotify) X common /info/ iochan,qcflag,qqflag X common /border/ ccount,chlnam,chllen X common /prime/ prime,primelen X common /screen/ disp,past,keyb,spos,curr,bol,eol X common /brdcst/ bflag X common /logging/ lflag,logfile,lglen,llun X common /away/ wflag X common /keys/ key X common /aliases/ alias X common /notify/ nflag,note X common /tab/ sflag,oldchars,treset X common /debug/ dflag X X ccount = 0 X bflag = .false. X eflag = .false. X mflag = .false. X wflag = .false. X dflag = .false. X status = 1 X oldbuf(0) = char(0) X olen(0) = 0 X lines = 1 X ls = eol - bol + 1 X do i = 1,maxchn X chllen(i) = 0 X enddo X do while ((status).and..not.(qqflag)) X code = 0 X curr = bol X buffer = char(0) X length = 0 X level = 0 X lpos = 1 X lines = 1 X do while ((code.ne.smg$k_trm_ctrlm).and.(status.ne.smg$_eof) X + .and.(length.lt.500)) X call smg$set_cursor_abs(disp,spos,curr) X status = smg$read_keystroke(keyb,code) X X* Key = Control-Null, display current settings. X X if (code.eq.smg$k_trm_null_char) then X call output_text('**** CURRENT SETUP ****') X if (mflag) then X call output_text('* Insert mode.') X else X call output_text('* Overstrike mode.') X endif X if (bflag) then X call output_text('* Broadcasts will not be displayed.') X else X call output_text('* Broadcasts will be displayed.') X endif X if (dflag) then X call output_text('* Debug mode is on.') X else X call output_text('* Debug mode is off.') X endif X if (nflag) then X call output_text('* Notification is being performed.') X else X call output_text('* Notification is not being performed.') X endif X if (sflag) then X call output_text('* Terminal tabs are not interpreted.') X else X call output_text('* Terminal tabs are interpreted.') X endif X do i = 1,maxkey X if (key(i).key.ne.-1) then X call get_keyname(key(i).key,kname) X call str$trim(kname,kname,klen) X if (key(i).text(key(i).tlen:key(i).tlen).eq. X + char(13)) then X call output_text('* Key: '//kname(1:klen)//' = "'// X + key(i).text(1:key(i).tlen-1)//'"') X else X call output_text('* Key: '//kname(1:klen)//' = "'// X + key(i).text(1:key(i).tlen)//'"') X endif X endif X enddo X do i = 1,maxalias X if (alias(i).nlen.ne.0) then X if (alias(i).text(alias(i).tlen:alias(i).tlen).eq. X + char(13)) then X call output_text('* Alias: '// X + alias(i).name(1:alias(i).nlen)//' = "'// X + alias(i).text(1:alias(i).tlen-1)//'"') X else X call output_text('* Alias: '// X + alias(i).name(1:alias(i).nlen)//' = "'// X + alias(i).text(1:alias(i).tlen)//'"') X endif X endif X enddo X X* Key = Control-A, insert/overstrike mode toggle. X X else if (code.eq.smg$k_trm_ctrla) then X mflag = .not.mflag X if (mflag) then X call output_text('* Insert mode.') X else X call output_text('* Overstrike mode.') X endif X X* Key = Control-D, tab toggle. X X else if (code.eq.smg$k_trm_ctrld) then X sflag = .not.sflag X call set_tab X if (sflag) then X call output_text('* Terminal tabs are not interpreted.') X else X call output_text('* Terminal tabs are interpreted.') X endif X X* Key = Control-E, move to end of line. X X else if (code.eq.smg$k_trm_ctrle) then X lines = (length-1)/ls + 1 X cut = length - (lines-1) * ls X if (cut.eq.ls) then X curr = eol X else X curr = bol + cut X endif X lpos = length + 1 X call smg$erase_line(disp,spos,bol) X call smg$put_chars(disp, X + buffer((lines-1)*ls+1:length),spos,bol) X X* Key = Control-G, toggle logging. X X else if (code.eq.smg$k_trm_ctrlg) then X lflag = .not.lflag X if (lflag) then X call lib$get_lun(llun) X call smg$set_cursor_abs(disp,spos+1,1) X call sys$setast(%val(0)) X call smg$read_string(keyb,logfile, X + 'Name of file> ',144,,,,lglen,,disp) X call sys$setast(%val(1)) X call smg$erase_line(disp,spos+1,1) X open(llun,file=logfile(1:lglen),status='unknown', X + access='append',carriagecontrol='list') X call output_text('* Logging enabled.') X else X call output_text('* Logging disabled.') X close(llun) X call lib$free_lun(llun) X endif X X* Key = Control-H, move to beginning of line. X X else if (code.eq.smg$k_trm_ctrlh) then X lines = 1 X curr = bol X lpos = 1 X call smg$erase_line(disp,spos,bol) X if (length.le.ls) then X call smg$put_chars(disp,buffer(1:length),spos,bol) X else X call smg$put_chars(disp,buffer(1:ls),spos,bol) X endif X X* Key = (Control-I,Tab), switch primary channel. X X else if (code.eq.smg$k_trm_ctrli) then X if (ccount.gt.1) then X call switch_order X call label_border X endif X X* Key = Control-N, notification display toggle. X X else if (code.eq.smg$k_trm_ctrln) then X nflag = .not.nflag X if (nflag) then X call output_text('* Notification will be performed.') X call launch_notify X else X call output_text('* Notification will not be performed.') X call cancel_launch_notify X endif X X* Key = Control-P, broadcast display toggle. X X else if (code.eq.smg$k_trm_ctrlp) then X bflag = .not.bflag X if (bflag) then X call output_text('* Broadcasts will not be displayed.') X else X call output_text('* Broadcasts will be displayed.') X endif X X* Key = Control-R, debug toggle. X X else if (code.eq.smg$k_trm_ctrlr) then X dflag = .not.dflag X if (dflag) then X call output_text('* Entered raw debug mode.') X else X call output_text('* Exited raw debug mode.') X endif X X* Key = (Control-U,Control-X), delete the line. X X else if ((code.eq.smg$k_trm_ctrlu).or. X + (code.eq.smg$k_trm_ctrlx)) then X call smg$erase_line(disp,spos,bol) X buffer = buffer(lpos:length) X length = length - lpos + 1 X lines = (length-1)/ls + 1 X call smg$put_chars(disp, X + buffer((lines-1)*ls+1:(lines-1)*ls+ls),spos,bol) X curr = bol X lpos = 1 X X* Key = Control-W, redraw the screen. X X else if (code.eq.smg$k_trm_ctrlw) then X call smg$repaint_screen(past) X X* Key = Delete, delete a character. X X else if (code.eq.smg$k_trm_delete) then X if (curr.gt.bol) then X curr = curr - 1 X call smg$erase_chars(disp,1,spos,curr) X buffer = buffer(1:lpos-2)//buffer(lpos:length) X call smg$erase_line(disp,spos,curr) X call smg$put_chars(disp,buffer(lpos-1:length-1), X + spos,curr) X length = length - 1 X lpos = lpos - 1 X else if (lines.gt.1) then X curr = eol X lines = lines - 1 X call smg$erase_line(disp,spos,bol) X if (lpos.ne.length+1) then X buffer = buffer(1:lpos-2)//buffer(lpos:length) X else X buffer = buffer(1:length-1) X endif X call smg$put_chars(disp, X + buffer((lines-1)*ls+1:(lines-1)*ls+ls),spos,bol) X call smg$set_cursor_abs(disp,spos,eol) X length = length - 1 X lpos = lpos - 1 X endif X X* Key = (Up_Arrow,Control-B), recall previous command. X X else if ((code.eq.smg$k_trm_ctrlb).or. X + (code.eq.smg$k_trm_up)) then X level = level + 1 X if (level.gt.cmdbuf) level = cmdbuf X buffer = oldbuf(level) X length = olen(level) X lines = (length-1)/ls + 1 X lpos = length + 1 X cut = length - (lines-1) * ls X if (cut.eq.ls) then X curr = eol X else X curr = bol + cut X endif X call smg$erase_line(disp,spos,bol) X call smg$put_chars(disp, X + buffer((lines-1)*ls+1:length),spos,bol) X X* Key = Down_Arrow, recall next command. X X else if (code.eq.smg$k_trm_down) then X level = level - 1 X if (level.le.0) level = 0 X buffer = oldbuf(level) X length = olen(level) X lines = (length-1)/ls + 1 X lpos = length + 1 X cut = length - (lines-1) * ls X if (cut.eq.ls) then X curr = eol X else X curr = bol + cut X endif X call smg$erase_line(disp,spos,bol) X call smg$put_chars(disp, X + buffer((lines-1)*ls+1:length),spos,bol) X X* Key = Left_Arrow, move the cursor one space to the left. X X else if (code.eq.smg$k_trm_left) then X if (curr.gt.bol) then X curr = curr - 1 X lpos = lpos - 1 X call smg$set_cursor_abs(disp,spos,curr) X else if (lines.gt.1) then X curr = eol X lpos = lpos - 1 X lines = lines - 1 X call smg$erase_line(disp,spos,bol) +-+-+-+-+-+-+-+- END OF PART 3 +-+-+-+-+-+-+-+-