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