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