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