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