cgit.sxemacs.org Git - riece/blob - lisp/riece-handle.el

   1 ;;; riece-handle.el --- basic message handlers -*- lexical-binding: t -*-
   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., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, 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 (require 'riece-mode)
  33 (require 'riece-000)
  34 (require 'riece-200)
  35 (require 'riece-300)
  36 (require 'riece-400)
  37 (require 'riece-500)
  38
  39 (defun riece-default-handle-numeric-reply
  40   (client-prefix _prefix _number _name string)
  41   (riece-insert
  42    (list riece-dialogue-buffer riece-others-buffer)
  43    (concat client-prefix
  44            (riece-concat-server-name
  45             (mapconcat #'identity (riece-split-parameters string) " "))
  46            "\n")))
  47
  48 (defun riece-handle-nick-message (prefix string)
  49   (let* ((old (riece-prefix-nickname prefix))
  50          (new (car (riece-split-parameters string)))
  51          (old-identity (riece-make-identity old riece-server-name))
  52          (new-identity (riece-make-identity new riece-server-name))
  53          (channels (riece-user-get-channels old))
  54          (visible (riece-identity-member
  55                    riece-current-channel
  56                    (mapcar (lambda (channel)
  57                              (riece-make-identity channel riece-server-name))
  58                            channels))))
  59     (riece-naming-assert-rename old new)
  60     (if (riece-identity-member old-identity riece-current-channels)
  61         (setq channels (cons new channels)))
  62     (riece-insert-change (delq nil (mapcar
  63                                     (lambda (channel)
  64                                       (riece-channel-buffer
  65                                        (riece-make-identity
  66                                         channel riece-server-name)))
  67                                     channels))
  68                          (format "%s -> %s\n"
  69                                  (riece-format-identity old-identity t)
  70                                  (riece-format-identity new-identity t)))
  71     (riece-insert-change (if visible
  72                              riece-dialogue-buffer
  73                            (list riece-dialogue-buffer riece-others-buffer))
  74                          (concat
  75                           (riece-concat-server-name
  76                            (format "%s -> %s"
  77                                  (riece-format-identity old-identity t)
  78                                  (riece-format-identity new-identity t)))
  79                           "\n"))))
  80
  81 (defun riece-handle-privmsg-message (prefix decoded)
  82   (let* ((user (riece-prefix-nickname prefix))
  83          (parameters (riece-split-parameters (riece-decoded-string decoded)))
  84          (targets (split-string (car parameters) ","))
  85          message)
  86     (setq parameters (riece-split-parameters
  87                       (riece-decoded-string-for-identity
  88                        decoded
  89                        (riece-make-identity (car targets) riece-server-name)))
  90           message (nth 1 parameters))
  91     (riece-display-message
  92      (riece-make-message (riece-make-identity user
  93                                               riece-server-name)
  94                          (riece-make-identity (car targets)
  95                                               riece-server-name)
  96                          message
  97                          nil
  98                          (riece-identity-equal-no-server
  99                           user riece-real-nickname)))))
 100
 101 (defun riece-handle-notice-message (prefix decoded)
 102   (let* ((user (if prefix
 103                    (riece-prefix-nickname prefix)))
 104          (parameters (riece-split-parameters (riece-decoded-string decoded)))
 105          (targets (split-string (car parameters) ","))
 106          message)
 107     (setq parameters (riece-split-parameters
 108                       (riece-decoded-string-for-identity
 109                        decoded
 110                        (riece-make-identity (car targets) riece-server-name)))
 111           message (nth 1 parameters))
 112     (if user
 113         (riece-display-message
 114          (riece-make-message (riece-make-identity user
 115                                                   riece-server-name)
 116                              (riece-make-identity (car targets)
 117                                                   riece-server-name)
 118                              message 'notice
 119                              (if riece-real-nickname
 120                                  (riece-identity-equal-no-server
 121                                   user riece-real-nickname))))
 122       ;; message from server
 123       (riece-insert-notice
 124        (list riece-dialogue-buffer riece-others-buffer)
 125        (concat (riece-concat-server-name message) "\n")))))
 126
 127 (defun riece-handle-ping-message (_prefix string)
 128   (riece-send-string (format "PONG :%s\r\n"
 129                              (if (eq (aref string 0) ?:)
 130                                  (substring string 1)
 131                                string))))
 132
 133 (defun riece-handle-join-message (prefix string)
 134   (let* ((user (riece-prefix-nickname prefix))
 135          ;; RFC2812 3.2.1 doesn't recommend server to send join
 136          ;; messages which contain multiple targets.
 137          (channels (split-string (car (riece-split-parameters string)) ","))
 138          (user-identity (riece-make-identity user riece-server-name)))
 139     (while channels
 140       (riece-naming-assert-join user (car channels))
 141       (if (and riece-gather-channel-modes
 142                (riece-identity-equal-no-server user riece-real-nickname))
 143           (riece-send-string (format "MODE %s\r\n" (car channels))))
 144       (unless (memq 'joins riece-hide-joins-parts-quits)
 145         (let* ((channel-identity (riece-make-identity (car channels)
 146                                                       riece-server-name))
 147                (buffer (riece-channel-buffer channel-identity)))
 148           (riece-insert-change
 149            buffer
 150            (format (riece-mcat "%s (%s) has joined %s\n")
 151                    (riece-format-identity user-identity t)
 152                    (riece-user-get-user-at-host user)
 153                    (riece-format-identity channel-identity t)))
 154           (riece-insert-change
 155            (if (and riece-channel-buffer-mode
 156                     (not (eq buffer riece-channel-buffer)))
 157                (list riece-dialogue-buffer riece-others-buffer)
 158              riece-dialogue-buffer)
 159            (concat
 160             (riece-concat-server-name
 161              (format (riece-mcat "%s (%s) has joined %s")
 162                      (riece-format-identity user-identity t)
 163                      (riece-user-get-user-at-host user)
 164                      (riece-format-identity channel-identity t)))
 165             "\n"))))
 166       (setq channels (cdr channels)))))
 167
 168 (defun riece-handle-part-message (prefix decoded)
 169   (unless (memq 'parts riece-hide-joins-parts-quits)
 170     (let* ((user (riece-prefix-nickname prefix))
 171            (parameters (riece-split-parameters (riece-decoded-string decoded)))
 172            ;; RFC2812 3.2.2 doesn't recommend server to send part
 173            ;; messages which contain multiple targets.
 174            (channels (split-string (car parameters) ","))
 175            (user-identity (riece-make-identity user riece-server-name)))
 176       (while channels
 177         (let* ((channel-identity (riece-make-identity (car channels)
 178                                                       riece-server-name))
 179                (buffer (riece-channel-buffer channel-identity))
 180                message)
 181           (setq parameters (riece-split-parameters
 182                             (riece-decoded-string-for-identity decoded
 183                                                                channel-identity))
 184                 message (nth 1 parameters))
 185           (riece-insert-change
 186            buffer
 187            (concat
 188             (riece-concat-message
 189              (format (riece-mcat "%s has left %s")
 190                      (riece-format-identity user-identity t)
 191                      (riece-format-identity channel-identity t))
 192              message)
 193             "\n"))
 194           (riece-insert-change
 195            (if (and riece-channel-buffer-mode
 196                     (not (eq buffer riece-channel-buffer)))
 197                (list riece-dialogue-buffer riece-others-buffer)
 198              riece-dialogue-buffer)
 199            (concat
 200             (riece-concat-server-name
 201              (riece-concat-message
 202               (format (riece-mcat "%s has left %s")
 203                       (riece-format-identity user-identity t)
 204                       (riece-format-identity channel-identity t))
 205               message))
 206             "\n")))
 207         (riece-naming-assert-part user (car channels))
 208         (setq channels (cdr channels))))))
 209
 210 (defun riece-handle-kick-message (prefix decoded)
 211   (let* ((kicker (riece-prefix-nickname prefix))
 212          (parameters (riece-split-parameters (riece-decoded-string decoded)))
 213          (channel (car parameters))
 214          (user (nth 1 parameters))
 215          message
 216          (kicker-identity (riece-make-identity kicker riece-server-name))
 217          (channel-identity (riece-make-identity channel riece-server-name))
 218          (user-identity (riece-make-identity user riece-server-name)))
 219     (setq parameters (riece-split-parameters
 220                       (riece-decoded-string-for-identity decoded
 221                                                          channel-identity))
 222           message (nth 2 parameters))
 223     (riece-naming-assert-part user channel)
 224     (let ((buffer (riece-channel-buffer channel-identity)))
 225       (riece-insert-change
 226        buffer
 227        (concat
 228         (riece-concat-message
 229          (format (riece-mcat "%s kicked %s out from %s")
 230                  (riece-format-identity kicker-identity t)
 231                  (riece-format-identity user-identity t)
 232                  (riece-format-identity channel-identity t))
 233          message)
 234         "\n"))
 235       (riece-insert-change
 236        (if (and riece-channel-buffer-mode
 237                 (not (eq buffer riece-channel-buffer)))
 238            (list riece-dialogue-buffer riece-others-buffer)
 239          riece-dialogue-buffer)
 240        (concat
 241         (riece-concat-server-name
 242          (riece-concat-message
 243           (format (riece-mcat "%s kicked %s out from %s\n")
 244                  (riece-format-identity kicker-identity t)
 245                  (riece-format-identity user-identity t)
 246                  (riece-format-identity channel-identity t))
 247           message))
 248         "\n")))))
 249
 250 (defun riece-handle-quit-message (prefix string)
 251   (let* ((user (riece-prefix-nickname prefix))
 252          (channels (copy-sequence (riece-user-get-channels user)))
 253          (pointer channels)
 254          (parameters (riece-split-parameters string))
 255          (message (car parameters))
 256          (user-identity (riece-make-identity user riece-server-name)))
 257     ;; If you are talking with the user, quit it.
 258     (if (riece-identity-member user-identity riece-current-channels)
 259         (riece-part-channel user-identity))
 260     (setq pointer channels)
 261     (while pointer
 262       (riece-naming-assert-part user (car pointer))
 263       (setq pointer (cdr pointer)))
 264     (unless (memq 'quits riece-hide-joins-parts-quits)
 265       (let ((buffers
 266              (delq nil (mapcar
 267                         (lambda (channel)
 268                           (riece-channel-buffer (riece-make-identity
 269                                                  channel riece-server-name)))
 270                         channels))))
 271         (riece-insert-change
 272          buffers
 273          (concat
 274           (riece-concat-message
 275            (format (riece-mcat "%s has left IRC")
 276                    (riece-format-identity user-identity t))
 277            message)
 278           "\n"))
 279         (riece-insert-change
 280          (if (and riece-channel-buffer-mode
 281                   (not (memq riece-channel-buffer buffers)))
 282              (list riece-dialogue-buffer riece-others-buffer)
 283            riece-dialogue-buffer)
 284          (concat
 285           (riece-concat-server-name
 286            (riece-concat-message
 287             (format (riece-mcat "%s has left IRC")
 288                     (riece-format-identity user-identity t))
 289             message))
 290           "\n"))))))
 291
 292 (defun riece-handle-kill-message (prefix string)
 293   (let* ((killer (riece-prefix-nickname prefix))
 294          (parameters (riece-split-parameters string))
 295          (user (car parameters))
 296          (message (nth 1 parameters))
 297          (channels (copy-sequence (riece-user-get-channels user)))
 298          (killer-identity (riece-make-identity killer riece-server-name))
 299          (user-identity (riece-make-identity user riece-server-name))
 300          pointer)
 301     ;; If you are talking with the user, quit it.
 302     (if (riece-identity-member user-identity riece-current-channels)
 303         (riece-part-channel user))
 304     (setq pointer channels)
 305     (while pointer
 306       (riece-naming-assert-part user (car pointer))
 307       (setq pointer (cdr pointer)))
 308     (let ((buffers
 309            (delq nil (mapcar
 310                       (lambda (channel)
 311                         (riece-channel-buffer (riece-make-identity
 312                                                channel riece-server-name)))
 313                       channels))))
 314       (riece-insert-change
 315        buffers
 316        (concat
 317         (riece-concat-message
 318          (format (riece-mcat "%s killed %s")
 319                  (riece-format-identity killer-identity t)
 320                  (riece-format-identity user-identity t))
 321          message)
 322         "\n"))
 323       (riece-insert-change
 324        (if (and riece-channel-buffer-mode
 325                 (not (memq riece-channel-buffer buffers)))
 326            (list riece-dialogue-buffer riece-others-buffer)
 327          riece-dialogue-buffer)
 328        (concat
 329         (riece-concat-server-name
 330          (riece-concat-message
 331           (format (riece-mcat "%s killed %s")
 332                  (riece-format-identity killer-identity t)
 333                  (riece-format-identity user-identity t))
 334           message))
 335         "\n")))))
 336
 337 (defun riece-handle-invite-message (prefix string)
 338   (let* ((user (riece-prefix-nickname prefix))
 339          (parameters (riece-split-parameters string))
 340          (invited (car parameters))
 341          (channel (nth 1 parameters))
 342          (channel-identity (riece-make-identity channel riece-server-name)))
 343     (if (riece-identity-equal-no-server invited riece-real-nickname)
 344         (setq riece-join-channel-candidate channel-identity))
 345     (riece-insert-info
 346      (list riece-dialogue-buffer riece-others-buffer)
 347      (concat
 348       (riece-concat-server-name
 349        (format (riece-mcat "%s invites %s to %s")
 350                (riece-format-identity (riece-make-identity
 351                                        user riece-server-name))
 352                (riece-format-identity (riece-make-identity
 353                                        invited riece-server-name))
 354                (riece-format-identity channel-identity)))
 355       "\n"))))
 356
 357 (defun riece-handle-topic-message (prefix decoded)
 358   (let* ((user (riece-prefix-nickname prefix))
 359          (parameters (riece-split-parameters (riece-decoded-string decoded)))
 360          (channel (car parameters))
 361          topic
 362          (user-identity (riece-make-identity user riece-server-name))
 363          (channel-identity (riece-make-identity channel riece-server-name)))
 364     (setq parameters (riece-split-parameters
 365                       (riece-decoded-string-for-identity decoded
 366                                                          channel-identity))
 367           topic (nth 1 parameters))
 368     (riece-channel-set-topic (riece-get-channel channel) topic)
 369     (riece-emit-signal 'channel-topic-changed
 370                        channel-identity topic)
 371     (let ((buffer (riece-channel-buffer channel-identity)))
 372       (riece-insert-change
 373        buffer
 374        (format (riece-mcat "Topic by %s: %s\n")
 375                (riece-format-identity user-identity t)
 376                topic))
 377       (riece-insert-change
 378        (if (and riece-channel-buffer-mode
 379                 (not (eq buffer riece-channel-buffer)))
 380            (list riece-dialogue-buffer riece-others-buffer)
 381          riece-dialogue-buffer)
 382        (concat
 383         (riece-concat-server-name
 384          (format (riece-mcat "Topic on %s by %s: %s")
 385                  (riece-format-identity channel-identity t)
 386                  (riece-format-identity user-identity t)
 387                  topic))
 388         "\n")))))
 389
 390 (defun riece-handle-mode-message (prefix string)
 391   (let* ((user (riece-prefix-nickname prefix))
 392          (user-identity (riece-make-identity user riece-server-name))
 393          channel)
 394     (when (string-match "^\\([^ ]+\\) *:?" string)
 395       (setq channel (match-string 1 string)
 396             string (substring string (match-end 0)))
 397       (if (string-match (concat "^" riece-channel-regexp "$") channel)
 398           (riece-naming-assert-channel-modes channel
 399                                              (riece-parse-modes string)))
 400       (let* ((channel-identity (riece-make-identity channel riece-server-name))
 401              (buffer (riece-channel-buffer channel-identity)))
 402         (riece-insert-change
 403          buffer
 404          (format (riece-mcat "Mode by %s: %s\n")
 405                  (riece-format-identity user-identity t)
 406                  string))
 407         (riece-insert-change
 408          (if (and riece-channel-buffer-mode
 409                   (not (eq buffer riece-channel-buffer)))
 410              (list riece-dialogue-buffer riece-others-buffer)
 411            riece-dialogue-buffer)
 412          (concat
 413           (riece-concat-server-name
 414            (format (riece-mcat "Mode on %s by %s: %s")
 415                    (riece-format-identity channel-identity t)
 416                    (riece-format-identity user-identity t)
 417                    string))
 418           "\n"))))))
 419
 420 (provide 'riece-handle)
 421
 422 ;;; riece-handle.el ends here