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