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