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