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