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-signal)
  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
  65 (defun riece-handle-privmsg-message (prefix string)
  66   (let* ((user (riece-prefix-nickname prefix))
  67          (parameters (riece-split-parameters string))
  68          (targets (split-string (car parameters) ","))
  69          (message (nth 1 parameters)))
  70     (riece-display-message
  71      (riece-make-message (riece-make-identity user
  72                                               riece-server-name)
  73                          (riece-make-identity (car targets)
  74                                               riece-server-name)
  75                          message nil
  76                          (riece-identity-equal-no-server
  77                           user riece-real-nickname)))))
  78
  79 (defun riece-handle-notice-message (prefix string)
  80   (let* ((user (if prefix
  81                    (riece-prefix-nickname prefix)))
  82          (parameters (riece-split-parameters string))
  83          (targets (split-string (car parameters) ","))
  84          (message (nth 1 parameters)))
  85     (if user
  86         (riece-display-message
  87          (riece-make-message (riece-make-identity user
  88                                                   riece-server-name)
  89                              (riece-make-identity (car targets)
  90                                                   riece-server-name)
  91                              message 'notice
  92                              (riece-identity-equal-no-server
  93                               user riece-real-nickname)))
  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
 139 (defun riece-handle-part-message (prefix string)
 140   (let* ((user (riece-prefix-nickname prefix))
 141          (parameters (riece-split-parameters string))
 142          ;; RFC2812 3.2.2 doesn't recommend server to send part
 143          ;; messages which contain multiple targets.
 144          (channels (split-string (car parameters) ","))
 145          (message (nth 1 parameters))
 146          (user-identity (riece-make-identity user riece-server-name)))
 147     (while channels
 148       (riece-naming-assert-part user (car channels))
 149       (let* ((channel-identity (riece-make-identity (car channels)
 150                                                     riece-server-name))
 151              (buffer (riece-channel-buffer channel-identity)))
 152         (riece-insert-change
 153          buffer
 154          (concat
 155           (riece-concat-message
 156            (format "%s has left %s"
 157                    (riece-format-identity user-identity t)
 158                    (riece-format-identity channel-identity t))
 159            message)
 160           "\n"))
 161         (riece-insert-change
 162          (if (and riece-channel-buffer-mode
 163                   (not (eq buffer riece-channel-buffer)))
 164              (list riece-dialogue-buffer riece-others-buffer)
 165            riece-dialogue-buffer)
 166          (concat
 167           (riece-concat-server-name
 168            (riece-concat-message
 169             (format "%s has left %s"
 170                     (riece-format-identity user-identity t)
 171                     (riece-format-identity channel-identity t))
 172             message))
 173           "\n")))
 174       (setq channels (cdr channels)))))
 175
 176 (defun riece-handle-kick-message (prefix string)
 177   (let* ((kicker (riece-prefix-nickname prefix))
 178          (parameters (riece-split-parameters string))
 179          (channel (car parameters))
 180          (user (nth 1 parameters))
 181          (message (nth 2 parameters))
 182          (kicker-identity (riece-make-identity kicker riece-server-name))
 183          (channel-identity (riece-make-identity channel riece-server-name))
 184          (user-identity (riece-make-identity user riece-server-name)))
 185     (riece-naming-assert-part user channel)
 186     (let ((buffer (riece-channel-buffer channel-identity)))
 187       (riece-insert-change
 188        buffer
 189        (concat
 190         (riece-concat-message
 191          (format "%s kicked %s out from %s"
 192                  (riece-format-identity kicker-identity t)
 193                  (riece-format-identity user-identity t)
 194                  (riece-format-identity channel-identity t))
 195          message)
 196         "\n"))
 197       (riece-insert-change
 198        (if (and riece-channel-buffer-mode
 199                 (not (eq buffer riece-channel-buffer)))
 200            (list riece-dialogue-buffer riece-others-buffer)
 201          riece-dialogue-buffer)
 202        (concat
 203         (riece-concat-server-name
 204          (riece-concat-message
 205           (format "%s kicked %s out from %s\n"
 206                  (riece-format-identity kicker-identity t)
 207                  (riece-format-identity user-identity t)
 208                  (riece-format-identity channel-identity t))
 209           message))
 210         "\n")))))
 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
 253 (defun riece-handle-kill-message (prefix string)
 254   (let* ((killer (riece-prefix-nickname prefix))
 255          (parameters (riece-split-parameters string))
 256          (user (car parameters))
 257          (message (nth 1 parameters))
 258          (channels (copy-sequence (riece-user-get-channels user)))
 259          (killer-identity (riece-make-identity killer riece-server-name))
 260          (user-identity (riece-make-identity user riece-server-name))
 261          pointer)
 262     ;; If you are talking with the user, quit it.
 263     (if (riece-identity-member user-identity riece-current-channels)
 264         (riece-part-channel user))
 265     (setq pointer channels)
 266     (while pointer
 267       (riece-naming-assert-part user (car pointer))
 268       (setq pointer (cdr pointer)))
 269     (let ((buffers
 270            (mapcar
 271             (lambda (channel)
 272               (riece-channel-buffer (riece-make-identity channel
 273                                                          riece-server-name)))
 274             channels)))
 275       (riece-insert-change
 276        buffers
 277        (concat
 278         (riece-concat-message
 279          (format "%s killed %s"
 280                  (riece-format-identity killer-identity t)
 281                  (riece-format-identity user-identity t))
 282          message)
 283         "\n"))
 284       (riece-insert-change
 285        (if (and riece-channel-buffer-mode
 286                 (not (memq riece-channel-buffer buffers)))
 287            (list riece-dialogue-buffer riece-others-buffer)
 288          riece-dialogue-buffer)
 289        (concat
 290         (riece-concat-server-name
 291          (riece-concat-message
 292           (format "%s killed %s"
 293                  (riece-format-identity killer-identity t)
 294                  (riece-format-identity user-identity t))
 295           message))
 296         "\n")))))
 297
 298 (defun riece-handle-invite-message (prefix string)
 299   (let* ((user (riece-prefix-nickname prefix))
 300          (parameters (riece-split-parameters string))
 301          (invited (car parameters))
 302          (channel (nth 1 parameters))
 303          (channel-identity (riece-make-identity channel riece-server-name)))
 304     (if (riece-identity-equal-no-server invited riece-real-nickname)
 305         (setq riece-join-channel-candidate channel-identity))
 306     (riece-insert-info
 307      (list riece-dialogue-buffer riece-others-buffer)
 308      (concat
 309       (riece-concat-server-name
 310        (format "%s invites %s to %s"
 311                (riece-format-identity (riece-make-identity
 312                                        user riece-server-name))
 313                (riece-format-identity (riece-make-identity
 314                                        invited riece-server-name))
 315                (riece-format-identity channel-identity)))
 316       "\n"))))
 317
 318 (defun riece-handle-topic-message (prefix string)
 319   (let* ((user (riece-prefix-nickname prefix))
 320          (parameters (riece-split-parameters string))
 321          (channel (car parameters))
 322          (topic (nth 1 parameters))
 323          (user-identity (riece-make-identity user riece-server-name))
 324          (channel-identity (riece-make-identity channel riece-server-name)))
 325     (riece-channel-set-topic (riece-get-channel channel) topic)
 326     (riece-emit-signal 'channel-topic-changed
 327                        channel-identity 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
 347 (defun riece-parse-modes (string)
 348   (let ((start 0)
 349         result)
 350     (while (and (string-match "[-+]\\([^ ]*\\) *" string start)
 351                 (= (match-beginning 0) start))
 352       (let ((toggle (eq (aref string 0) ?+))
 353             (modes (string-to-list (match-string 1 string))))
 354         (setq start (match-end 0))
 355         (while modes
 356           (if (and (string-match "\\([^-+][^ ]*\\) *" string start)
 357                    (= (match-beginning 0) start))
 358               (setq start (match-end 0)
 359                     result (cons (list (car modes) toggle
 360                                        (match-string 1 string))
 361                                  result))
 362             (setq result (cons (list (car modes) toggle)
 363                                result)))
 364           (setq modes (cdr modes)))))
 365     (nreverse result)))
 366
 367 (defun riece-handle-channel-modes (channel modes)
 368   (while modes
 369     (cond
 370      ((eq (car (car modes)) ?o)
 371       (riece-channel-toggle-operator channel
 372                                      (nth 2 (car modes))
 373                                      (nth 1 (car modes)))
 374       (riece-emit-signal 'channel-operators-changed
 375                          (riece-make-identity channel
 376                                               riece-server-name)
 377                          (riece-make-identity (nth 2 (car modes))
 378                                               riece-server-name)
 379                          (nth 1 (car modes))))
 380      ((eq (car (car modes)) ?v)
 381       (riece-channel-toggle-speaker channel
 382                                     (nth 2 (car modes))
 383                                     (nth 1 (car modes)))
 384       (riece-emit-signal 'channel-speakers-changed
 385                          (riece-make-identity channel
 386                                               riece-server-name)
 387                          (riece-make-identity (nth 2 (car modes))
 388                                               riece-server-name)
 389                          (nth 1 (car modes))))
 390      ((eq (car (car modes)) ?b)
 391       (riece-channel-toggle-banned channel
 392                                    (nth 2 (car modes))
 393                                    (nth 1 (car modes))))
 394      ((eq (car (car modes)) ?e)
 395       (riece-channel-toggle-uninvited channel
 396                                       (nth 2 (car modes))
 397                                       (nth 1 (car modes))))
 398      ((eq (car (car modes)) ?I)
 399       (riece-channel-toggle-invited channel
 400                                     (nth 2 (car modes))
 401                                     (nth 1 (car modes))))
 402      (t
 403       (apply #'riece-channel-toggle-mode channel (car modes))))
 404     (setq modes (cdr modes)))
 405   (riece-emit-signal 'channel-modes-changed
 406                      (riece-make-identity channel
 407                                           riece-server-name)))
 408
 409 (defun riece-handle-mode-message (prefix string)
 410   (let* ((user (riece-prefix-nickname prefix))
 411          (user-identity (riece-make-identity user riece-server-name))
 412          channel)
 413     (when (string-match "^\\([^ ]+\\) *:?" string)
 414       (setq channel (match-string 1 string)
 415             string (substring string (match-end 0)))
 416       (if (string-match (concat "^" riece-channel-regexp "$") channel)
 417           (riece-handle-channel-modes channel (riece-parse-modes string)))
 418       (let* ((channel-identity (riece-make-identity channel riece-server-name))
 419              (buffer (riece-channel-buffer channel-identity)))
 420         (riece-insert-change
 421          buffer
 422          (format "Mode by %s: %s\n"
 423                  (riece-format-identity user-identity t)
 424                  string))
 425         (riece-insert-change
 426          (if (and riece-channel-buffer-mode
 427                   (not (eq buffer riece-channel-buffer)))
 428              (list riece-dialogue-buffer riece-others-buffer)
 429            riece-dialogue-buffer)
 430          (concat
 431           (riece-concat-server-name
 432            (format "Mode on %s by %s: %s"
 433                    (riece-format-identity channel-identity t)
 434                    (riece-format-identity user-identity t)
 435                    string))
 436           "\n"))))))
 437
 438 (provide 'riece-handle)
 439
 440 ;;; riece-handle.el ends here