6ff8d2f6380de9e2113b65090b32b274f8bb51a8
[riece] / 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