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