-+-+-+-+-+-+-+-+ START OF PART 7 -+-+-+-+-+-+-+-+ X return X X* Case PRIVMSG. X X else if (mrec.comm(1:mrec.clen).eq.'privmsg') then X call chop(mrec.rest,mrec.rlen,chan,chlen) X mark = index(mrec.rest,':') + 1 X mrec.rest = mrec.rest(mark:mrec.rlen) X mrec.rlen = mrec.rlen - mark + 1 X mark = index(mrec.rest,char(1)) X if (mark.gt.0) then X mark = index(mrec.rest,'ACTION') X if (mark.gt.0) then X mrec.rest = mrec.rest(mark+7:mrec.rlen-1) X mrec.rlen = mrec.rlen - 9 X text = mrec.nick(1:mrec.nlen)//' '//mrec.rest(1:mrec.rlen) X length = mrec.nlen + 1 + mrec.rlen X endif X else X call lowcase(chan,chlen) X if ((chan(1:1).eq.'#').or.(chan(1:1).eq.'&')) then X if ((ccount.gt.1).and.(chan(1:chlen).ne.prime(1:primelen))) X + then X text = '<'//chan(1:chlen)//'/'//mrec.nick(1:mrec.nlen)// X + '> '//mrec.rest(1:mrec.rlen) X length = 1 + chlen + 1 + mrec.nlen + 2 + mrec.rlen X else X text = '<'//mrec.nick(1:mrec.nlen)//'> '// X + mrec.rest(1:mrec.rlen) X length = 1 + mrec.nlen + 2 + mrec.rlen X endif X else X if (wflag) then X call sys$asctim(,dt,,) X if (dt(1:1).eq.' ') dt(1:1) = '0' X text = '*'//mrec.nick(1:mrec.nlen)//'* '// X + mrec.rest(1:mrec.rlen)//' ('//dt//')' X length = 1 + mrec.nlen + 2 + mrec.rlen + 2 + 23 + 1 X else X text = '*'//mrec.nick(1:mrec.nlen)//'* '// X + mrec.rest(1:mrec.rlen) X length = 1 + mrec.nlen + 2 + mrec.rlen X endif X endif X endif X X* Case QUIT. X X else if (mrec.comm(1:mrec.clen).eq.'quit') then X mark = index(mrec.rest(1:mrec.rlen),':') + 1 X text = 'Change: '//mrec.nick(1:mrec.nlen)// X + ' has signed off. ('//mrec.rest(mark:mrec.rlen)//')' X length = 8 + mrec.nlen + 18 + mrec.rlen + 1 X X* Case TOPIC. X X else if (mrec.comm(1:mrec.clen).eq.'topic') then X call chop(mrec.rest,mrec.rlen,dumm,dlen) X mark = index(mrec.rest(1:mrec.rlen),':') + 1 X text = mrec.nick(1:mrec.nlen)//' has changed the topic to "'// X + mrec.rest(mark:mrec.rlen)//'" on channel '//dumm(1:dlen)//'.' X length = mrec.nlen + 27 + mrec.rlen - mark + 1 + 13 + dlen + 1 X X* Case ERROR. X X else if (mrec.comm(1:mrec.clen).eq.'error') then X call untimely_exit(mrec.rest(1:mrec.rlen)) X X* Case UNHANDLED. X X else X if ((mrec.comm(1:1).eq.'4').or.(mrec.comm(1:1).eq.'5')) then X mark = index(mrec.rest(1:mrec.rlen),':') + 1 X text = 'Error: '//mrec.rest(mark:mrec.rlen) X length = 7 + mrec.rlen - mark + 1 X else if (mrec.comm(1:1).eq.'0') then X mark = index(mrec.rest(1:mrec.rlen),':') + 1 X text = mrec.rest(mark:mrec.rlen) X length = mrec.rlen - mark + 1 `20 X else X text = mrec.comm(1:mrec.clen)//' '//mrec.rest(1:mrec.rlen) X length = mrec.clen + 1 + mrec.rlen X endif X endif X X call output_text(text(1:length)) X end X X X subroutine linkinfo_list (line,length) X implicit none X character *(*) line X character *512 oline X character *80 link X character *16 senq,senm,senb,recm,recb X integer *4 length,llen,sqlen,smlen,sblen,rmlen,rblen X X call chop(line,length,link,llen) X call chop(line,length,senq,sqlen) X call chop(line,length,senm,smlen) X call chop(line,length,senb,sblen) X call chop(line,length,recm,rmlen) X call chop(line,length,recb,rblen) X line = line(index(line,':')+1:length) X call str$trim(line,line,length) X oline = link(1:llen)//','//senq(1:sqlen)//','//senm(1:smlen)// X + ','//senb(1:sblen)//','//recm(1:rmlen)//','//recb(1:rblen)// X + ' ('//line(1:length)//')' X length = llen + 1 + sqlen + 1 + smlen + 1 + sblen + 1 + rmlen + X + 1 + rblen + 2 + length + 1 X call output_text(oline(1:length)) X end X X X subroutine channel_list (line,length) X implicit none X character *(*) line X character *512 oline X character *20 chan X character *6 numb X integer *4 length,clen,nlen X X call chop(line,length,chan,clen) X call chop(line,length,numb,nlen) X line = line(index(line,':')+1:length) X if (line(1:1).eq.' ') then X line = char(0) X length = 0 X endif X if (chan(1:1).eq.'*') then X chan = '*Private*' X clen = 9 X line = char(0) X length = 0 X endif X if (length.gt.0) then X oline = chan//numb//line(1:length) X length = 20 + 6 + length X else X oline = chan//numb X length = 20 + 6 X endif X call output_text(oline(1:length)) X end X X X subroutine link_list (line,length) X implicit none X character *(*) line X character *512 oline X character *80 serv X integer *4 length,slen X X call chop(line,length,serv,slen) X line = line(index(line,':')+1:length) X call str$trim(line,line,length) X oline = serv(1:slen)//' ('//line(1:length)//')' X length = slen + 2 + length + 1 X call output_text(oline(1:length)) X end X X X subroutine who_list (line,length) X implicit none X character *(*) line X character *512 oline X character *80 host,serv X character *12 chan,nick,user,dumm X character *4 stat X integer *4 length,clen,ulen,hlen,slen,nlen,xlen,dlen,olen X X call chop(line,length,chan,clen) X call chop(line,length,user,ulen) X call chop(line,length,host,hlen) X call chop(line,length,serv,slen) X call chop(line,length,nick,nlen) X call chop(line,length,stat,xlen) X call chop(line,length,dumm,dlen)`20 X if (line(1:1).eq.' ') line = 'Name' X call str$trim(line,line,length) X oline = chan//' '//nick//' '//stat//user(1:ulen)//'@'// X + host(1:hlen)//' ('//line(1:length)//')' X length = 12 + 1 + 12 + 1 + 4 + ulen + 1 + hlen + 1 + length + 2 X call output_text(oline(1:length)) X end X X X***************************** UTILITY ROUTINES ***************************** V**** X X X logical *4 function key_in_use (key,value,kpos,kslot) X implicit none X include 'constants.inc' X include 'structures.inc' X integer *4 i,value,kpos,kslot X record /keydef/ key(maxkey) X X kslot = 0 X key_in_use = .false. X do i = maxkey,1,-1 X if (key(i).key.eq.-1) kslot = i X if (key(i).key.eq.value) then X key_in_use = .true. X kpos = i X endif X enddo X end X X X subroutine set_key (text,tlen,key,signal) X implicit none X include 'constants.inc' X include 'structures.inc' X character *(*) text X character *8 kname X character *4 cr X integer *4 tlen,klen,kval,slot,pos X logical *4 signal,rflag,crflag,key_in_use X record /keydef/ key(maxkey) X X rflag = .false. X crflag = .false. X call chop(text,tlen,kname,klen) X call lowcase(kname,klen) X call get_keyvalue(kval,kname(1:klen)) X if (kval.eq.-1) then X call output_error('Bad key name or undefinable key.') X return X else if (key_in_use(key,kval,pos,slot)) then X if (tlen.eq.0) then X key(pos).key = -1 X if (signal) call output_text('* Key has been undefined.') X return X else X rflag = .true. X slot = pos X endif X else if ((tlen.eq.0).or.(text.eq.' ')) then X if (signal) call output_error('No text accompanying key.') X return X endif X if (slot.eq.0) then X if (signal) call output_error('Key definition list is '// X + 'full - contact client supporter (MAXKEY).') X return X endif X if (tlen.gt.4) then X cr = text(tlen-3:tlen) X call lowcase(cr,4) X if (cr.eq.'') crflag = .true. X endif X if (crflag) then X text = text(1:tlen-4) X tlen = tlen - 4 X endif X if (text(1:1).eq.'"') then X key(slot).text = text(2:tlen-1) X key(slot).tlen = tlen - 2 X else X key(slot).text = text(1:tlen) X key(slot).tlen = tlen X endif X if (crflag) then X key(slot).text = key(slot).text(1:key(slot).tlen)//char(13) X key(slot).tlen = key(slot).tlen + 1 X endif X key(slot).key = kval X if (rflag) then X if (signal) call output_text('* Key has been redefined.') X else X if (signal) call output_text('* Key has been defined.') X endif X end X X X logical *4 function alias_in_use (alias,name,length,apos,aslot) X implicit none X include 'constants.inc' X include 'structures.inc' X character *12 name X integer *4 i,length,apos,aslot X record /aliasdef/ alias(maxalias) X X aslot = 0 X alias_in_use = .false. X do i = maxalias,1,-1 X if (alias(i).nlen.eq.0) aslot = i X if (alias(i).name(1:length).eq.name(1:length)) then X alias_in_use = .true. X apos = i X endif X enddo X end X X X subroutine set_alias (text,tlen,alias,signal) X implicit none X include 'constants.inc' X include 'structures.inc' X character *(*) text X character *12 aname X character *4 cr X integer *4 tlen,alen,slot,pos X logical *4 signal,rflag,alias_in_use X record /aliasdef/ alias(maxalias) X X rflag = .false. X call chop(text,tlen,aname,alen) X call lowcase(aname,alen) X if (alias_in_use(alias,aname,alen,pos,slot)) then X if (tlen.eq.0) then X alias(pos).nlen = 0 X if (signal) call output_text('* Alias has been undefined.') X return X else X rflag = .true. X slot = pos X endif X else if ((tlen.eq.0).or.(text.eq.' ')) then X if (signal) call output_error('No text accompanying alias.') X return X endif X if (slot.eq.0) then X if (signal) call output_error('Alias list is full - '// X + 'contact client supporter (MAXALIAS).') X return X endif X if (text(1:1).eq.'"') then X alias(slot).text = text(2:tlen-1) X alias(slot).tlen = tlen - 2 X else X alias(slot).text = text(1:tlen) X alias(slot).tlen = tlen X endif X alias(slot).name = aname X alias(slot).nlen = alen X if (rflag) then X if (signal) call output_text('* Alias has been redefined.') X else X if (signal) call output_text('* Alias has been defined.') X endif X end X X X subroutine set_notify (nick,nlen,signal) X implicit none X include 'constants.inc' X include 'structures.inc' X character *(*) nick X character *9 lownick X integer *4 i,nlen,slot X logical *4 signal,nflag X record /notedef/ note(maxnotify) X common /notify/ nflag,note X X do i = maxnotify,1,-1 X lownick = note(i).nick X call lowcase(lownick,nlen) X if (note(i).nlen.eq.0) slot = i X if (nick(1:nlen).eq.lownick(1:note(i).nlen)) then X note(i).nlen = 0 X note(i).state = .false. X if (signal) X + call output_text('* Nickname removed from notify list.') X return X endif X enddo X if (.not.nflag) then X nflag = .true. X call launch_notify X endif X note(slot).nick = nick X note(slot).nlen = nlen X if (signal) X + call output_text('* Nickname has been added to notify list.') X end X X X logical *4 function substitute (buffer,length,text,tlen) X implicit none X include 'constants.inc' X include 'structures.inc' X character *(*) buffer,text X character *512 wrkbuf,parm X character *256 prime X character *80 uname,rname X character *9 nname X character *2 level X integer *4 i,length,mark,zero,plen,wlen,primelen X integer *4 nnlen,ulen,rlen,tlen X common /prime/ prime,primelen X common /user/ nname,uname,rname,nnlen,ulen,rlen X X substitute = .true. X wrkbuf = text X wlen = tlen X zero = ichar('0') X do i = 1,maxparam X level = '$'//char(zero+i-1) X mark = index(wrkbuf(1:wlen),level) X if (mark.gt.0) call chop(buffer,length,parm,plen) X do while (mark.gt.0) X if (plen.eq.0) then X substitute = .false. X return X endif X wrkbuf = wrkbuf(1:mark-1)//parm(1:plen)//wrkbuf(mark+2:wlen) X wlen = wlen - 2 + plen X mark = index(wrkbuf(1:wlen),level) X enddo X enddo X call predefined(wrkbuf,wlen,'$c',prime(1:primelen),primelen) X call predefined(wrkbuf,wlen,'$n',nname(1:nnlen),nnlen) X if (length.gt.0) then X buffer = wrkbuf(1:wlen)//' '//buffer(1:length) X length = wlen + 1 + length X else X buffer = wrkbuf(1:wlen) X length = wlen X endif X end X X X subroutine predefined (wrkbuf,wlen,level,parm,plen) X implicit none X character *(*) parm X character *512 wrkbuf,temp X character *2 level X integer *4 wlen,plen,mark,tlen X X temp = wrkbuf X tlen = wlen X call lowcase(temp,tlen) X mark = index(temp(1:tlen),level) X do while (mark.gt.0) X wrkbuf = wrkbuf(1:mark-1)//parm(1:plen)//wrkbuf(mark+2:wlen) X wlen = wlen - 2 + plen X temp = wrkbuf X tlen = wlen X mark = index(temp(1:tlen),level) X enddo X end X X X subroutine fix_order (chan,clen) X implicit none`20 X include 'constants.inc' X character *256 chan(maxchn),tmpc(maxchn) X integer *4 i,clen(maxchn),tmpl(maxchn),count X X count = 0 X do i = 1,maxchn X tmpc(i) = char(0) X tmpl(i) = 0 X if (clen(i).ne.0) then X count = count + 1 +-+-+-+-+-+-+-+- END OF PART 7 +-+-+-+-+-+-+-+-