371c407e5b6ba326f418d4b9294b5c3930bfdf43
[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 (require 'riece-misc)
28 (require 'riece-message)
29 (require 'riece-channel)
30 (require 'riece-naming)
31 (require 'riece-display)
32
33 (defun riece-handle-nick-message (prefix string)
34   (let* ((old (riece-prefix-nickname prefix))
35          (new (car (riece-split-parameters string)))
36          (channels (riece-user-get-channels old))
37          (visible (riece-identity-member riece-current-channel channels)))
38     (riece-naming-assert-rename old new)
39     (let ((pointer (riece-identity-member
40                     (riece-make-identity old)
41                     riece-current-channels)))
42       (when pointer
43         (setcar pointer (riece-make-identity new))
44         (setcar (riece-identity-assoc (riece-make-identity old)
45                                       riece-channel-buffer-alist)
46                 (riece-make-identity new))
47         (setcar (riece-identity-assoc (riece-make-identity old)
48                                       riece-user-list-buffer-alist)
49                 (riece-make-identity new))
50         (if (riece-identity-equal (riece-make-identity old)
51                                   riece-current-channel)
52             (riece-switch-to-channel (riece-make-identity new)))
53         (setq channels (cons (riece-make-identity new) channels))))
54     (riece-insert-change (mapcar
55                           (lambda (channel)
56                             (cdr (riece-identity-assoc
57                                   (riece-make-identity channel)
58                                   riece-channel-buffer-alist)))
59                           channels)
60                          (format "%s -> %s\n" old new))
61     (riece-insert-change (if visible
62                              riece-dialogue-buffer
63                            (list riece-dialogue-buffer riece-others-buffer))
64                          (concat
65                           (riece-concat-server-name
66                            (format "%s -> %s" old new))
67                           "\n"))
68     (riece-redisplay-buffers)))
69
70 (defun riece-handle-privmsg-message (prefix string)
71   (let* ((user (riece-prefix-nickname prefix))
72          (parameters (riece-split-parameters string))
73          (targets (split-string (car parameters) ","))
74          (message (nth 1 parameters)))
75     (unless (equal message "")          ;not ignored by server?
76       (riece-display-message
77        (riece-make-message user (riece-make-identity (car targets))
78                            message)))))
79
80 (defun riece-handle-notice-message (prefix string)
81   (let* ((user (if prefix
82                    (riece-prefix-nickname prefix)))
83          (parameters (riece-split-parameters string))
84          (targets (split-string (car parameters) ","))
85          (message (nth 1 parameters)))
86     (unless (equal message "")          ;not ignored by server?
87       (if user
88           (riece-display-message
89            (riece-make-message user (riece-make-identity (car targets))
90                                message 'notice))
91         ;; message from server
92         (riece-insert-notice
93          (list riece-dialogue-buffer riece-others-buffer)
94          (concat (riece-concat-server-name message) "\n"))))))
95
96 (defun riece-handle-ping-message (prefix string)
97   (riece-send-string (format "PONG :%s\r\n"
98                              (if (eq (aref string 0) ?:)
99                                  (substring string 1)
100                                string))))
101
102 (defun riece-handle-join-message (prefix string)
103   (let ((user (riece-prefix-nickname prefix))
104         (channels (split-string (car (riece-split-parameters string)) ",")))
105     (while channels
106       (riece-naming-assert-join user (car channels))
107       ;;XXX
108       (if (riece-identity-equal-no-server user riece-real-nickname)
109           (riece-switch-to-channel (riece-make-identity (car channels))))
110       (let ((buffer (cdr (riece-identity-assoc
111                           (riece-make-identity (car channels))
112                           riece-channel-buffer-alist))))
113         (riece-insert-change
114          buffer
115          (format "%s (%s) has joined %s\n"
116                  user
117                  (riece-user-get-user-at-host user)
118                  (car channels)))
119         (riece-insert-change
120          (if (and riece-channel-buffer-mode
121                   (not (eq buffer riece-channel-buffer)))
122              (list riece-dialogue-buffer riece-others-buffer)
123            riece-dialogue-buffer)
124          (concat
125           (riece-concat-server-name
126            (format "%s (%s) has joined %s"
127                    user
128                    (riece-user-get-user-at-host user)
129                    (car channels)))
130           "\n")))
131       (setq channels (cdr channels)))
132     (riece-redisplay-buffers)))
133
134 (defun riece-handle-part-message (prefix string)
135   (let* ((user (riece-prefix-nickname prefix))
136          (parameters (riece-split-parameters string))
137          (channels (split-string (car parameters) ","))
138          (message (nth 1 parameters)))
139     (while channels
140       (riece-naming-assert-part user (car channels))
141       (let ((buffer (cdr (riece-identity-assoc
142                           (riece-make-identity (car channels))
143                           riece-channel-buffer-alist))))
144         (riece-insert-change
145          buffer
146          (concat
147           (riece-concat-message
148            (format "%s has left %s" user (car channels))
149            message)
150           "\n"))
151         (riece-insert-change
152          (if (and riece-channel-buffer-mode
153                   (not (eq buffer riece-channel-buffer)))
154              (list riece-dialogue-buffer riece-others-buffer)
155            riece-dialogue-buffer)
156          (concat
157           (riece-concat-server-name
158            (riece-concat-message
159             (format "%s has left %s" user (car channels))
160             message))
161           "\n")))
162       (setq channels (cdr channels)))
163     (riece-redisplay-buffers)))
164
165 (defun riece-handle-kick-message (prefix string)
166   (let* ((kicker (riece-prefix-nickname prefix))
167          (parameters (riece-split-parameters string))
168          (channel (car parameters))
169          (user (nth 1 parameters))
170          (message (nth 2 parameters)))
171     (riece-naming-assert-part user channel)
172     (let ((buffer (cdr (riece-identity-assoc
173                         (riece-make-identity channel)
174                         riece-channel-buffer-alist))))
175       (riece-insert-change
176        buffer
177        (concat
178         (riece-concat-message
179          (format "%s kicked %s out from %s" kicker user channel)
180          message)
181         "\n"))
182       (riece-insert-change
183        (if (and riece-channel-buffer-mode
184                 (not (eq buffer riece-channel-buffer)))
185            (list riece-dialogue-buffer riece-others-buffer)
186          riece-dialogue-buffer)
187        (concat
188         (riece-concat-server-name
189          (riece-concat-message
190           (format "%s kicked %s out from %s\n" kicker user channel)
191           message))
192         "\n")))
193     (riece-redisplay-buffers)))
194
195 (defun riece-handle-quit-message (prefix string)
196   (let* ((user (riece-prefix-nickname prefix))
197          (channels (copy-sequence (riece-user-get-channels user)))
198          (pointer channels)
199          (message (car (riece-split-parameters string))))
200     ;; If you are quitting, no need to cleanup.
201     (unless (riece-identity-equal-no-server user riece-real-nickname)
202       ;; You were talking with the user.
203       (if (riece-identity-member (riece-make-identity user)
204                                  riece-current-channels)
205           (riece-part-channel user)) ;XXX
206       (setq pointer channels)
207       (while pointer
208         (riece-naming-assert-part user (car pointer))
209         (setq pointer (cdr pointer)))
210       (let ((buffers
211              (mapcar
212               (lambda (channel)
213                 (cdr (riece-identity-assoc
214                       (riece-make-identity channel)
215                       riece-channel-buffer-alist)))
216               channels)))
217         (riece-insert-change buffers
218                              (concat (riece-concat-message
219                                       (format "%s has left IRC" user)
220                                       message)
221                                      "\n"))
222         (riece-insert-change (if (and riece-channel-buffer-mode
223                                       (not (memq riece-channel-buffer
224                                                  buffers)))
225                                  (list riece-dialogue-buffer
226                                        riece-others-buffer)
227                                riece-dialogue-buffer)
228                              (concat
229                               (riece-concat-server-name
230                                (riece-concat-message
231                                 (format "%s has left IRC" user)
232                                 message))
233                               "\n"))))
234     (riece-redisplay-buffers)))
235
236 (defun riece-handle-kill-message (prefix string)
237   (let* ((killer (riece-prefix-nickname prefix))
238          (parameters (riece-split-parameters string))
239          (user (car parameters))
240          (message (nth 1 parameters))
241          (channels (copy-sequence (riece-user-get-channels user)))
242          pointer)
243     ;; You were talking with the user.
244     (if (riece-identity-member (riece-make-identity user)
245                                riece-current-channels)
246         (riece-part-channel user)) ;XXX
247     (setq pointer channels)
248     (while pointer
249       (riece-naming-assert-part user (car pointer))
250       (setq pointer (cdr pointer)))
251     (let ((buffers
252            (mapcar
253             (lambda (channel)
254               (cdr (riece-identity-assoc
255                     (riece-make-identity channel)
256                     riece-channel-buffer-alist)))
257             channels)))
258       (riece-insert-change buffers
259                            (concat (riece-concat-message
260                                     (format "%s killed %s" killer user)
261                                     message)
262                                    "\n"))
263       (riece-insert-change (if (and riece-channel-buffer-mode
264                                     (not (memq riece-channel-buffer
265                                                buffers)))
266                                (list riece-dialogue-buffer
267                                      riece-others-buffer)
268                              riece-dialogue-buffer)
269                            (concat
270                             (riece-concat-server-name
271                              (riece-concat-message
272                               (format "%s killed %s" killer user)
273                              message))
274                             "\n")))
275     (riece-redisplay-buffers)))
276
277 (defun riece-handle-invite-message (prefix string)
278   (let* ((user (riece-prefix-nickname prefix))
279          (parameters (riece-split-parameters string))
280          (channel (car parameters)))
281     (riece-insert-info
282      (list riece-dialogue-buffer riece-others-buffer)
283      (concat
284       (riece-concat-server-name
285        (format "%s invites you to %s" user channel))
286       "\n"))))
287
288 (defun riece-handle-topic-message (prefix string)
289   (let* ((user (riece-prefix-nickname prefix))
290          (parameters (riece-split-parameters string))
291          (channel (car parameters))
292          (topic (nth 1 parameters)))
293     (riece-channel-set-topic (riece-get-channel channel) topic)
294     (let ((buffer (cdr (riece-identity-assoc
295                         (riece-make-identity channel)
296                         riece-channel-buffer-alist))))
297       (riece-insert-change
298        buffer
299        (format "Topic by %s: %s\n" user topic))
300       (riece-insert-change
301        (if (and riece-channel-buffer-mode
302                 (not (eq buffer riece-channel-buffer)))
303            (list riece-dialogue-buffer riece-others-buffer)
304          riece-dialogue-buffer)
305        (concat
306         (riece-concat-server-name
307          (format "Topic on %s by %s: %s" channel user topic))
308         "\n"))
309       (riece-redisplay-buffers))))
310
311 (defsubst riece-parse-channel-modes (string channel)
312   (while (string-match "^[-+]\\([^ ]*\\) *" string)
313     (let ((toggle (aref string 0))
314           (modes (string-to-list (match-string 1 string))))
315       (setq string (substring string (match-end 0)))
316       (while modes
317         (if (and (memq (car modes) '(?O ?o ?v ?k ?l ?b ?e ?I))
318                  (string-match "\\([^-+][^ ]*\\) *" string))
319             (let ((parameter (match-string 1 string)))
320               (setq string (substring string (match-end 0)))
321               (cond
322                ((eq (car modes) ?o)
323                 (riece-channel-toggle-operator channel parameter
324                                                (eq toggle ?+)))
325                ((eq (car modes) ?v)
326                 (riece-channel-toggle-speaker channel parameter
327                                               (eq toggle ?+)))
328                ((eq (car modes) ?b)
329                 (riece-channel-toggle-banned channel parameter
330                                              (eq toggle ?+)))
331                ((eq (car modes) ?e)
332                 (riece-channel-toggle-uninvited channel parameter
333                                                 (eq toggle ?+)))
334                ((eq (car modes) ?I)
335                 (riece-channel-toggle-invited channel parameter
336                                               (eq toggle ?+)))))
337           (riece-channel-toggle-mode channel (car modes)
338                                      (eq toggle ?+)))
339         (setq modes (cdr modes))))))
340
341 (defun riece-handle-mode-message (prefix string)
342   (let ((user (riece-prefix-nickname prefix))
343         channel)
344     (when (string-match "\\([^ ]+\\) *:?" string)
345       (setq channel (match-string 1 string)
346             string (substring string (match-end 0)))
347       (riece-parse-channel-modes string channel)
348       (let ((buffer (cdr (riece-identity-assoc
349                           (riece-make-identity channel)
350                           riece-channel-buffer-alist))))
351         (riece-insert-change
352          buffer
353          (format "Mode by %s: %s\n" user string))
354         (riece-insert-change
355          (if (and riece-channel-buffer-mode
356                   (not (eq buffer riece-channel-buffer)))
357              (list riece-dialogue-buffer riece-others-buffer)
358            riece-dialogue-buffer)
359          (concat
360           (riece-concat-server-name
361            (format "Mode on %s by %s: %s" channel user string))
362           "\n"))
363         (riece-redisplay-buffers)))))
364
365 (provide 'riece-handle)
366
367 ;;; riece-handle.el ends here