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
  34 (defun riece-handle-nick-message (prefix string)
  35   (let* ((old (riece-prefix-nickname prefix))
  36          (new (car (riece-split-parameters string)))
  37          (old-identity (riece-make-identity old riece-server-name))
  38          (new-identity (riece-make-identity new riece-server-name))
  39          (channels (riece-user-get-channels old))
  40          (visible (riece-identity-member
  41                    riece-current-channel
  42                    (mapcar (lambda (channel)
  43                              (riece-make-identity channel riece-server-name))
  44                            channels))))
  45     (riece-naming-assert-rename old new)
  46     (if (riece-identity-member old-identity riece-current-channels)
  47         (setq channels (cons new channels)))
  48     (riece-insert-change (mapcar
  49                           (lambda (channel)
  50                             (riece-channel-buffer (riece-make-identity
  51                                                    channel riece-server-name)))
  52                           channels)
  53                          (format "%s -> %s\n"
  54                                  (riece-format-identity old-identity t)
  55                                  (riece-format-identity new-identity t)))
  56     (riece-insert-change (if visible
  57                              riece-dialogue-buffer
  58                            (list riece-dialogue-buffer riece-others-buffer))
  59                          (concat
  60                           (riece-concat-server-name
  61                            (format "%s -> %s"
  62                                  (riece-format-identity old-identity t)
  63                                  (riece-format-identity new-identity t)))
  64                           "\n"))))
  65
  66 (defun riece-handle-privmsg-message (prefix string)
  67   (let* ((user (riece-prefix-nickname prefix))
  68          (parameters (riece-split-parameters string))
  69          (targets (split-string (car parameters) ","))
  70          (message (nth 1 parameters)))
  71     (riece-display-message
  72      (riece-make-message (riece-make-identity user
  73                                               riece-server-name)
  74                          (riece-make-identity (car targets)
  75                                               riece-server-name)
  76                          message nil
  77                          (riece-identity-equal-no-server
  78                           user riece-real-nickname)))))
  79
  80 (defun riece-handle-notice-message (prefix string)
  81   (let* ((user (if prefix
  82                    (riece-prefix-nickname prefix)))
  83          (parameters (riece-split-parameters string))
  84          (targets (split-string (car parameters) ","))
  85          (message (nth 1 parameters)))
  86     (if user
  87         (riece-display-message
  88          (riece-make-message (riece-make-identity user
  89                                                   riece-server-name)
  90                              (riece-make-identity (car targets)
  91                                                   riece-server-name)
  92                              message 'notice
  93                              (riece-identity-equal-no-server
  94                               user riece-real-nickname)))
  95       ;; message from server
  96       (riece-insert-notice
  97        (list riece-dialogue-buffer riece-others-buffer)
  98        (concat (riece-concat-server-name message) "\n")))))
  99
 100 (defun riece-handle-ping-message (prefix string)
 101   (riece-send-string (format "PONG :%s\r\n"
 102                              (if (eq (aref string 0) ?:)
 103                                  (substring string 1)
 104                                string))))
 105
 106 (defun riece-handle-join-message (prefix string)
 107   (let* ((user (riece-prefix-nickname prefix))
 108          ;; RFC2812 3.2.1 doesn't recommend server to send join
 109          ;; messages which contain multiple targets.
 110          (channels (split-string (car (riece-split-parameters string)) ","))
 111          (user-identity (riece-make-identity user riece-server-name)))
 112     (while channels
 113       (riece-naming-assert-join user (car channels))
 114       (if (and riece-gather-channel-modes
 115                (riece-identity-equal-no-server user riece-real-nickname))
 116           (riece-send-string (format "MODE %s\r\n" (car channels))))
 117       (let* ((channel-identity (riece-make-identity (car channels)
 118                                                     riece-server-name))
 119              (buffer (riece-channel-buffer channel-identity)))
 120         (riece-insert-change
 121          buffer
 122          (format "%s (%s) has joined %s\n"
 123                  (riece-format-identity user-identity t)
 124                  (riece-user-get-user-at-host user)
 125                  (riece-format-identity channel-identity t)))
 126         (riece-insert-change
 127          (if (and riece-channel-buffer-mode
 128                   (not (eq buffer riece-channel-buffer)))
 129              (list riece-dialogue-buffer riece-others-buffer)
 130            riece-dialogue-buffer)
 131          (concat
 132           (riece-concat-server-name
 133            (format "%s (%s) has joined %s"
 134                    (riece-format-identity user-identity t)
 135                    (riece-user-get-user-at-host user)
 136                    (riece-format-identity channel-identity t)))
 137           "\n")))
 138       (setq channels (cdr channels)))))
 139
 140 (defun riece-handle-part-message (prefix string)
 141   (let* ((user (riece-prefix-nickname prefix))
 142          (parameters (riece-split-parameters string))
 143          ;; RFC2812 3.2.2 doesn't recommend server to send part
 144          ;; messages which contain multiple targets.
 145          (channels (split-string (car parameters) ","))
 146          (message (nth 1 parameters))
 147          (user-identity (riece-make-identity user riece-server-name)))
 148     (while channels
 149       (riece-naming-assert-part user (car channels))
 150       (let* ((channel-identity (riece-make-identity (car channels)
 151                                                     riece-server-name))
 152              (buffer (riece-channel-buffer channel-identity)))
 153         (riece-insert-change
 154          buffer
 155          (concat
 156           (riece-concat-message
 157            (format "%s has left %s"
 158                    (riece-format-identity user-identity t)
 159                    (riece-format-identity channel-identity t))
 160            message)
 161           "\n"))
 162         (riece-insert-change
 163          (if (and riece-channel-buffer-mode
 164                   (not (eq buffer riece-channel-buffer)))
 165              (list riece-dialogue-buffer riece-others-buffer)
 166            riece-dialogue-buffer)
 167          (concat
 168           (riece-concat-server-name
 169            (riece-concat-message
 170             (format "%s has left %s"
 171                     (riece-format-identity user-identity t)
 172                     (riece-format-identity channel-identity t))
 173             message))
 174           "\n")))
 175       (setq channels (cdr channels)))))
 176
 177 (defun riece-handle-kick-message (prefix string)
 178   (let* ((kicker (riece-prefix-nickname prefix))
 179          (parameters (riece-split-parameters string))
 180          (channel (car parameters))
 181          (user (nth 1 parameters))
 182          (message (nth 2 parameters))
 183          (kicker-identity (riece-make-identity kicker riece-server-name))
 184          (channel-identity (riece-make-identity channel riece-server-name))
 185          (user-identity (riece-make-identity user riece-server-name)))
 186     (riece-naming-assert-part user channel)
 187     (let ((buffer (riece-channel-buffer channel-identity)))
 188       (riece-insert-change
 189        buffer
 190        (concat
 191         (riece-concat-message
 192          (format "%s kicked %s out from %s"
 193                  (riece-format-identity kicker-identity t)
 194                  (riece-format-identity user-identity t)
 195                  (riece-format-identity channel-identity t))
 196          message)
 197         "\n"))
 198       (riece-insert-change
 199        (if (and riece-channel-buffer-mode
 200                 (not (eq buffer riece-channel-buffer)))
 201            (list riece-dialogue-buffer riece-others-buffer)
 202          riece-dialogue-buffer)
 203        (concat
 204         (riece-concat-server-name
 205          (riece-concat-message
 206           (format "%s kicked %s out from %s\n"
 207                  (riece-format-identity kicker-identity t)
 208                  (riece-format-identity user-identity t)
 209                  (riece-format-identity channel-identity t))
 210           message))
 211         "\n")))))
 212
 213 (defun riece-handle-quit-message (prefix string)
 214   (let* ((user (riece-prefix-nickname prefix))
 215          (channels (copy-sequence (riece-user-get-channels user)))
 216          (pointer channels)
 217          (parameters (riece-split-parameters string))
 218          (message (car parameters))
 219          (user-identity (riece-make-identity user riece-server-name)))
 220     ;; If you are talking with the user, quit it.
 221     (if (riece-identity-member user-identity riece-current-channels)
 222         (riece-part-channel user))
 223     (setq pointer channels)
 224     (while pointer
 225       (riece-naming-assert-part user (car pointer))
 226       (setq pointer (cdr pointer)))
 227     (let ((buffers
 228            (mapcar
 229             (lambda (channel)
 230               (riece-channel-buffer (riece-make-identity channel
 231                                                          riece-server-name)))
 232             channels)))
 233       (riece-insert-change
 234        buffers
 235        (concat
 236         (riece-concat-message
 237          (format "%s has left IRC"
 238                  (riece-format-identity user-identity t))
 239          message)
 240         "\n"))
 241       (riece-insert-change
 242        (if (and riece-channel-buffer-mode
 243                 (not (memq riece-channel-buffer buffers)))
 244            (list riece-dialogue-buffer riece-others-buffer)
 245          riece-dialogue-buffer)
 246        (concat
 247         (riece-concat-server-name
 248          (riece-concat-message
 249           (format "%s has left IRC"
 250                   (riece-format-identity user-identity t))
 251           message))
 252         "\n")))))
 253
 254 (defun riece-handle-kill-message (prefix string)
 255   (let* ((killer (riece-prefix-nickname prefix))
 256          (parameters (riece-split-parameters string))
 257          (user (car parameters))
 258          (message (nth 1 parameters))
 259          (channels (copy-sequence (riece-user-get-channels user)))
 260          (killer-identity (riece-make-identity killer riece-server-name))
 261          (user-identity (riece-make-identity user riece-server-name))
 262          pointer)
 263     ;; If you are talking with the user, quit it.
 264     (if (riece-identity-member user-identity riece-current-channels)
 265         (riece-part-channel user))
 266     (setq pointer channels)
 267     (while pointer
 268       (riece-naming-assert-part user (car pointer))
 269       (setq pointer (cdr pointer)))
 270     (let ((buffers
 271            (mapcar
 272             (lambda (channel)
 273               (riece-channel-buffer (riece-make-identity channel
 274                                                          riece-server-name)))
 275             channels)))
 276       (riece-insert-change
 277        buffers
 278        (concat
 279         (riece-concat-message
 280          (format "%s killed %s"
 281                  (riece-format-identity killer-identity t)
 282                  (riece-format-identity user-identity t))
 283          message)
 284         "\n"))
 285       (riece-insert-change
 286        (if (and riece-channel-buffer-mode
 287                 (not (memq riece-channel-buffer buffers)))
 288            (list riece-dialogue-buffer riece-others-buffer)
 289          riece-dialogue-buffer)
 290        (concat
 291         (riece-concat-server-name
 292          (riece-concat-message
 293           (format "%s killed %s"
 294                  (riece-format-identity killer-identity t)
 295                  (riece-format-identity user-identity t))
 296           message))
 297         "\n")))))
 298
 299 (defun riece-handle-invite-message (prefix string)
 300   (let* ((user (riece-prefix-nickname prefix))
 301          (parameters (riece-split-parameters string))
 302          (invited (car parameters))
 303          (channel (nth 1 parameters))
 304          (channel-identity (riece-make-identity channel riece-server-name)))
 305     (if (riece-identity-equal-no-server invited riece-real-nickname)
 306         (setq riece-join-channel-candidate channel-identity))
 307     (riece-insert-info
 308      (list riece-dialogue-buffer riece-others-buffer)
 309      (concat
 310       (riece-concat-server-name
 311        (format "%s invites %s to %s"
 312                (riece-format-identity (riece-make-identity
 313                                        user riece-server-name))
 314                (riece-format-identity (riece-make-identity
 315                                        invited riece-server-name))
 316                (riece-format-identity channel-identity)))
 317       "\n"))))
 318
 319 (defun riece-handle-topic-message (prefix string)
 320   (let* ((user (riece-prefix-nickname prefix))
 321          (parameters (riece-split-parameters string))
 322          (channel (car parameters))
 323          (topic (nth 1 parameters))
 324          (user-identity (riece-make-identity user riece-server-name))
 325          (channel-identity (riece-make-identity channel riece-server-name)))
 326     (riece-channel-set-topic (riece-get-channel channel) topic)
 327     (riece-emit-signal 'channel-topic-changed
 328                        channel-identity topic)
 329     (let ((buffer (riece-channel-buffer channel-identity)))
 330       (riece-insert-change
 331        buffer
 332        (format "Topic by %s: %s\n"
 333                (riece-format-identity user-identity t)
 334                topic))
 335       (riece-insert-change
 336        (if (and riece-channel-buffer-mode
 337                 (not (eq buffer riece-channel-buffer)))
 338            (list riece-dialogue-buffer riece-others-buffer)
 339          riece-dialogue-buffer)
 340        (concat
 341         (riece-concat-server-name
 342          (format "Topic on %s by %s: %s"
 343                  (riece-format-identity channel-identity t)
 344                  (riece-format-identity user-identity t)
 345                  topic))
 346         "\n")))))
 347
 348 (defun riece-handle-mode-message (prefix string)
 349   (let* ((user (riece-prefix-nickname prefix))
 350          (user-identity (riece-make-identity user riece-server-name))
 351          channel)
 352     (when (string-match "^\\([^ ]+\\) *:?" string)
 353       (setq channel (match-string 1 string)
 354             string (substring string (match-end 0)))
 355       (if (string-match (concat "^" riece-channel-regexp "$") channel)
 356           (riece-naming-assert-channel-modes channel
 357                                              (riece-parse-modes string)))
 358       (let* ((channel-identity (riece-make-identity channel riece-server-name))
 359              (buffer (riece-channel-buffer channel-identity)))
 360         (riece-insert-change
 361          buffer
 362          (format "Mode by %s: %s\n"
 363                  (riece-format-identity user-identity t)
 364                  string))
 365         (riece-insert-change
 366          (if (and riece-channel-buffer-mode
 367                   (not (eq buffer riece-channel-buffer)))
 368              (list riece-dialogue-buffer riece-others-buffer)
 369            riece-dialogue-buffer)
 370          (concat
 371           (riece-concat-server-name
 372            (format "Mode on %s by %s: %s"
 373                    (riece-format-identity channel-identity t)
 374                    (riece-format-identity user-identity t)
 375                    string))
 376           "\n"))))))
 377
 378 (provide 'riece-handle)
 379
 380 ;;; riece-handle.el ends here