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