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