lisp/liece-handle.el

   1 ;;; liece-handle.el --- implementation of IRC message handlers
   2 ;; Copyright (C) 1998-2000 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Revised: 1998-11-25
   7 ;; Keywords: IRC, liece
   8
   9 ;; This file is part of Liece.
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31
  32 (eval-when-compile
  33   (require 'liece-inlines)
  34   (require 'liece-misc)
  35   (require 'liece-intl))
  36
  37 (require 'liece-message)
  38 (require 'liece-filter)
  39
  40 (require 'liece-handler)
  41
  42 (defmacro liece-handle-prepare-comment (rest &optional quote)
  43   `(if (zerop (length ,rest))
  44        ""
  45      (if ,quote
  46          (regexp-quote (format " (%s)" ,rest))
  47        (format " (%s)" ,rest))))
  48
  49 (defmacro liece-handle-message-check-empty (msg)
  50   `(string= ,msg ""))
  51
  52 (defmacro liece-handle-message-check-ignored (prefix rest)
  53   `(and ,prefix
  54         (liece-ignore-this-p ,prefix liece-user-at-host)
  55         (liece-message-from-ignored ,prefix ,rest)))
  56
  57 (defmacro liece-handle-check-changes-ignored ()
  58   'liece-ignore-changes)
  59
  60 (defconst liece-handle-ctcp-message-regexp "\001\\(.*\\)\001")
  61
  62 (defmacro liece-handle-ctcp-message-p (msg)
  63   `(string-match liece-handle-ctcp-message-regexp ,msg))
  64
  65 (autoload 'liece-ctcp-message "liece-ctcp")
  66 (autoload 'liece-ctcp-notice "liece-ctcp")
  67
  68 \f
  69 (liece-handler-define-backend "generic")
  70
  71 (mapcar
  72  (lambda (message)
  73    (liece-handler-define-function
  74     message '(prefix rest "generic")
  75     (intern (format "liece-handle-%s-message" message)))
  76    (defvar ,(intern (format "liece-%s-hook" message)) nil)
  77    (defvar ,(intern (format "liece-after-%s-hook" message)) nil))
  78  '("nick" "notice" "privmsg" "ping" "wall" "wallops" "quit" "topic"
  79    "mode" "kick" "invite" "kill" "join" "part" "silence"))
  80
  81 (defun* liece-handle-nick-message (prefix rest)
  82   (let ((chnls (liece-nick-get-joined-channels prefix)))
  83     (liece-nick-change prefix rest)
  84     (cond
  85      ((liece-nick-equal prefix liece-real-nickname)
  86       (setq liece-nickname-last liece-real-nickname
  87             liece-real-nickname rest))
  88      ((liece-nick-member prefix liece-current-chat-partners)
  89       (setq liece-current-chat-partners
  90             (string-list-modify-ignore-case (list (cons prefix rest))
  91                                             liece-current-chat-partners))
  92       (setcar (string-assoc-ignore-case prefix liece-nick-buffer-alist)
  93               rest)
  94       (setcar (string-assoc-ignore-case prefix liece-channel-buffer-alist)
  95               rest)
  96       (if (liece-nick-equal prefix liece-current-chat-partner)
  97           (setq liece-current-chat-partner rest))
  98       (add-to-list 'chnls rest)
  99       (liece-channel-change)))
 100     (if (liece-handle-check-changes-ignored)
 101         (return-from liece-handle-nick-message))
 102     (liece-insert-change (append (liece-pick-buffer chnls)
 103                                   liece-D-buffer liece-O-buffer)
 104                           (format (_ "%s is now known as %s\n") prefix rest))))
 105
 106 (defun* liece-handle-notice-message (prefix rest)
 107   (if (liece-handle-message-check-ignored prefix rest)
 108       (return-from liece-handle-notice-message))
 109   (or liece-ignore-extra-notices
 110         prefix
 111         (string-match "as being away" rest)
 112         (return-from liece-handle-notice-message))
 113
 114   ;; No prefix. This is a server notice.
 115   (when (and (null prefix) (string-match "^[^ ]* +:?" rest))
 116     (liece-insert-notice (append liece-D-buffer liece-O-buffer)
 117                           (concat (substring rest (match-end 0)) "\n"))
 118     (return-from liece-handle-notice-message))
 119   (multiple-value-bind (chnl temp) (liece-split-line rest)
 120     ;; This is a ctcp reply but contains additional messages
 121     ;; at the left or/and right side.
 122     (if (liece-handle-ctcp-message-p temp)
 123         (setq temp (liece-ctcp-notice prefix temp)))
 124     (if (liece-handle-message-check-empty temp)
 125         (return-from liece-handle-notice-message))
 126
 127     ;; Normal message via notice.
 128     (setq chnl (liece-channel-virtual chnl))
 129     (let ((liece-message-target chnl)
 130           (liece-message-speaker prefix)
 131           (liece-message-type 'notice))
 132       (liece-display-message temp))))
 133
 134 (defun* liece-handle-privmsg-message (prefix rest)
 135   (if (liece-handle-message-check-ignored prefix rest)
 136       (return-from liece-handle-privmsg-message))
 137   (multiple-value-bind (chnl temp) (liece-split-line rest)
 138     (setq temp (or temp ""))
 139     ;; This is a ctcp request but contains additional messages
 140     ;; at the left or/and right side.
 141     (if (liece-handle-ctcp-message-p temp)
 142         (setq temp (liece-ctcp-message prefix chnl temp)))
 143     (if (liece-handle-message-check-empty temp)
 144         (return-from liece-handle-privmsg-message))
 145
 146     (setq chnl (liece-channel-virtual chnl))
 147
 148     (when liece-beep-on-bells
 149       (if (string-match "\007" rest)
 150           (liece-beep))
 151       (if (liece-nick-equal chnl liece-real-nickname)
 152           (and liece-beep-when-privmsg (liece-beep))
 153         (with-current-buffer (if liece-channel-buffer-mode
 154                                  (liece-pick-buffer-1 chnl)
 155                                liece-dialogue-buffer)
 156           (if liece-beep
 157               (liece-beep))))
 158       (dolist (word liece-beep-words-list)
 159         (if (string-match word rest)
 160             (liece-beep))))
 161
 162     ;; Append timestamp if we are being away.
 163     (if (and (string-equal "A" liece-away-indicator)
 164              (liece-nick-equal chnl liece-real-nickname))
 165         (setq temp
 166               (concat temp " ("
 167                       (funcall liece-format-time-function (current-time))
 168                       ")")))
 169
 170     ;; Normal message.
 171     (let ((liece-message-target chnl)
 172           (liece-message-speaker prefix)
 173           (liece-message-type 'privmsg))
 174       (liece-display-message temp))
 175
 176     ;; Append to the unread list.
 177     (let ((item (if (eq liece-command-buffer-mode 'chat)
 178                     liece-current-chat-partner
 179                   liece-current-channel)))
 180       (unless (and item (liece-channel-equal chnl item))
 181         (if (liece-channel-unread-p chnl)
 182             (setq liece-channel-unread-list
 183                   (delete chnl liece-channel-unread-list)))
 184         (setq liece-channel-unread-list
 185               (cons chnl liece-channel-unread-list))
 186       (run-hook-with-args 'liece-channel-unread-functions chnl)))
 187
 188     (if (and (liece-nick-equal chnl liece-real-nickname)
 189              (if (and liece-current-chat-partner
 190                       (eq liece-command-buffer-mode 'chat))
 191                  (not (liece-nick-equal prefix liece-current-chat-partner))
 192                t))
 193         (liece-message (_ "A private message has arrived from %s")
 194                        prefix))))
 195
 196 (defun liece-handle-ping-message (prefix rest)
 197   (liece-send "PONG :%s" rest)
 198   (liece-command-timestamp-if-interval-expired t)
 199   (liece-maybe-poll))
 200
 201 (defun liece-handle-wall-message (prefix rest)
 202   (liece-insert-broadcast (append liece-D-buffer liece-O-buffer)
 203                            (concat (if prefix (concat "from " prefix) "") " "
 204                                    rest "\n")))
 205
 206 (defun liece-handle-wallops-message (prefix rest)
 207   (if liece-show-wallops
 208       (liece-insert-wallops (append liece-D-buffer liece-O-buffer)
 209                              (concat (if prefix prefix "UNKNOWN")
 210                                      ": " rest "\n")))
 211   (liece-insert-wallops liece-W-buffer
 212                          (concat (if prefix (concat "from " prefix) "") " "
 213                                  rest "\n")))
 214
 215 (defun* liece-handle-quit-message (prefix rest)
 216   (let ((chnls (liece-nick-get-joined-channels prefix)) text match default)
 217     ;; Mark temporary apart, if quitting user is one of our chat partners.
 218     (when (liece-nick-member prefix liece-current-chat-partners)
 219       (add-to-list 'chnls prefix)
 220       (liece-nick-mark-as-part t prefix))
 221     (if (liece-handle-check-changes-ignored)
 222         (return-from liece-handle-quit-message))
 223     (cond
 224      (liece-compress-changes
 225       (setq text (format (_ " \\(has\\|have\\) left IRC%s")
 226                          (liece-handle-prepare-comment rest t))
 227             match (format "^%s%s.*%s$"
 228                           (if liece-display-time
 229                               liece-time-prefix-regexp "")
 230                           (regexp-quote liece-change-prefix)
 231                           (regexp-quote text))
 232             default (format (_ "%s%s has left IRC%s\n")
 233                             liece-change-prefix prefix
 234                             (liece-handle-prepare-comment rest)))
 235       (liece-replace (append (liece-pick-buffer chnls)
 236                               liece-D-buffer liece-O-buffer)
 237                       match default text
 238                       (format (_ ", %s have left IRC%s")
 239                               prefix (liece-handle-prepare-comment rest))))
 240      (t
 241       (liece-insert-change (append (liece-pick-buffer chnls)
 242                                     liece-D-buffer liece-O-buffer)
 243                             (format (_ "%s has left IRC%s\n")
 244                                     (liece-handle-prepare-comment rest)))))
 245     (liece-nick-change prefix nil)))
 246
 247 (defun* liece-handle-topic-message (prefix rest)
 248   (multiple-value-bind (chnl topic) (liece-split-line rest)
 249     (setq chnl (liece-channel-virtual chnl)
 250           topic (or topic ""))
 251     (liece-channel-set-topic topic chnl)
 252     (if (liece-handle-check-changes-ignored)
 253         (return-from liece-handle-topic-message))
 254     (liece-insert-change (liece-pick-buffer chnl)
 255                           (format (_ "New topic on channel %s set by %s: %s\n")
 256                                   chnl prefix topic))
 257     (liece-insert-change (if (liece-nick-equal chnl liece-current-channel)
 258                               liece-D-buffer
 259                             (append liece-D-buffer liece-O-buffer))
 260                           (format (_ "New topic on channel %s set by %s: %s\n")
 261                                   chnl prefix topic))
 262     (liece-set-channel-indicator)))
 263
 264 (defun* liece-handle-mode-message (prefix rest)
 265   (if (liece-handle-check-changes-ignored)
 266       (return-from liece-handle-mode-message))
 267   (let (mflgs margs val chnl mode chnlp)
 268     (if (string-match "\\([^ ]*\\) *:?" rest)
 269         (progn
 270           (setq chnl (match-string 1 rest)
 271                 mode (substring rest (match-end 0)))
 272           (if (liece-channel-p chnl)
 273               (setq chnl (liece-channel-virtual chnl) chnlp t))
 274           (if (string-match " *$" mode)
 275               (setq mode (substring mode 0 (match-beginning 0)))))
 276       (return-from liece-handle-mode-message))
 277     ;; parse modes
 278     (when (string-match "\\([^ ]*\\) *" mode)
 279       (setq mflgs (liece-string-to-list (match-string 1 mode))
 280             margs (delete "" (split-string
 281                               (substring mode (match-end 0))
 282                               "[ ]+")))
 283       (while mflgs
 284         (cond ((eq ?- (car mflgs)) (setq val nil))
 285               ((eq ?+ (car mflgs)) (setq val t))
 286               ((and chnlp (eq ?o (car mflgs)))
 287                (liece-channel-set-operator chnl (car margs) val)
 288                (setq margs (cdr margs)))
 289               ((and chnlp (eq ?v (car mflgs)))
 290                (liece-channel-set-voice chnl (car margs) val)
 291                (setq margs (cdr margs)))
 292               ((and chnlp (eq ?b (car mflgs)))
 293                (liece-channel-set-ban chnl (car margs) val)
 294                (setq margs (cdr margs)))
 295               ((and chnlp (eq ?e (car mflgs)))
 296                (liece-channel-set-exception chnl (car margs) val)
 297                (setq margs (cdr margs)))
 298               ((and chnlp (eq ?I (car mflgs)))
 299                (liece-channel-set-invite chnl (car margs) val)
 300                (setq margs (cdr margs)))
 301               (chnlp (liece-channel-set-mode chnl (car mflgs) val))
 302               (t (liece-nick-set-mode chnl (car mflgs) val)))
 303         (setq mflgs (cdr mflgs))))
 304     (liece-set-channel-indicator)
 305     (cond
 306      (liece-compress-changes
 307       (let* ((text (concat (regexp-quote rest) "\n"))
 308              (match (format (_ "^%s%sNew mode for %s set by %s: ")
 309                             (if liece-display-time
 310                                 liece-time-prefix-regexp "")
 311                             (regexp-quote liece-change-prefix)
 312                             (regexp-quote chnl) (regexp-quote prefix)))
 313              (default (format (_ "%sNew mode for %s set by %s: %s\n")
 314                               liece-change-prefix chnl prefix mode)))
 315         (liece-replace (liece-pick-buffer chnl)
 316                         match default text (concat ", " mode "\n"))
 317         (liece-replace (if (and liece-current-channel
 318                                  (liece-channel-equal
 319                                   chnl liece-current-channel))
 320                             liece-D-buffer
 321                           (append liece-D-buffer liece-O-buffer))
 322                         match default text (concat ", " mode "\n"))))
 323      (t
 324       (liece-insert-change (liece-pick-buffer chnl)
 325                             (format (_ "New mode for %s set by %s: %s\n")
 326                                     chnl prefix mode))
 327       (liece-insert-change (if (and liece-current-channel
 328                                      (liece-channel-equal
 329                                       chnl liece-current-channel))
 330                                 liece-D-buffer
 331                               (append liece-D-buffer liece-O-buffer))
 332                             (format (_ "New mode for %s set by %s: %s\n")
 333                                     chnl prefix mode))))))
 334
 335 (defun* liece-handle-kick-message (prefix rest)
 336   (if (/= 3 (length (setq rest (liece-split-line rest))))
 337       (return-from liece-handle-kick-message))
 338   (multiple-value-bind (chnl nick message) rest
 339     (setq chnl (liece-channel-virtual chnl))
 340
 341     (if (liece-nick-equal nick liece-real-nickname)
 342         (progn
 343           (liece-insert-change
 344            (liece-pick-buffer chnl)
 345            (format (_ "You were kicked off channel %s by %s (%s).\n")
 346                    chnl prefix message))
 347           (liece-channel-part chnl))
 348       (liece-nick-part nick chnl))
 349
 350     (if (liece-handle-check-changes-ignored)
 351         (return-from liece-handle-kick-message))
 352
 353     (liece-insert-change
 354      (append (liece-pick-buffer chnl)
 355              (if (liece-channel-equal chnl liece-current-channel)
 356                  liece-D-buffer
 357                (append liece-D-buffer liece-O-buffer)))
 358      (format "%s has kicked %s out%s%s\n"
 359              prefix nick
 360              (if (string= (or liece-current-channel "") chnl)
 361                  ""
 362                (format " from channel %s" chnl))
 363              (if (not message)
 364                  ""
 365                (format " (%s)" message))))))
 366
 367 (defun* liece-handle-invite-message (prefix rest)
 368   (or (string-match " +:" rest)
 369       (return-from liece-handle-invite-message))
 370   (and liece-beep-when-invited liece-beep-on-bells
 371        (liece-beep))
 372   (let ((chnl (liece-channel-virtual (substring rest (match-end 0)))))
 373     (liece-insert-info (append liece-D-buffer liece-O-buffer)
 374                         (format "%s invites you to channel %s\n"
 375                                 prefix chnl))
 376     (setq liece-default-channel-candidate chnl)))
 377
 378 (defun* liece-handle-kill-message (prefix rest)
 379   (or (string-match " +:" rest)
 380       (return-from liece-handle-kill-message))
 381   (let ((path (substring rest (match-end 0))))
 382     (liece-insert-info (append liece-D-buffer liece-O-buffer)
 383                         (format "You were killed by %s. (Path: %s. RIP)\n"
 384                                 prefix path)))
 385   (liece-close-server))
 386
 387 (defun* liece-handle-join-message (prefix rest)
 388   (let (flag (xnick prefix) (nick prefix) (chnl rest))
 389     (cond
 390      ((string-match "\007[ov]" chnl)
 391       (setq flag (aref (match-string 0 chnl) 1)
 392             chnl (substring rest 0 (match-beginning 0))))
 393      ((string-match " +$" chnl)
 394       (setq chnl (substring chnl 0 (match-beginning 0)))))
 395     (setq chnl (liece-channel-virtual chnl))
 396     (liece-nick-set-user-at-host nick liece-user-at-host)
 397     (if (liece-nick-equal nick liece-real-nickname)
 398         (progn
 399           (and liece-gather-channel-modes
 400                (not (liece-channel-modeless-p (liece-channel-real chnl)))
 401                (liece-send "MODE %s " (liece-channel-real chnl)))
 402           (liece-channel-join chnl))
 403       (liece-nick-join nick chnl))
 404     (cond
 405      ((eq flag ?o)
 406       (liece-channel-set-operator chnl xnick t)
 407       (setq xnick (concat "@" xnick)))
 408      ((eq flag ?v)
 409       (liece-channel-set-voice chnl xnick t)
 410       (setq xnick (concat "+" xnick))))
 411     (if (liece-handle-check-changes-ignored)
 412         (return-from liece-handle-join-message))
 413     ;; Restore the private conversation to its original state.
 414     (when (and (liece-nick-member nick liece-current-chat-partners)
 415                (get (intern nick liece-obarray) 'part))
 416       (liece-insert-change (liece-pick-buffer nick)
 417                             (format (_ "%s has come back as (%s)\n")
 418                                     nick liece-user-at-host))
 419       (liece-nick-mark-as-part nil nick))
 420     (cond
 421      (liece-compress-changes
 422       (let* ((text (format (_ " \\(has\\|have\\) joined channel %s")
 423                            (regexp-quote chnl)))
 424              (match (format "^%s%s.*%s$"
 425                             (if liece-display-time
 426                                 liece-time-prefix-regexp "")
 427                             (regexp-quote liece-change-prefix)
 428                             (regexp-quote text)))
 429              (default (format (_ "%s%s (%s) has joined channel %s\n")
 430                               liece-change-prefix
 431                               nick liece-user-at-host chnl)))
 432         (liece-replace (liece-pick-buffer chnl)
 433                         match default text
 434                         (format (_ ", %s (%s) have joined channel %s")
 435                                 nick liece-user-at-host chnl))
 436         (liece-replace (if (and liece-current-channel
 437                                  (liece-channel-equal chnl
 438                                                        liece-current-channel))
 439                             liece-D-buffer
 440                           (append liece-D-buffer liece-O-buffer))
 441                         match default text
 442                         (format (_ ", %s (%s) have joined channel %s")
 443                                 nick liece-user-at-host chnl))))
 444      (t
 445       (liece-insert-change (liece-pick-buffer chnl)
 446                             (format (_ "%s (%s) has joined channel %s\n")
 447                                     nick liece-user-at-host chnl))
 448       (liece-insert-change (if (liece-channel-equal chnl
 449                                                       liece-current-channel)
 450                                 liece-D-buffer
 451                               (append liece-D-buffer liece-O-buffer))
 452                             (format (_ "%s (%s) has joined channel %s\n")
 453                                     nick liece-user-at-host chnl))))))
 454
 455 (defun* liece-handle-part-message (prefix rest)
 456   (multiple-value-bind (chnl comment text match default buf) (liece-split-line rest)
 457     (setq chnl (liece-channel-virtual chnl)
 458           comment (liece-handle-prepare-comment comment))
 459
 460     (if (liece-nick-equal prefix liece-real-nickname)
 461         (liece-channel-part chnl)
 462       (liece-nick-part prefix chnl))
 463
 464     (if (liece-handle-check-changes-ignored)
 465         (return-from liece-handle-part-message))
 466
 467     (setq buf (append liece-D-buffer (liece-pick-buffer chnl)))
 468     (unless (and liece-current-channel
 469                  (liece-channel-equal chnl liece-current-channel))
 470       (setq buf (append buf liece-O-buffer)))
 471     (cond
 472      (liece-compress-changes
 473       (setq text (format (_ " \\(has\\|have\\) left channel %s%s")
 474                          (regexp-quote chnl) (regexp-quote comment))
 475             match (format "^%s%s.*%s$"
 476                           (if liece-display-time
 477                               liece-time-prefix-regexp "")
 478                           (regexp-quote liece-change-prefix)
 479                           (regexp-quote text))
 480             default (format (_ "%s%s has left channel %s%s\n")
 481                             liece-change-prefix prefix chnl comment))
 482       (liece-replace buf
 483                       match default text
 484                       (format (_ ", %s have left channel %s%s")
 485                               prefix chnl comment)))
 486      (t
 487       (liece-insert-change buf
 488                             (format (_ "%s has left channel %s%s\n")
 489                                     prefix chnl comment))))))
 490
 491 (defun* liece-handle-silence-message (prefix rest)
 492   (let* ((flag (aref rest 0)) (rest (substring rest 1)))
 493     (liece-insert-info (append liece-D-buffer liece-O-buffer)
 494                         (concat "User " rest
 495                                 (if (eq flag ?-) "unsilenced" "silenced")))))
 496
 497 (provide 'liece-handle)
 498
 499 ;;; liece-handle.el ends here