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 (eval-when-compile (require 'riece-inlines))
  28
  29 (require 'riece-misc)
  30 (require 'riece-message)
  31 (require 'riece-channel)
  32 (require 'riece-naming)
  33 (require 'riece-display)
  34
  35 (defun riece-handle-nick-message (prefix string)
  36   (let* ((old (riece-prefix-nickname prefix))
  37          (new (car (riece-split-parameters string)))
  38          (channels (riece-user-get-channels old))
  39          (visible (riece-identity-member riece-current-channel channels)))
  40     (riece-naming-assert-rename old new)
  41     (let ((pointer (riece-identity-member
  42                     (riece-make-identity old)
  43                     riece-current-channels)))
  44       (when pointer
  45         (setcar pointer (riece-make-identity new))
  46         (setcar (riece-identity-assoc (riece-make-identity old)
  47                                       riece-channel-buffer-alist)
  48                 (riece-make-identity new))
  49         (setcar (riece-identity-assoc (riece-make-identity old)
  50                                       riece-user-list-buffer-alist)
  51                 (riece-make-identity new))
  52         (if (riece-identity-equal (riece-make-identity old)
  53                                   riece-current-channel)
  54             (riece-switch-to-channel (riece-make-identity new)))
  55         (setq channels (cons (riece-make-identity new) channels))))
  56     (riece-insert-change (mapcar
  57                           (lambda (channel)
  58                             (cdr (riece-identity-assoc
  59                                   (riece-make-identity channel)
  60                                   riece-channel-buffer-alist)))
  61                           channels)
  62                          (format "%s -> %s\n" old new))
  63     (riece-insert-change (if visible
  64                              riece-dialogue-buffer
  65                            (list riece-dialogue-buffer riece-others-buffer))
  66                          (concat
  67                           (riece-concat-server-name
  68                            (format "%s -> %s" old new))
  69                           "\n"))
  70     (riece-redisplay-buffers)))
  71
  72 (defun riece-handle-privmsg-message (prefix string)
  73   (let* ((user (riece-prefix-nickname prefix))
  74          (parameters (riece-split-parameters string))
  75          (targets (split-string (car parameters) ","))
  76          (message (nth 1 parameters)))
  77     (unless (equal message "")          ;not ignored by server?
  78       (riece-display-message
  79        (riece-make-message user (riece-make-identity (car targets))
  80                            message)))))
  81
  82 (defun riece-handle-notice-message (prefix string)
  83   (let* ((user (if prefix
  84                    (riece-prefix-nickname prefix)))
  85          (parameters (riece-split-parameters string))
  86          (targets (split-string (car parameters) ","))
  87          (message (nth 1 parameters)))
  88     (unless (equal message "")          ;not ignored by server?
  89       (if user
  90           (riece-display-message
  91            (riece-make-message user (riece-make-identity (car targets))
  92                                message 'notice))
  93         ;; message from server
  94         (riece-insert-notice
  95          (list riece-dialogue-buffer riece-others-buffer)
  96          (concat (riece-concat-server-name message) "\n"))))))
  97
  98 (defun riece-handle-ping-message (prefix string)
  99   (riece-send-string (format "PONG :%s\r\n"
 100                              (if (eq (aref string 0) ?:)
 101                                  (substring string 1)
 102                                string))))
 103
 104 (defun riece-handle-join-message (prefix string)
 105   (let ((user (riece-prefix-nickname prefix))
 106         (channels (split-string (car (riece-split-parameters string)) ",")))
 107     (while channels
 108       (riece-naming-assert-join user (car channels))
 109       ;;XXX
 110       (if (riece-identity-equal-no-server user riece-real-nickname)
 111           (riece-switch-to-channel (riece-make-identity (car channels))))
 112       (let ((buffer (cdr (riece-identity-assoc
 113                           (riece-make-identity (car channels))
 114                           riece-channel-buffer-alist))))
 115         (riece-insert-change
 116          buffer
 117          (format "%s (%s) has joined %s\n"
 118                  user
 119                  (riece-user-get-user-at-host user)
 120                  (car channels)))
 121         (riece-insert-change
 122          (if (and riece-channel-buffer-mode
 123                   (not (eq buffer riece-channel-buffer)))
 124              (list riece-dialogue-buffer riece-others-buffer)
 125            riece-dialogue-buffer)
 126          (concat
 127           (riece-concat-server-name
 128            (format "%s (%s) has joined %s"
 129                    user
 130                    (riece-user-get-user-at-host user)
 131                    (car channels)))
 132           "\n")))
 133       (setq channels (cdr channels)))
 134     (riece-redisplay-buffers)))
 135
 136 (defun riece-handle-part-message (prefix string)
 137   (let* ((user (riece-prefix-nickname prefix))
 138          (parameters (riece-split-parameters string))
 139          (channels (split-string (car parameters) ","))
 140          (message (nth 1 parameters)))
 141     (while channels
 142       (riece-naming-assert-part user (car channels))
 143       (let ((buffer (cdr (riece-identity-assoc
 144                           (riece-make-identity (car channels))
 145                           riece-channel-buffer-alist))))
 146         (riece-insert-change
 147          buffer
 148          (concat
 149           (riece-concat-message
 150            (format "%s has left %s" user (car channels))
 151            message)
 152           "\n"))
 153         (riece-insert-change
 154          (if (and riece-channel-buffer-mode
 155                   (not (eq buffer riece-channel-buffer)))
 156              (list riece-dialogue-buffer riece-others-buffer)
 157            riece-dialogue-buffer)
 158          (concat
 159           (riece-concat-server-name
 160            (riece-concat-message
 161             (format "%s has left %s" user (car channels))
 162             message))
 163           "\n")))
 164       (setq channels (cdr channels)))
 165     (riece-redisplay-buffers)))
 166
 167 (defun riece-handle-kick-message (prefix string)
 168   (let* ((kicker (riece-prefix-nickname prefix))
 169          (parameters (riece-split-parameters string))
 170          (channel (car parameters))
 171          (user (nth 1 parameters))
 172          (message (nth 2 parameters)))
 173     (riece-naming-assert-part user channel)
 174     (let ((buffer (cdr (riece-identity-assoc
 175                         (riece-make-identity channel)
 176                         riece-channel-buffer-alist))))
 177       (riece-insert-change
 178        buffer
 179        (concat
 180         (riece-concat-message
 181          (format "%s kicked %s out from %s" kicker user channel)
 182          message)
 183         "\n"))
 184       (riece-insert-change
 185        (if (and riece-channel-buffer-mode
 186                 (not (eq buffer riece-channel-buffer)))
 187            (list riece-dialogue-buffer riece-others-buffer)
 188          riece-dialogue-buffer)
 189        (concat
 190         (riece-concat-server-name
 191          (riece-concat-message
 192           (format "%s kicked %s out from %s\n" kicker user channel)
 193           message))
 194         "\n")))
 195     (riece-redisplay-buffers)))
 196
 197 (defun riece-handle-quit-message (prefix string)
 198   (let* ((user (riece-prefix-nickname prefix))
 199          (channels (copy-sequence (riece-user-get-channels user)))
 200          (pointer channels)
 201          (message (car (riece-split-parameters string))))
 202     ;; If you are quitting, no need to cleanup.
 203     (unless (riece-identity-equal-no-server user riece-real-nickname)
 204       ;; You were talking with the user.
 205       (if (riece-identity-member (riece-make-identity user)
 206                                  riece-current-channels)
 207           (riece-part-channel user)) ;XXX
 208       (setq pointer channels)
 209       (while pointer
 210         (riece-naming-assert-part user (car pointer))
 211         (setq pointer (cdr pointer)))
 212       (let ((buffers
 213              (mapcar
 214               (lambda (channel)
 215                 (cdr (riece-identity-assoc
 216                       (riece-make-identity channel)
 217                       riece-channel-buffer-alist)))
 218               channels)))
 219         (riece-insert-change buffers
 220                              (concat (riece-concat-message
 221                                       (format "%s has left IRC" user)
 222                                       message)
 223                                      "\n"))
 224         (riece-insert-change (if (and riece-channel-buffer-mode
 225                                       (not (memq riece-channel-buffer
 226                                                  buffers)))
 227                                  (list riece-dialogue-buffer
 228                                        riece-others-buffer)
 229                                riece-dialogue-buffer)
 230                              (concat
 231                               (riece-concat-server-name
 232                                (riece-concat-message
 233                                 (format "%s has left IRC" user)
 234                                 message))
 235                               "\n"))))
 236     (riece-redisplay-buffers)))
 237
 238 (defun riece-handle-kill-message (prefix string)
 239   (let* ((killer (riece-prefix-nickname prefix))
 240          (parameters (riece-split-parameters string))
 241          (user (car parameters))
 242          (message (nth 1 parameters))
 243          (channels (copy-sequence (riece-user-get-channels user)))
 244          pointer)
 245     ;; You were talking with the user.
 246     (if (riece-identity-member (riece-make-identity user)
 247                                riece-current-channels)
 248         (riece-part-channel user)) ;XXX
 249     (setq pointer channels)
 250     (while pointer
 251       (riece-naming-assert-part user (car pointer))
 252       (setq pointer (cdr pointer)))
 253     (let ((buffers
 254            (mapcar
 255             (lambda (channel)
 256               (cdr (riece-identity-assoc
 257                     (riece-make-identity channel)
 258                     riece-channel-buffer-alist)))
 259             channels)))
 260       (riece-insert-change buffers
 261                            (concat (riece-concat-message
 262                                     (format "%s killed %s" killer user)
 263                                     message)
 264                                    "\n"))
 265       (riece-insert-change (if (and riece-channel-buffer-mode
 266                                     (not (memq riece-channel-buffer
 267                                                buffers)))
 268                                (list riece-dialogue-buffer
 269                                      riece-others-buffer)
 270                              riece-dialogue-buffer)
 271                            (concat
 272                             (riece-concat-server-name
 273                              (riece-concat-message
 274                               (format "%s killed %s" killer user)
 275                              message))
 276                             "\n")))
 277     (riece-redisplay-buffers)))
 278
 279 (defun riece-handle-invite-message (prefix string)
 280   (let* ((user (riece-prefix-nickname prefix))
 281          (parameters (riece-split-parameters string))
 282          (channel (car parameters)))
 283     (riece-insert-info
 284      (list riece-dialogue-buffer riece-others-buffer)
 285      (concat
 286       (riece-concat-server-name
 287        (format "%s invites you to %s" user channel))
 288       "\n"))))
 289
 290 (defun riece-handle-topic-message (prefix string)
 291   (let* ((user (riece-prefix-nickname prefix))
 292          (parameters (riece-split-parameters string))
 293          (channel (car parameters))
 294          (topic (nth 1 parameters)))
 295     (riece-channel-set-topic (riece-get-channel channel) topic)
 296     (let ((buffer (cdr (riece-identity-assoc
 297                         (riece-make-identity channel)
 298                         riece-channel-buffer-alist))))
 299       (riece-insert-change
 300        buffer
 301        (format "Topic by %s: %s\n" user topic))
 302       (riece-insert-change
 303        (if (and riece-channel-buffer-mode
 304                 (not (eq buffer riece-channel-buffer)))
 305            (list riece-dialogue-buffer riece-others-buffer)
 306          riece-dialogue-buffer)
 307        (concat
 308         (riece-concat-server-name
 309          (format "Topic on %s by %s: %s" channel user topic))
 310         "\n"))
 311       (riece-redisplay-buffers))))
 312
 313 (defsubst riece-parse-channel-modes (string channel)
 314   (while (string-match "^[-+]\\([^ ]*\\) *" string)
 315     (let ((toggle (aref string 0))
 316           (modes (string-to-list (match-string 1 string))))
 317       (setq string (substring string (match-end 0)))
 318       (while modes
 319         (if (and (memq (car modes) '(?O ?o ?v ?k ?l ?b ?e ?I))
 320                  (string-match "\\([^-+][^ ]*\\) *" string))
 321             (let ((parameter (match-string 1 string)))
 322               (setq string (substring string (match-end 0)))
 323               (cond
 324                ((eq (car modes) ?o)
 325                 (riece-channel-toggle-operator channel parameter
 326                                                (eq toggle ?+)))
 327                ((eq (car modes) ?v)
 328                 (riece-channel-toggle-speaker channel parameter
 329                                               (eq toggle ?+)))
 330                ((eq (car modes) ?b)
 331                 (riece-channel-toggle-banned channel parameter
 332                                              (eq toggle ?+)))
 333                ((eq (car modes) ?e)
 334                 (riece-channel-toggle-uninvited channel parameter
 335                                                 (eq toggle ?+)))
 336                ((eq (car modes) ?I)
 337                 (riece-channel-toggle-invited channel parameter
 338                                               (eq toggle ?+)))))
 339           (riece-channel-toggle-mode channel (car modes)
 340                                      (eq toggle ?+)))
 341         (setq modes (cdr modes))))))
 342
 343 (defun riece-handle-mode-message (prefix string)
 344   (let ((user (riece-prefix-nickname prefix))
 345         channel)
 346     (when (string-match "\\([^ ]+\\) *:?" string)
 347       (setq channel (match-string 1 string)
 348             string (substring string (match-end 0)))
 349       (riece-parse-channel-modes string channel)
 350       (let ((buffer (cdr (riece-identity-assoc
 351                           (riece-make-identity channel)
 352                           riece-channel-buffer-alist))))
 353         (riece-insert-change
 354          buffer
 355          (format "Mode by %s: %s\n" user string))
 356         (riece-insert-change
 357          (if (and riece-channel-buffer-mode
 358                   (not (eq buffer riece-channel-buffer)))
 359              (list riece-dialogue-buffer riece-others-buffer)
 360            riece-dialogue-buffer)
 361          (concat
 362           (riece-concat-server-name
 363            (format "Mode on %s by %s: %s" channel user string))
 364           "\n"))
 365         (riece-redisplay-buffers)))))
 366
 367 (provide 'riece-handle)
 368
 369 ;;; riece-handle.el ends here