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          (speaker (riece-make-identity user riece-server-name)))
  72     (riece-display-message
  73      (riece-make-message speaker
  74                          (riece-make-identity (car targets)
  75                                               riece-server-name)
  76                          message
  77                          nil
  78                          (riece-identity-equal
  79                           speaker (riece-current-nickname))))))
  80
  81 (defun riece-handle-notice-message (prefix string)
  82   (let* ((user (if prefix
  83                    (riece-prefix-nickname prefix)))
  84          (parameters (riece-split-parameters string))
  85          (targets (split-string (car parameters) ","))
  86          (message (nth 1 parameters)))
  87     (if user
  88         (riece-display-message
  89          (riece-make-message (riece-make-identity user
  90                                                   riece-server-name)
  91                              (riece-make-identity (car targets)
  92                                                   riece-server-name)
  93                              message 'notice))
  94       ;; message from server
  95       (riece-insert-notice
  96        (list riece-dialogue-buffer riece-others-buffer)
  97        (concat (riece-concat-server-name message) "\n")))))
  98
  99 (defun riece-handle-ping-message (prefix string)
 100   (riece-send-string (format "PONG :%s\r\n"
 101                              (if (eq (aref string 0) ?:)
 102                                  (substring string 1)
 103                                string))))
 104
 105 (defun riece-handle-join-message (prefix string)
 106   (let* ((user (riece-prefix-nickname prefix))
 107          ;; RFC2812 3.2.1 doesn't recommend server to send join
 108          ;; messages which contain multiple targets.
 109          (channels (split-string (car (riece-split-parameters string)) ","))
 110          (user-identity (riece-make-identity user riece-server-name)))
 111     (while channels
 112       (riece-naming-assert-join user (car channels))
 113       (if (and riece-gather-channel-modes
 114                (riece-identity-equal-no-server user riece-real-nickname))
 115           (riece-send-string (format "MODE %s\r\n" (car channels))))
 116       (let* ((channel-identity (riece-make-identity (car channels)
 117                                                     riece-server-name))
 118              (buffer (riece-channel-buffer channel-identity)))
 119         (riece-insert-change
 120          buffer
 121          (format "%s (%s) has joined %s\n"
 122                  (riece-format-identity user-identity t)
 123                  (riece-user-get-user-at-host user)
 124                  (riece-format-identity channel-identity t)))
 125         (riece-insert-change
 126          (if (and riece-channel-buffer-mode
 127                   (not (eq buffer riece-channel-buffer)))
 128              (list riece-dialogue-buffer riece-others-buffer)
 129            riece-dialogue-buffer)
 130          (concat
 131           (riece-concat-server-name
 132            (format "%s (%s) has joined %s"
 133                    (riece-format-identity user-identity t)
 134                    (riece-user-get-user-at-host user)
 135                    (riece-format-identity channel-identity t)))
 136           "\n")))
 137       (setq channels (cdr channels)))
 138     (riece-redisplay-buffers)))
 139
 140 (defun riece-handle-part-message (prefix string)
 141   (let* ((user (riece-prefix-nickname prefix))
 142          (parameters (riece-split-parameters string))
 143          ;; RFC2812 3.2.2 doesn't recommend server to send part
 144          ;; messages which contain multiple targets.
 145          (channels (split-string (car parameters) ","))
 146          (message (nth 1 parameters))
 147          (user-identity (riece-make-identity user riece-server-name)))
 148     (while channels
 149       (riece-naming-assert-part user (car channels))
 150       (let* ((channel-identity (riece-make-identity (car channels)
 151                                                     riece-server-name))
 152              (buffer (riece-channel-buffer channel-identity)))
 153         (riece-insert-change
 154          buffer
 155          (concat
 156           (riece-concat-message
 157            (format "%s has left %s"
 158                    (riece-format-identity user-identity t)
 159                    (riece-format-identity channel-identity t))
 160            message)
 161           "\n"))
 162         (riece-insert-change
 163          (if (and riece-channel-buffer-mode
 164                   (not (eq buffer riece-channel-buffer)))
 165              (list riece-dialogue-buffer riece-others-buffer)
 166            riece-dialogue-buffer)
 167          (concat
 168           (riece-concat-server-name
 169            (riece-concat-message
 170             (format "%s has left %s"
 171                     (riece-format-identity user-identity t)
 172                     (riece-format-identity channel-identity t))
 173             message))
 174           "\n")))
 175       (setq channels (cdr channels)))
 176     (riece-redisplay-buffers)))
 177
 178 (defun riece-handle-kick-message (prefix string)
 179   (let* ((kicker (riece-prefix-nickname prefix))
 180          (parameters (riece-split-parameters string))
 181          (channel (car parameters))
 182          (user (nth 1 parameters))
 183          (message (nth 2 parameters))
 184          (kicker-identity (riece-make-identity kicker riece-server-name))
 185          (channel-identity (riece-make-identity channel riece-server-name))
 186          (user-identity (riece-make-identity user riece-server-name)))
 187     (riece-naming-assert-part user channel)
 188     (let ((buffer (riece-channel-buffer channel-identity)))
 189       (riece-insert-change
 190        buffer
 191        (concat
 192         (riece-concat-message
 193          (format "%s kicked %s out from %s"
 194                  (riece-format-identity kicker-identity t)
 195                  (riece-format-identity user-identity t)
 196                  (riece-format-identity channel-identity t))
 197          message)
 198         "\n"))
 199       (riece-insert-change
 200        (if (and riece-channel-buffer-mode
 201                 (not (eq buffer riece-channel-buffer)))
 202            (list riece-dialogue-buffer riece-others-buffer)
 203          riece-dialogue-buffer)
 204        (concat
 205         (riece-concat-server-name
 206          (riece-concat-message
 207           (format "%s kicked %s out from %s\n"
 208                  (riece-format-identity kicker-identity t)
 209                  (riece-format-identity user-identity t)
 210                  (riece-format-identity channel-identity t))
 211           message))
 212         "\n")))
 213     (riece-redisplay-buffers)))
 214
 215 (defun riece-handle-quit-message (prefix string)
 216   (let* ((user (riece-prefix-nickname prefix))
 217          (channels (copy-sequence (riece-user-get-channels user)))
 218          (pointer channels)
 219          (parameters (riece-split-parameters string))
 220          (message (car parameters))
 221          (user-identity (riece-make-identity user riece-server-name)))
 222     ;; If you are talking with the user, quit it.
 223     (if (riece-identity-member user-identity riece-current-channels)
 224         (riece-part-channel user))
 225     (setq pointer channels)
 226     (while pointer
 227       (riece-naming-assert-part user (car pointer))
 228       (setq pointer (cdr pointer)))
 229     (let ((buffers
 230            (mapcar
 231             (lambda (channel)
 232               (riece-channel-buffer (riece-make-identity channel
 233                                                          riece-server-name)))
 234             channels)))
 235       (riece-insert-change
 236        buffers
 237        (concat
 238         (riece-concat-message
 239          (format "%s has left IRC"
 240                  (riece-format-identity user-identity t))
 241          message)
 242         "\n"))
 243       (riece-insert-change
 244        (if (and riece-channel-buffer-mode
 245                 (not (memq riece-channel-buffer buffers)))
 246            (list riece-dialogue-buffer riece-others-buffer)
 247          riece-dialogue-buffer)
 248        (concat
 249         (riece-concat-server-name
 250          (riece-concat-message
 251           (format "%s has left IRC"
 252                   (riece-format-identity user-identity t))
 253           message))
 254         "\n"))))
 255   (riece-redisplay-buffers))
 256
 257 (defun riece-handle-kill-message (prefix string)
 258   (let* ((killer (riece-prefix-nickname prefix))
 259          (parameters (riece-split-parameters string))
 260          (user (car parameters))
 261          (message (nth 1 parameters))
 262          (channels (copy-sequence (riece-user-get-channels user)))
 263          (killer-identity (riece-make-identity killer riece-server-name))
 264          (user-identity (riece-make-identity user riece-server-name))
 265          pointer)
 266     ;; If you are talking with the user, quit it.
 267     (if (riece-identity-member user-identity riece-current-channels)
 268         (riece-part-channel user))
 269     (setq pointer channels)
 270     (while pointer
 271       (riece-naming-assert-part user (car pointer))
 272       (setq pointer (cdr pointer)))
 273     (let ((buffers
 274            (mapcar
 275             (lambda (channel)
 276               (riece-channel-buffer (riece-make-identity channel
 277                                                          riece-server-name)))
 278             channels)))
 279       (riece-insert-change
 280        buffers
 281        (concat
 282         (riece-concat-message
 283          (format "%s killed %s"
 284                  (riece-format-identity killer-identity t)
 285                  (riece-format-identity user-identity t))
 286          message)
 287         "\n"))
 288       (riece-insert-change
 289        (if (and riece-channel-buffer-mode
 290                 (not (memq riece-channel-buffer buffers)))
 291            (list riece-dialogue-buffer riece-others-buffer)
 292          riece-dialogue-buffer)
 293        (concat
 294         (riece-concat-server-name
 295          (riece-concat-message
 296           (format "%s killed %s"
 297                  (riece-format-identity killer-identity t)
 298                  (riece-format-identity user-identity t))
 299           message))
 300         "\n")))
 301     (riece-redisplay-buffers)))
 302
 303 (defun riece-handle-invite-message (prefix string)
 304   (let* ((user (riece-prefix-nickname prefix))
 305          (parameters (riece-split-parameters string))
 306          (invited (car parameters))
 307          (channel (nth 1 parameters))
 308          (channel-identity (riece-make-identity channel riece-server-name)))
 309     (if (riece-identity-equal-no-server invited riece-real-nickname)
 310         (setq riece-join-channel-candidate channel-identity))
 311     (riece-insert-info
 312      (list riece-dialogue-buffer riece-others-buffer)
 313      (concat
 314       (riece-concat-server-name
 315        (format "%s invites %s to %s"
 316                (riece-format-identity (riece-make-identity
 317                                        user riece-server-name))
 318                (riece-format-identity (riece-make-identity
 319                                        invited riece-server-name))
 320                (riece-format-identity channel-identity)))
 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 (riece-channel-buffer 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 (riece-channel-buffer channel-identity)))
 391         (riece-insert-change
 392          buffer
 393          (format "Mode by %s: %s\n"
 394                  (riece-format-identity user-identity t)
 395                  string))
 396         (riece-insert-change
 397          (if (and riece-channel-buffer-mode
 398                   (not (eq buffer riece-channel-buffer)))
 399              (list riece-dialogue-buffer riece-others-buffer)
 400            riece-dialogue-buffer)
 401          (concat
 402           (riece-concat-server-name
 403            (format "Mode on %s by %s: %s"
 404                    (riece-format-identity channel-identity t)
 405                    (riece-format-identity user-identity t)
 406                    string))
 407           "\n"))
 408         (riece-redisplay-buffers)))))
 409
 410 (provide 'riece-handle)
 411
 412 ;;; riece-handle.el ends here