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
 120   (with-liece-decryption (rest prefix)
 121     (if (run-hook-with-args-until-success 'liece-notice-cleartext-hook
 122                                           prefix rest)
 123         (return-from liece-handle-notice-message))
 124
 125     (multiple-value-bind (chnl temp) (liece-split-line rest)
 126       ;; This is a ctcp reply but contains additional messages
 127       ;; at the left or/and right side.
 128       (if (liece-handle-ctcp-message-p temp)
 129           (setq temp (liece-ctcp-notice prefix temp)))
 130       (if (liece-handle-message-check-empty temp)
 131           (return-from liece-handle-notice-message))
 132
 133       ;; Normal message via notice.
 134       (setq chnl (liece-channel-virtual chnl))
 135       (let ((liece-message-target chnl)
 136             (liece-message-speaker prefix)
 137             (liece-message-type 'notice))
 138         (liece-display-message temp)))))
 139
 140 (defun* liece-handle-privmsg-message (prefix rest)
 141   (if (liece-handle-message-check-ignored prefix rest)
 142       (return-from liece-handle-privmsg-message))
 143   (with-liece-decryption (rest prefix)
 144     (if (run-hook-with-args-until-success 'liece-privmsg-cleartext-hook
 145                                           prefix rest)
 146         (return-from liece-handle-privmsg-message))
 147
 148     (multiple-value-bind (chnl temp) (liece-split-line rest)
 149       (setq temp (or temp ""))
 150       ;; This is a ctcp request but contains additional messages
 151       ;; at the left or/and right side.
 152       (if (liece-handle-ctcp-message-p temp)
 153           (setq temp (liece-ctcp-message prefix chnl temp)))
 154       (if (liece-handle-message-check-empty temp)
 155           (return-from liece-handle-privmsg-message))
 156
 157       (setq chnl (liece-channel-virtual chnl))
 158
 159       ; beep
 160       (if liece-beep-on-bells
 161           (progn
 162             (and (string-match "\007" rest) (beep t))
 163             (if (liece-nick-equal chnl liece-real-nickname)
 164                 (and liece-beep-when-privmsg (beep t))
 165               (with-current-buffer (if liece-channel-buffer-mode
 166                                        (liece-pick-buffer-1 chnl)
 167                                      liece-dialogue-buffer)
 168                 (and liece-beep (beep t))))
 169             (let ((i 0)
 170                   (word (nth 0 liece-beep-words-list)))
 171               (while word
 172                 (and (string-match word rest) (beep t))
 173                 (setq i (1+ i))
 174                 (setq word (nth i liece-beep-words-list))))))
 175
 176       ;; Append timestamp if we are being away.
 177       (and (string-equal "A" liece-away-indicator)
 178            (liece-nick-equal chnl liece-real-nickname)
 179            (setq temp
 180                  (concat temp " ("
 181                          (funcall liece-format-time-function (current-time))
 182                          ")")))
 183
 184       ;; Normal message.
 185       (let ((liece-message-target chnl)
 186             (liece-message-speaker prefix)
 187             (liece-message-type 'privmsg))
 188         (liece-display-message temp))
 189
 190       ;; Append to the unread list.
 191       (let ((item (if (eq liece-command-buffer 'chat)
 192                       liece-current-chat-partner
 193                     liece-current-channel)))
 194         (if (liece-channel-equal chnl item)
 195             ()
 196           (and (liece-channel-unread-p chnl)
 197                (setq liece-channel-unread-list
 198                      (delete chnl liece-channel-unread-list)))
 199           (setq liece-channel-unread-list
 200                 (cons chnl liece-channel-unread-list))))
 201
 202       (and (liece-nick-equal chnl liece-real-nickname)
 203            (not (liece-nick-equal prefix liece-current-chat-partner))
 204            (liece-message (_ "A private message has arrived from %s")
 205                            prefix)))))
 206
 207 (defun liece-handle-ping-message (prefix rest)
 208   (liece-send "PONG :%s" rest)
 209   (liece-command-timestamp-if-interval-expired t)
 210   (liece-maybe-poll))
 211
 212 (defun liece-handle-wall-message (prefix rest)
 213   (liece-insert-broadcast (append liece-D-buffer liece-O-buffer)
 214                            (concat (if prefix (concat "from " prefix) "") " "
 215                                    rest "\n")))
 216
 217 (defun liece-handle-wallops-message (prefix rest)
 218   (if liece-show-wallops
 219       (liece-insert-wallops (append liece-D-buffer liece-O-buffer)
 220                              (concat (if prefix prefix "UNKNOWN")
 221                                      ": " rest "\n")))
 222   (liece-insert-wallops liece-W-buffer
 223                          (concat (if prefix (concat "from " prefix) "") " "
 224                                  rest "\n")))
 225
 226 (defun* liece-handle-quit-message (prefix rest)
 227   (let ((chnls (liece-nick-get-joined-channels prefix)) text match default)
 228     ;; Mark temporary apart, if quitting user is one of our chat partners.
 229     (when (liece-nick-member prefix liece-current-chat-partners)
 230       (add-to-list 'chnls prefix)
 231       (liece-nick-mark-as-apart prefix))
 232     (if (liece-handle-check-changes-ignored)
 233         (return-from liece-handle-quit-message))
 234     (cond
 235      (liece-compress-changes
 236       (setq text (format (_ " \\(has\\|have\\) left IRC%s")
 237                          (liece-handle-prepare-comment rest t))
 238             match (format "^%s%s.*%s$"
 239                           (if liece-display-time
 240                               liece-time-prefix-regexp "")
 241                           (regexp-quote liece-change-prefix)
 242                           (regexp-quote text))
 243             default (format (_ "%s%s has left IRC%s\n")
 244                             liece-change-prefix prefix
 245                             (liece-handle-prepare-comment rest)))
 246       (liece-replace (append (liece-pick-buffer chnls)
 247                               liece-D-buffer liece-O-buffer)
 248                       match default text
 249                       (format (_ ", %s have left IRC%s")
 250                               prefix (liece-handle-prepare-comment rest))))
 251      (t
 252       (liece-insert-change (append (liece-pick-buffer chnls)
 253                                     liece-D-buffer liece-O-buffer)
 254                             (format (_ "%s has left IRC%s\n")
 255                                     (liece-handle-prepare-comment rest)))))
 256     (liece-nick-change prefix nil)))
 257
 258 (defun* liece-handle-topic-message (prefix rest)
 259   (multiple-value-bind (chnl topic) (liece-split-line rest)
 260     (setq chnl (liece-channel-virtual chnl)
 261           topic (or topic ""))
 262     (liece-channel-set-topic topic chnl)
 263     (if (liece-handle-check-changes-ignored)
 264         (return-from liece-handle-topic-message))
 265     (liece-insert-change (liece-pick-buffer chnl)
 266                           (format (_ "New topic on channel %s set by %s: %s\n")
 267                                   chnl prefix topic))
 268     (liece-insert-change (if (liece-nick-equal chnl liece-current-channel)
 269                               liece-D-buffer
 270                             (append liece-D-buffer liece-O-buffer))
 271                           (format (_ "New topic on channel %s set by %s: %s\n")
 272                                   chnl prefix topic))
 273     (liece-set-channel-indicator)))
 274
 275 (defun* liece-handle-mode-message (prefix rest)
 276   (if (liece-handle-check-changes-ignored)
 277       (return-from liece-handle-mode-message))
 278   (let ((chnl " ") (str "") mflag mflags marg margs val md chnlp)
 279     (or (and (string-match "\\([^ ]*\\) +:?" rest)
 280              (setq chnl (match-string 1 rest)
 281                    str (substring rest (match-end 0))
 282                    chnlp (liece-channel-p chnl)
 283                    str (if (= (aref str (1- (length str))) ? )
 284                            (substring str 0 -1) str)
 285                    chnl (liece-channel-virtual chnl)))
 286         (and (string-match " +:" rest)
 287              (setq str (substring rest (match-end 0))))
 288         (return-from liece-handle-mode-message))
 289
 290     ;; parse modes
 291     (when (string-match "\\([^ ]*\\) +" str)
 292       (setq mflag (match-string 1 str)
 293             marg (substring str (match-end 0))
 294             mflags (string-to-char-list mflag))
 295       (while (string-match "^\\([^ ]*\\) +" marg)
 296         (setq margs (cons (match-string 1 marg) margs)
 297               marg (substring marg (match-end 0))))
 298       (or (string= marg "") (setq margs (cons marg margs)))
 299       (while (setq md (pop mflags))
 300         (cond ((eq ?- md) (setq val nil))
 301               ((eq ?+ md) (setq val t))
 302               ((eq ?o md) (liece-channel-set-operator chnl (pop margs) val))
 303               ((eq ?v md) (liece-channel-set-voice chnl (pop margs) val))
 304               ((eq ?b md) (liece-channel-set-ban chnl (pop margs) val))
 305               ((eq ?e md) (liece-channel-set-exception chnl (pop margs) val))
 306               ((eq ?I md) (liece-channel-set-invite chnl (pop margs) val))
 307               (chnlp (liece-channel-set-mode val md chnl))
 308               (t (liece-nick-set-mode val md chnl)))))
 309
 310     (liece-set-channel-indicator)
 311     (cond
 312      (liece-compress-changes
 313       (let* ((text (concat (regexp-quote rest) "\n"))
 314              (match (format (_ "^%s%sNew mode for %s set by %s: ")
 315                             (if liece-display-time
 316                                 liece-time-prefix-regexp "")
 317                             (regexp-quote liece-change-prefix)
 318                             (regexp-quote chnl) (regexp-quote prefix)))
 319              (default (format (_ "%sNew mode for %s set by %s: %s\n")
 320                               liece-change-prefix chnl prefix str)))
 321         (liece-replace (liece-pick-buffer chnl)
 322                         match default text (concat ", " str "\n"))
 323         (liece-replace (if (and liece-current-channel
 324                                  (liece-channel-equal
 325                                   chnl liece-current-channel))
 326                             liece-D-buffer
 327                           (append liece-D-buffer liece-O-buffer))
 328                         match default text (concat ", " str "\n"))))
 329      (t
 330       (liece-insert-change (liece-pick-buffer chnl)
 331                             (format (_ "New mode for %s set by %s: %s\n")
 332                                     chnl prefix str))
 333       (liece-insert-change (if (and liece-current-channel
 334                                      (liece-channel-equal
 335                                       chnl liece-current-channel))
 336                                 liece-D-buffer
 337                               (append liece-D-buffer liece-O-buffer))
 338                             (format (_ "New mode for %s set by %s: %s\n")
 339                                     chnl prefix str))))))
 340
 341 (defun* liece-handle-kick-message (prefix rest)
 342   (if (/= 3 (length (setq rest (liece-split-line rest))))
 343       (return-from liece-handle-kick-message))
 344   (multiple-value-bind (chnl nick message) rest
 345     (setq chnl (liece-channel-virtual chnl))
 346
 347     (if (liece-nick-equal nick liece-real-nickname)
 348         (progn
 349           (liece-insert-change
 350            (liece-pick-buffer chnl)
 351            (format (_ "You were kicked off channel %s by %s (%s).\n")
 352                    chnl prefix message))
 353           (liece-channel-part chnl))
 354       (liece-nick-part nick chnl))
 355
 356     (if (liece-handle-check-changes-ignored)
 357         (return-from liece-handle-kick-message))
 358
 359     (liece-insert-change
 360      (append (liece-pick-buffer chnl)
 361              (if (liece-channel-equal chnl liece-current-channel)
 362                  liece-D-buffer
 363                (append liece-D-buffer liece-O-buffer)))
 364      (format "%s has kicked %s out%s%s\n"
 365              prefix nick
 366              (if (string= (or liece-current-channel "") chnl)
 367                  ""
 368                (format " from channel %s" chnl))
 369              (if (not message)
 370                  ""
 371                (format " (%s)" message))))))
 372
 373 (defun* liece-handle-invite-message (prefix rest)
 374   (or (string-match " +:" rest)
 375       (return-from liece-handle-invite-message))
 376   (and liece-beep-when-invited liece-beep-on-bells
 377        (beep t))
 378   (let ((chnl (liece-channel-virtual (substring rest (match-end 0)))))
 379     (liece-insert-info (append liece-D-buffer liece-O-buffer)
 380                         (format "%s invites you to channel %s\n"
 381                                 prefix chnl))
 382     (setq liece-default-channel-candidate chnl)))
 383
 384 (defun* liece-handle-kill-message (prefix rest)
 385   (or (string-match " +:" rest)
 386       (return-from liece-handle-kill-message))
 387   (let ((path (substring rest (match-end 0))))
 388     (liece-insert-info (append liece-D-buffer liece-O-buffer)
 389                         (format "You were killed by %s. (Path: %s. RIP)\n"
 390                                 prefix path)))
 391   (liece-clear-system))
 392
 393 (defun* liece-handle-join-message (prefix rest)
 394   (let (flag (xnick prefix) (nick prefix) (chnl rest))
 395     (cond
 396      ((string-match "\007[ov]" chnl)
 397       (setq flag (aref (match-string 0 chnl) 1)
 398             chnl (substring rest 0 (match-beginning 0))))
 399      ((string-match " +$" chnl)
 400       (setq chnl (substring chnl 0 (match-beginning 0)))))
 401     (setq chnl (liece-channel-virtual chnl))
 402
 403     (liece-nick-set-user-at-host nick liece-user-at-host)
 404
 405     (if (liece-nick-equal nick liece-real-nickname)
 406         (progn
 407           (and liece-gather-channel-modes
 408                (not (liece-channel-modeless-p (liece-channel-real chnl)))
 409                (liece-send "MODE %s " (liece-channel-real chnl)))
 410           (liece-channel-join chnl))
 411       (liece-nick-join nick chnl))
 412
 413     (cond
 414      ((eq flag ?o)
 415       (liece-channel-set-operator chnl xnick t)
 416       (setq xnick (concat "@" xnick)))
 417      ((eq flag ?v)
 418       (liece-channel-set-voice chnl xnick t)
 419       (setq xnick (concat "+" xnick))))
 420
 421     (if (liece-handle-check-changes-ignored)
 422         (return-from liece-handle-join-message))
 423
 424     (when (and (liece-nick-member nick liece-current-chat-partners)
 425                (get (intern nick liece-obarray) 'part))
 426       (liece-insert-change (liece-pick-buffer nick)
 427                             (format (_ "%s has come back as (%s)\n")
 428                                     nick liece-user-at-host))
 429       (liece-nick-unmark-as-apart nick))
 430
 431     (cond
 432      (liece-compress-changes
 433       (let* ((text (format (_ " \\(has\\|have\\) joined channel %s")
 434                            (regexp-quote chnl)))
 435              (match (format "^%s%s.*%s$"
 436                             (if liece-display-time
 437                                 liece-time-prefix-regexp "")
 438                             (regexp-quote liece-change-prefix)
 439                             (regexp-quote text)))
 440              (default (format (_ "%s%s (%s) has joined channel %s\n")
 441                               liece-change-prefix
 442                               nick liece-user-at-host chnl)))
 443         (liece-replace (liece-pick-buffer chnl)
 444                         match default text
 445                         (format (_ ", %s (%s) have joined channel %s")
 446                                 nick liece-user-at-host chnl))
 447         (liece-replace (if (and liece-current-channel
 448                                  (liece-channel-equal chnl
 449                                                        liece-current-channel))
 450                             liece-D-buffer
 451                           (append liece-D-buffer liece-O-buffer))
 452                         match default text
 453                         (format (_ ", %s (%s) have joined channel %s")
 454                                 nick liece-user-at-host chnl))))
 455      (t
 456       (liece-insert-change (liece-pick-buffer chnl)
 457                             (format (_ "%s (%s) has joined channel %s\n")
 458                                     nick liece-user-at-host chnl))
 459       (liece-insert-change (if (liece-channel-equal chnl
 460                                                       liece-current-channel)
 461                                 liece-D-buffer
 462                               (append liece-D-buffer liece-O-buffer))
 463                             (format (_ "%s (%s) has joined channel %s\n")
 464                                     nick liece-user-at-host chnl))))))
 465
 466 (defun* liece-handle-part-message (prefix rest)
 467   (multiple-value-bind (chnl comment text match default buf) (liece-split-line rest)
 468     (setq chnl (liece-channel-virtual chnl)
 469           comment (liece-handle-prepare-comment comment))
 470
 471     (if (liece-nick-equal prefix liece-real-nickname)
 472         (liece-channel-part chnl)
 473       (liece-nick-part prefix chnl))
 474
 475     (if (liece-handle-check-changes-ignored)
 476         (return-from liece-handle-part-message))
 477
 478     (setq buf (append liece-D-buffer (liece-pick-buffer chnl)))
 479     (unless (and liece-current-channel
 480                  (liece-channel-equal chnl liece-current-channel))
 481       (setq buf (append buf liece-O-buffer)))
 482     (cond
 483      (liece-compress-changes
 484       (setq text (format (_ " \\(has\\|have\\) left channel %s%s")
 485                          (regexp-quote chnl) (regexp-quote comment))
 486             match (format "^%s%s.*%s$"
 487                           (if liece-display-time
 488                               liece-time-prefix-regexp "")
 489                           (regexp-quote liece-change-prefix)
 490                           (regexp-quote text))
 491             default (format (_ "%s%s has left channel %s%s\n")
 492                             liece-change-prefix prefix chnl comment))
 493       (liece-replace buf
 494                       match default text
 495                       (format (_ ", %s have left channel %s%s")
 496                               prefix chnl comment)))
 497      (t
 498       (liece-insert-change buf
 499                             (format (_ "%s has left channel %s%s\n")
 500                                     prefix chnl comment))))))
 501
 502 (defun* liece-handle-silence-message (prefix rest)
 503   (let* ((flag (aref rest 0)) (rest (substring rest 1)))
 504     (liece-insert-info (append liece-D-buffer liece-O-buffer)
 505                         (concat "User " rest
 506                                 (if (eq flag ?-) "unsilenced" "silenced")))))
 507
 508 (provide 'liece-handle)
 509
 510 ;;; liece-handle.el ends here