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