Otherware/Otherware_1_SB_Development.iso/mac/developm/source/rclesrc.10/ircle sources/IRCCommands.p

Text File | 1992-09-05 | 6.3 KB | 274 lines

{    ircle - Internet Relay Chat client    }
{    File: IRCCommands    }
{    Copyright ⌐ 1992 Olaf Titz ([e-mail])    }

{    This program is free software; you can redistribute it and/or modify    }
{    it under the terms of the GNU General Public License as published by    }
{    the Free Software Foundation; either version 2 of the License, or    }
{    (at your option) any later version.    }

{    This program is distributed in the hope that it will be useful,    }
{    but WITHOUT ANY WARRANTY; without even the implied warranty of    }
{    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    }
{    GNU General Public License for more details.    }

{    You should have received a copy of the GNU General Public License    }
{    along with this program; if not, write to the Free Software    }
{    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.    }

unit IRCCommands;
{ Handles commands typed in by the user }

interface
uses
    TCPTypes, TCPStuff, TCPConnections, ApplBase, MsgWindows, {}
    IRCGlobals, IRCaux, IRCPreferences, IRCChannels, IRCHelp, IRCIgnore, DCC;

procedure HandleCommand (var s: string);
{ Process s as command line }

procedure sendCTCP (var t, s: string);
{ send CTCP message }

procedure RegUser;
{ Send the server the first commands to register the user }

implementation

{ This procedure is to be run in the background, to type }
{ a file to the current channel. }
procedure TypeCmd;
    var
        s, t: Str255;
        f: text;
    begin
        t := CurrentTarget;
        if t <> '' then begin
            s := OldFileName(concat('Type to ', t, ':'));
            if s <> '' then begin
                reset(f, s);
                while not eof(f) do begin
                    readln(f, s);
                    if s <> '' then begin
                        s := concat('MSG ', t, ' ', s);
                        HandleCommand(s);
                    end
                end;
                close(f);
            end;
        end
    end;

procedure ParseComLine (var l: string; var com: str255; var rest: string);
    var
        i: integer;
        c: char;
    begin
        if l[1] = cmdChar then
            delete(l, 1, 1);
        i := pos(' ', l);
        if i = 0 then begin
            com := copy(l, 1, 255);
            rest := ''
        end
        else begin
            com := copy(l, 1, i - 1);
            while (i <= length(l)) and (l[i] = ' ') do
                i := succ(i);
            rest := copy(l, i, 255)
        end;
        UprString(com, false);
    end;

procedure TranslateCommand (var s: string);
{ Translates aliases & processes internal commands }
{ Will return an empty string if command already processed }
{ Note: valid commands not mentioned here get sent to the server unprocessed anyway. }
{ That means that an error message for wrong commands comes always from the server. }
    var
        com: str255;
        rest, s1: string;
        i: integer;
        dd: MWHndl;
    procedure join;
        begin
            if rest = '' then
                rest := lastInvite;
            s := concat('JOIN ', rest);
        end;
    procedure signoff;
        begin
            if rest = '' then
                rest := 'Leaving';
            s := concat('QUIT :', rest);
            QuitRequest := true
        end;
    begin
        ParseComLine(s, com, rest);
        if com = 'BYE' then
            signoff
        else if com = 'CHANNEL' then
            join
        else if com = 'CTCP' then begin
            i := pos(' ', rest);
            if i = 0 then begin
                com := rest;
                rest := ''
            end
            else begin
                com := copy(rest, 1, i - 1);
                delete(rest, 1, i)
            end;
            sendCTCP(com, rest);
            s := ''
        end
        else if com = 'DATE' then
            s := concat('TIME ', rest)
        else if com = 'DCC' then begin
            DCCcommand(rest);
            s := ''
        end
        else if com = 'EXIT' then
            signoff
        else if com = 'HELP' then begin
            ShowHelp;
            ApplRun;
            ApplRun;
            ApplRun;
            s1 := '*** This is the server''s HELP information. For Client Help refer to the Help window';
            LineMsg(s1);
            ApplRun;
            ApplRun
        end
        else if com = 'IGNORE' then begin
            DoIgnore(rest);
            s := ''
        end
        else if com = 'JOIN' then
            join
        else if com = 'LEAVE' then
            s := concat('PART ', rest)
        else if com = 'ME' then begin
            s := concat(CurrentNick, ' ', rest);
            Message(s);
            s := concat('ACTION ', rest);
            sendCTCP(currentTarget, s);
            s := ''
        end
        else if com = 'MSG' then begin
            i := pos(' ', rest);
            s1 := copy(rest, 1, i - 1);
            if IsChannel(s1) then
                s := concat('> ', s1, copy(rest, i, 255))
            else
                s := concat('> *', s1, '*', copy(rest, i, 255));
            ChannelMsg(s1, s);
            s := concat('PRIVMSG ', rest);
        end
        else if com = 'NOTICE' then begin
            i := pos(' ', rest);
            s1 := copy(rest, 1, i - 1);
            s := concat('> -', s1, '-', copy(rest, i, 255));
            ChannelMsg(s1, s);
            s := concat('NOTICE ', rest)
        end
        else if com = 'QUERY' then begin
            if rest = '' then begin
                if lastMSG <> '' then
                    dd := DoJoin(lastMSG)
            end
            else
                dd := DoJoin(rest);
            s := ''
        end
        else if com = 'QUIT' then
            signoff
        else if com = 'QUOTE' then
            s := rest
        else if com = 'SIGNOFF' then
            signoff
        else if com = 'TYPE' then begin
            i := ApplCoroutine(@TypeCmd, COSPACE);
            s := ''
        end
        else if com = 'WHO' then begin
            if rest = '' then
                s := concat(com, ' ', CurrentTarget)
            else if rest[1] = '*' then
                s := concat(com, ' ', CurrentTarget);
        end
        else if com = 'WHOIS' then begin
            if rest = '' then
                s := concat(com, ' ', lastMSG)
            else
                s := concat(com, ' ', rest);
        end;
    end;


procedure sendCTCP (var t, s: string);
    var
        i: integer;
        com: str255;
    begin
        if serverStatus = 0 then begin
            i := pos(' ', s);
            if i = 0 then begin
                com := s;
                s := ''
            end
            else begin
                com := copy(s, 1, i - 1);
                delete(s, 1, i);
            end;
            UprString(com, false);
            s := concat('PRIVMSG ', t, ' ', chr(1), com, ' ', s, chr(1));
            PutLine(s);
        end
        else
            StatusMsg(E_NOSERVER);
    end;

procedure HandleCommand (var s: string);
    begin
        if serverStatus = 0 then begin
            flushing := false;
            UpdateStatusLine;
            TranslateCommand(s);
            if s <> '' then begin
                PutLine(s);
                s := ''
            end
        end
        else
            StatusMsg(E_NOSERVER);
    end;

procedure RegUser;
    var
        s0, s: string;
        i: integer;
    begin
        CurrentServer := ''; { server will respond with NOTICE }
{ This is used to determine server name }
        s := concat('NICK ', currentNick);
        HandleCommand(s);
        s0 := default^^.userLoginName;
        i := pos('@', s0);
        if i > 0 then
            s := concat('USER ', copy(s0, 1, i - 1), ' ', copy(s0, i + 1, 255), ' . :', default^^.username)
        else
            s := concat('USER ', s0, ' . . :', default^^.username);
        HandleCommand(s);
        s0 := default^^.autoExec;
        while s0 <> '' do begin
            i := pos(';', s0);
            if i = 0 then
                i := 255;
            s := copy(s0, 1, i - 1);
            HandleCommand(s);
            delete(s0, 1, i)
        end;
    end;

end.