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