cgit.sxemacs.org Git - riece/blob - lisp/riece-handle.el

   1 ;;; riece-handle.el --- basic message handlers
   2 ;; Copyright (C) 1998-2003 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (require 'riece-misc)
  28 (require 'riece-message)
  29 (require 'riece-channel)
  30 (require 'riece-naming)
  31 (require 'riece-signal)
  32 (require 'riece-mode)
  33 (require 'riece-000)
  34 (require 'riece-200)
  35 (require 'riece-300)
  36 (require 'riece-400)
  37 (require 'riece-500)
  38
  39 (defun riece-default-handle-numeric-reply
  40   (client-prefix prefix number name string)
  41   (riece-insert
  42    (list riece-dialogue-buffer riece-others-buffer)
  43    (concat client-prefix
  44            (riece-concat-server-name
  45             (mapconcat #'identity (riece-split-parameters string) " "))
  46            "\n")))
  47
  48 (defun riece-handle-nick-message (prefix string)
  49   (let* ((old (riece-prefix-nickname prefix))
  50          (new (car (riece-split-parameters string)))
  51          (old-identity (riece-make-identity old riece-server-name))
  52          (new-identity (riece-make-identity new riece-server-name))
  53          (channels (riece-user-get-channels old))
  54          (visible (riece-identity-member
  55                    riece-current-channel
  56                    (mapcar (lambda (channel)
  57                              (riece-make-identity channel riece-server-name))
  58                            channels))))
  59     (riece-naming-assert-rename old new)
  60     (if (riece-identity-member old-identity riece-current-channels)
  61         (setq channels (cons new channels)))
  62     (riece-insert-change (mapcar
  63                           (lambda (channel)
  64                             (riece-channel-buffer (riece-make-identity
  65                                                    channel riece-server-name)))
  66                           channels)
  67                          (format "%s -> %s\n"
  68                                  (riece-format-identity old-identity t)
  69                                  (riece-format-identity new-identity t)))
  70     (riece-insert-change (if visible
  71                              riece-dialogue-buffer
  72                            (list riece-dialogue-buffer riece-others-buffer))
  73                          (concat
  74                           (riece-concat-server-name
  75                            (format "%s -> %s"
  76                                  (riece-format-identity old-identity t)
  77                                  (riece-format-identity new-identity t)))
  78                           "\n"))))
  79
  80 (defun riece-handle-privmsg-message (prefix string)
  81   (let* ((user (riece-prefix-nickname prefix))
  82          (parameters (riece-split-parameters string))
  83          (targets (split-string (car parameters) ","))
  84          (message (nth 1 parameters)))
  85     (riece-display-message
  86      (riece-make-message (riece-make-identity user
  87                                               riece-server-name)
  88                          (riece-make-identity (car targets)
  89                                               riece-server-name)
  90                          message nil
  91                          (riece-identity-equal-no-server
  92                           user riece-real-nickname)))))
  93
  94 (defun riece-handle-notice-message (prefix string)
  95   (let* ((user (if prefix
  96                    (riece-prefix-nickname prefix)))
  97          (parameters (riece-split-parameters string))
  98          (targets (split-string (car parameters) ","))
  99          (message (nth 1 parameters)))
 100     (if user
 101         (riece-display-message
 102          (riece-make-message (riece-make-identity user
 103                                                   riece-server-name)
 104                              (riece-make-identity (car targets)
 105                                                   riece-server-name)
 106                              message 'notice
 107                              (riece-identity-equal-no-server
 108                               user riece-real-nickname)))
 109       ;; message from server
 110       (riece-insert-notice
 111        (list riece-dialogue-buffer riece-others-buffer)
 112        (concat (riece-concat-server-name message) "\n")))))
 113
 114 (defun riece-handle-ping-message (prefix string)
 115   (riece-send-string (format "PONG :%s\r\n"
 116                              (if (eq (aref string 0) ?:)
 117                                  (substring string 1)
 118                                string))))
 119
 120 (defun riece-handle-join-message (prefix string)
 121   (let* ((user (riece-prefix-nickname prefix))
 122          ;; RFC2812 3.2.1 doesn't recommend server to send join
 123          ;; messages which contain multiple targets.
 124          (channels (split-string (car (riece-split-parameters string)) ","))
 125          (user-identity (riece-make-identity user riece-server-name)))
 126     (while channels
 127       (riece-naming-assert-join user (car channels))
 128       (if (and riece-gather-channel-modes
 129                (riece-identity-equal-no-server user riece-real-nickname))
 130           (riece-send-string (format "MODE %s\r\n" (car channels))))
 131       (let* ((channel-identity (riece-make-identity (car channels)
 132                                                     riece-server-name))
 133              (buffer (riece-channel-buffer channel-identity)))
 134         (riece-insert-change
 135          buffer
 136          (format "%s (%s) has joined %s\n"
 137                  (riece-format-identity user-identity t)
 138                  (riece-user-get-user-at-host user)
 139                  (riece-format-identity channel-identity t)))
 140         (riece-insert-change
 141          (if (and riece-channel-buffer-mode
 142                   (not (eq buffer riece-channel-buffer)))
 143              (list riece-dialogue-buffer riece-others-buffer)
 144            riece-dialogue-buffer)
 145          (concat
 146           (riece-concat-server-name
 147            (format "%s (%s) has joined %s"
 148                    (riece-format-identity user-identity t)
 149                    (riece-user-get-user-at-host user)
 150                    (riece-format-identity channel-identity t)))
 151           "\n")))
 152       (setq channels (cdr channels)))))
 153
 154 (defun riece-handle-part-message (prefix string)