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