cgit.sxemacs.org Git - riece/blob - lisp/riece-filter.el

   1 ;;; riece-filter.el --- process filter and sentinel
   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-handle)
  28 (require 'riece-misc)
  29 (require 'riece-server)                 ;riece-close-server
  30
  31 (defun riece-handle-numeric-reply (prefix number name string)
  32   (let ((base-number (* (/ number 100) 100))
  33         function)
  34     (condition-case nil
  35         (require (intern (format "riece-%03d" base-number)))
  36       (error))
  37     (setq function (intern-soft (format "riece-handle-%03d-message" number)))
  38     (unless (and function
  39                  (symbol-function function))
  40       (setq function
  41             (intern-soft
  42              (format "riece-handle-default-%03d-message" base-number))))
  43     (if (and function
  44              (symbol-function function))
  45         (condition-case error
  46             (funcall function prefix number name
  47                      (riece-decode-coding-string string))
  48           (error
  49            (if riece-debug
  50                (message "Error occurred in `%S': %S" function error)))))))
  51
  52 (defun riece-default-handle-numeric-reply
  53   (client-prefix prefix number name string)
  54   (riece-insert
  55    (list riece-dialogue-buffer riece-others-buffer)
  56    (concat client-prefix
  57            (riece-concat-server-name
  58             (mapconcat #'identity (riece-split-parameters string) " "))
  59            "\n")))
  60
  61 (defun riece-handle-message (prefix message string)
  62   (if (and prefix
  63            (string-match "![^\x00\x0d\x0a @]+@" prefix))
  64       (riece-user-set-user-at-host
  65        (riece-get-user (substring prefix 0 (match-beginning 0)))
  66        (riece-parse-user-at-host (substring prefix (1+ (match-beginning 0))))))
  67   (setq message (downcase message)
  68         string (riece-decode-coding-string string))
  69   (let ((function (intern-soft (concat "riece-handle-" message "-message")))
  70         (hook (intern (concat "riece-" message "-hook")))
  71         (after-hook (intern (concat "riece-after-" message "-hook"))))
  72     (unless (condition-case error
  73                 (run-hook-with-args-until-success hook prefix string)
  74               (error
  75                (if riece-debug
  76                    (message "Error occurred in `%S': %S" hook error))
  77                nil))
  78       (if function
  79           (condition-case error
  80               (funcall function prefix string)
  81             (error
  82              (if riece-debug
  83                  (message "Error occurred in `%S': %S" function error)))))
  84       (condition-case error
  85           (run-hook-with-args-until-success after-hook prefix string)
  86         (error
  87          (if riece-debug
  88              (message "Error occurred in `%S': %S" after-hook error)))))))
  89
  90 (defun riece-filter (process input)
  91   (save-excursion
  92     (set-buffer (process-buffer process))
  93     (goto-char riece-read-point)
  94     (unless riece-debug
  95       (delete-region (riece-line-beginning-position) (point-min))
  96       (setq riece-read-point (point)))
  97     (insert input)
  98     (goto-char (prog1 riece-read-point
  99                  (setq riece-read-point (point))))
 100     (beginning-of-line)
 101     (catch 'contiguous
 102       (while (not (eobp))
 103         (save-excursion
 104           (if (looking-at
 105                ":\\([^ ]+\\) +\\([0-5][0-9][0-9]\\) +\\([^ ]+\\) +\\(.*\\)\r\n")
 106               (riece-handle-numeric-reply
 107                (match-string 1)         ;prefix
 108                (string-to-number (match-string 2)) ;number
 109                (match-string 3)         ;name
 110                (match-string 4))                ;reply string
 111             (if (looking-at "\\(:\\([^ ]+\\) +\\)?\\([^ ]+\\) +\\(.*\\)\r\n")
 112                 (riece-handle-message
 113                  (match-string 2)       ;optional prefix
 114                  (match-string 3)       ;command
 115                  (match-string 4))      ;params & trailing
 116               (if (looking-at ".*\r\n")
 117                   (if riece-debug
 118                       (message "Weird message from server: %s"
 119                                (buffer-substring (point) (progn
 120                                                            (end-of-line)
 121                                                            (point)))))
 122                 (throw 'contiguous nil)))))
 123         (forward-line)))))
 124
 125 (eval-when-compile
 126   (autoload 'riece "riece"))
 127 (defun riece-sentinel (process status)
 128   (if riece-reconnect-with-password
 129       (unwind-protect
 130           (if (eq process riece-server-process)
 131               (riece)                   ;Need to initialize system.
 132             (let ((server-name
 133                    (car (rassq process riece-server-process-alist))))
 134               (riece-close-server server-name)
 135               (riece-open-server
 136                (riece-server-name-to-server server-name)
 137                server-name)))
 138         (setq riece-reconnect-with-password nil))
 139     (let ((server-name (with-current-buffer (process-buffer process)
 140                          riece-server-name)))
 141       (if (and (process-id process)             ;not a network connection
 142                (string-match "^exited abnormally with code \\([0-9]+\\)"
 143                              status))
 144           (if server-name
 145               (message "Connection to \"%s\" closed: %s"
 146                        server-name (match-string 1 status))
 147             (message "Connection closed: %s" (match-string 1 status)))
 148         (if server-name
 149             (message "Connection to \"%s\" closed: %s"
 150                      server-name (substring status 0 (1- (length status))))
 151           (message "Connection closed: %s"
 152                    (substring status 0 (1- (length status))))))
 153       (riece-close-server server-name))))
 154
 155 (provide 'riece-filter)
 156
 157 ;;; riece-filter.el ends here