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