e3cc584634e84340d87cd2c53b4b6c574341b0ab
[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., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
24
25 ;;; Code:
26
27 (require 'riece-misc)
28 (require 'riece-message)
29 (require 'riece-channel)
30 (require 'riece-naming)
31 (require 'riece-signal)
32 (require 'riece-mode)
33 (require 'riece-000)
34 (require 'riece-200)
35 (require 'riece-300)
36 (require 'riece-400)
37 (require 'riece-500)
38
39 (defun riece-default-handle-numeric-reply
40   (client-prefix prefix number name string)
41   (riece-insert
42    (list riece-dialogue-buffer riece-others-buffer)
43    (concat client-prefix
44            (riece-concat-server-name
45             (mapconcat #'identity (riece-split-parameters string) " "))
46            "\n")))
47
48 (defun riece-handle-nick-message (prefix string)
49   (let* ((old (riece-prefix-nickname prefix))
50          (new (car (riece-split-parameters string)))
51          (old-identity (riece-make-identity old riece-server-name))
52          (new-identity (riece-make-identity new riece-server-name))
53          (channels (riece-user-get-channels old))
54          (visible (riece-identity-member
55                    riece-current-channel
56                    (mapcar (lambda (channel)
57                              (riece-make-identity channel riece-server-name))
58                            channels))))
59     (riece-naming-assert-rename old new)
60     (if (riece-identity-member old-identity riece-current-channels)
61         (setq channels (cons new channels)))
62     (riece-insert-change (delq nil (mapcar
63                                     (lambda (channel)
64                                       (riece-channel-buffer
65                                        (riece-make-identity
66                                         channel riece-server-name)))
67                                     channels))
68                          (format "%s -> %s\n"
69                                  (riece-format-identity old-identity t)
70                                  (riece-format-identity new-identity t)))
71     (riece-insert-change (if visible
72                              riece-dialogue-buffer
73                            (list riece-dialogue-buffer riece-others-buffer))
74                          (concat
75                           (riece-concat-server-name
76                            (format "%s -> %s"
77                                  (riece-format-identity old-identity t)
78                                  (riece-format-identity new-identity t)))
79                           "\n"))))
80
81 (defun riece-handle-privmsg-message (prefix decoded)
82   (let* ((user (riece-prefix-nickname prefix))
83          (parameters (riece-split-parameters (riece-decoded-string decoded)))
84          (targets (split-string (car parameters) ","))
85          message)
86     (setq parameters (riece-split-parameters
87                       (riece-decoded-string-for-identity
88                        decoded
89                        (riece-make-identity (car targets) riece-server-name)))
90           message (nth 1 parameters))
91     (riece-display-message
92      (riece-make-message (riece-make-identity user
93                                               riece-server-name)
94                          (riece-make-identity (car targets)
95                                               riece-server-name)
96                          message
97                          nil
98                          (riece-identity-equal-no-server
99                           user riece-real-nickname)))))
100
101 (defun riece-handle-notice-message (prefix decoded)
102   (let* ((user (if prefix
103                    (riece-prefix-nickname prefix)))
104          (parameters (riece-split-parameters (riece-decoded-string decoded)))
105          (targets (split-string (car parameters) ","))
106          message)
107     (setq parameters (riece-split-parameters
108                       (riece-decoded-string-for-identity
109                        decoded
110                        (riece-make-identity (car targets) riece-server-name)))
111           message (nth 1 parameters))
112     (if user
113         (riece-display-message
114          (riece-make-message (riece-make-identity user
115                                                   riece-server-name)
116                              (riece-make-identity (car targets)
117                                                   riece-server-name)
118                              message 'notice
119                              (riece-identity-equal-no-server
120                               user riece-real-nickname)))
121       ;; message from server
122       (riece-insert-notice
123        (list riece-dialogue-buffer riece-others-buffer)
124        (concat (riece-concat-server-name message) "\n")))))
125
126 (defun riece-handle-ping-message (prefix string)
127   (riece-send-string (format "PONG :%s\r\n"
128                              (if (eq (aref string 0) ?:)
129                                  (substring string 1)
130                                string))))
131
132 (defun riece-handle-join-message (prefix string)
133   (let* ((user (riece-prefix-nickname prefix))
134          ;; RFC2812 3.2.1 doesn't recommend server to send join
135          ;; messages which contain multiple targets.
136          (channels (split-string (car (riece-split-parameters string)) ","))
137          (user-identity (riece-make-identity user riece-server-name)))
138     (while channels
139       (riece-naming-assert-join user (car channels))
140       (if (and riece-gather-channel-modes
141                (riece-identity-equal-no-server user riece-real-nickname))
142           (riece-send-string (format "MODE %s\r\n" (car channels))))
143       (let* ((channel-identity (riece-make-identity (car channels)
144                                                     riece-server-name))
145              (buffer (riece-channel-buffer channel-identity)))
146         (riece-insert-change
147          buffer
148          (format "%s (%s) has joined %s\n"
149                  (riece-format-identity user-identity t)
150                  (riece-user-get-user-at-host user)
151                  (riece-format-identity channel-identity t)))
152         (riece-insert-change
153          (if (and riece-channel-buffer-mode
154                   (not (eq buffer riece-channel-buffer)))
155              (list riece-dialogue-buffer riece-others-buffer)
156            riece-dialogue-buffer)
157          (concat
158           (riece-concat-server-name
159            (format "%s (%s) has joined %s"
160                    (riece-format-identity user-identity t)
161                    (riece-user-get-user-at-host user)
162                    (riece-format-identity channel-identity t)))
163           "\n")))
164       (setq channels (cdr channels)))))
165
166 (defun riece-handle-part-message (prefix decoded)
167   (let* ((user (riece-prefix-nickname prefix))
168          (parameters (riece-split-parameters (riece-decoded-string decoded)))
169          ;; RFC2812 3.2.2 doesn't recommend server to send part
170          ;; messages which contain multiple targets.
171          (channels (split-string (car parameters) ","))
172          (user-identity (riece-make-identity user riece-server-name)))
173     (while channels
174       (let* ((channel-identity (riece-make-identity (car channels)
175                                                     riece-server-name))
176              (buffer (riece-channel-buffer channel-identity))
177              message)
178         (setq parameters (riece-split-parameters
179                           (riece-decoded-string-for-identity decoded
180                                                              channel-identity))
181               message (nth 1 parameters))
182         (riece-insert-change
183          buffer
184          (concat
185           (riece-concat-message
186            (format "%s has left %s"
187                    (riece-format-identity user-identity t)
188                    (riece-format-identity channel-identity t))
189            message)
190           "\n"))
191         (riece-insert-change
192          (if (and riece-channel-buffer-mode
193                   (not (eq buffer riece-channel-buffer)))
194              (list riece-dialogue-buffer riece-others-buffer)
195            riece-dialogue-buffer)
196          (concat
197           (riece-concat-server-name
198            (riece-concat-message
199             (format "%s has left %s"
200                     (riece-format-identity user-identity t)
201                     (riece-format-identity channel-identity t))
202             message))
203           "\n")))
204       (riece-naming-assert-part user (car channels))
205       (setq channels (cdr channels)))))
206
207 (defun riece-handle-kick-message (prefix decoded)
208   (let* ((kicker (riece-prefix-nickname prefix))
209          (parameters (riece-split-parameters (riece-decoded-string decoded)))
210          (channel (car parameters))
211          (user (nth 1 parameters))
212          message
213          (kicker-identity (riece-make-identity kicker riece-server-name))
214          (channel-identity (riece-make-identity channel riece-server-name))
215          (user-identity (riece-make-identity user riece-server-name)))
216     (setq parameters (riece-split-parameters
217                       (riece-decoded-string-for-identity decoded
218                                                          channel-identity))
219           message (nth 2 parameters))
220     (riece-naming-assert-part user channel)
221     (let ((buffer (riece-channel-buffer channel-identity)))
222       (riece-insert-change
223        buffer
224        (concat
225         (riece-concat-message
226          (format "%s kicked %s out from %s"
227                  (riece-format-identity kicker-identity t)
228                  (riece-format-identity user-identity t)
229                  (riece-format-identity channel-identity t))
230          message)
231         "\n"))
232       (riece-insert-change
233        (if (and riece-channel-buffer-mode
234                 (not (eq buffer riece-channel-buffer)))
235            (list riece-dialogue-buffer riece-others-buffer)
236          riece-dialogue-buffer)
237        (concat
238         (riece-concat-server-name
239          (riece-concat-message
240           (format "%s kicked %s out from %s\n"
241                  (riece-format-identity kicker-identity t)
242                  (riece-format-identity user-identity t)
243                  (riece-format-identity channel-identity t))
244           message))
245         "\n")))))
246
247 (defun riece-handle-quit-message (prefix string)
248   (let* ((user (riece-prefix-nickname prefix))
249          (channels (copy-sequence (riece-user-get-channels user)))
250          (pointer channels)
251          (parameters (riece-split-parameters string))
252          (message (car parameters))
253          (user-identity (riece-make-identity user riece-server-name)))
254     ;; If you are talking with the user, quit it.
255     (if (riece-identity-member user-identity riece-current-channels)
256         (riece-part-channel user-identity))
257     (setq pointer channels)
258     (while pointer
259       (riece-naming-assert-part user (car pointer))
260       (setq pointer (cdr pointer)))
261     (let ((buffers
262            (delq nil (mapcar
263                       (lambda (channel)
264                         (riece-channel-buffer (riece-make-identity
265                                                channel riece-server-name)))
266                       channels))))
267       (riece-insert-change
268        buffers
269        (concat
270         (riece-concat-message
271          (format "%s has left IRC"
272                  (riece-format-identity user-identity t))
273          message)
274         "\n"))
275       (riece-insert-change
276        (if (and riece-channel-buffer-mode
277                 (not (memq riece-channel-buffer buffers)))
278            (list riece-dialogue-buffer riece-others-buffer)
279          riece-dialogue-buffer)
280        (concat
281         (riece-concat-server-name
282          (riece-concat-message
283           (format "%s has left IRC"
284                   (riece-format-identity user-identity t))
285           message))
286         "\n")))))
287
288 (defun riece-handle-kill-message (prefix string)
289   (let* ((killer (riece-prefix-nickname prefix))
290          (parameters (riece-split-parameters string))
291          (user (car parameters))
292          (message (nth 1 parameters))
293          (channels (copy-sequence (riece-user-get-channels user)))
294          (killer-identity (riece-make-identity killer riece-server-name))
295          (user-identity (riece-make-identity user riece-server-name))
296          pointer)
297     ;; If you are talking with the user, quit it.
298     (if (riece-identity-member user-identity riece-current-channels)
299         (riece-part-channel user))
300     (setq pointer channels)
301     (while pointer
302       (riece-naming-assert-part user (car pointer))
303       (setq pointer (cdr pointer)))
304     (let ((buffers
305            (delq nil (mapcar
306                       (lambda (channel)
307                         (riece-channel-buffer (riece-make-identity
308                                                channel riece-server-name)))
309                       channels))))
310       (riece-insert-change
311        buffers
312        (concat
313         (riece-concat-message
314          (format "%s killed %s"
315                  (riece-format-identity killer-identity t)
316                  (riece-format-identity user-identity t))
317          message)
318         "\n"))
319       (riece-insert-change
320        (if (and riece-channel-buffer-mode
321                 (not (memq riece-channel-buffer buffers)))
322            (list riece-dialogue-buffer riece-others-buffer)
323          riece-dialogue-buffer)
324        (concat
325         (riece-concat-server-name
326          (riece-concat-message
327           (format "%s killed %s"
328                  (riece-format-identity killer-identity t)
329                  (riece-format-identity user-identity t))
330           message))
331         "\n")))))
332
333 (defun riece-handle-invite-message (prefix string)
334   (let* ((user (riece-prefix-nickname prefix))
335          (parameters (riece-split-parameters string))
336          (invited (car parameters))
337          (channel (nth 1 parameters))
338          (channel-identity (riece-make-identity channel riece-server-name)))
339     (if (riece-identity-equal-no-server invited riece-real-nickname)
340         (setq riece-join-channel-candidate channel-identity))
341     (riece-insert-info
342      (list riece-dialogue-buffer riece-others-buffer)
343      (concat
344       (riece-concat-server-name
345        (format "%s invites %s to %s"
346                (riece-format-identity (riece-make-identity
347                                        user riece-server-name))
348                (riece-format-identity (riece-make-identity
349                                        invited riece-server-name))
350                (riece-format-identity channel-identity)))
351       "\n"))))
352
353 (defun riece-handle-topic-message (prefix decoded)
354   (let* ((user (riece-prefix-nickname prefix))
355          (parameters (riece-split-parameters (riece-decoded-string decoded)))
356          (channel (car parameters))
357          topic
358          (user-identity (riece-make-identity user riece-server-name))
359          (channel-identity (riece-make-identity channel riece-server-name)))
360     (setq parameters (riece-split-parameters
361                       (riece-decoded-string-for-identity decoded
362                                                          channel-identity))
363           topic (nth 1 parameters))
364     (riece-channel-set-topic (riece-get-channel channel) topic)
365     (riece-emit-signal 'channel-topic-changed
366                        channel-identity topic)
367     (let ((buffer (riece-channel-buffer channel-identity)))
368       (riece-insert-change
369        buffer
370        (format "Topic by %s: %s\n"
371                (riece-format-identity user-identity t)
372                topic))
373       (riece-insert-change
374        (if (and riece-channel-buffer-mode
375                 (not (eq buffer riece-channel-buffer)))
376            (list riece-dialogue-buffer riece-others-buffer)
377          riece-dialogue-buffer)
378        (concat
379         (riece-concat-server-name
380          (format "Topic on %s by %s: %s"
381                  (riece-format-identity channel-identity t)
382                  (riece-format-identity user-identity t)
383                  topic))
384         "\n")))))
385
386 (defun riece-handle-mode-message (prefix string)
387   (let* ((user (riece-prefix-nickname prefix))
388          (user-identity (riece-make-identity user riece-server-name))
389          channel)
390     (when (string-match "^\\([^ ]+\\) *:?" string)
391       (setq channel (match-string 1 string)
392             string (substring string (match-end 0)))
393       (if (string-match (concat "^" riece-channel-regexp "$") channel)
394           (riece-naming-assert-channel-modes channel
395                                              (riece-parse-modes string)))
396       (let* ((channel-identity (riece-make-identity channel riece-server-name))
397              (buffer (riece-channel-buffer channel-identity)))
398         (riece-insert-change
399          buffer
400          (format "Mode by %s: %s\n"
401                  (riece-format-identity user-identity t)
402                  string))
403         (riece-insert-change
404          (if (and riece-channel-buffer-mode
405                   (not (eq buffer riece-channel-buffer)))
406              (list riece-dialogue-buffer riece-others-buffer)
407            riece-dialogue-buffer)
408          (concat
409           (riece-concat-server-name
410            (format "Mode on %s by %s: %s"
411                    (riece-format-identity channel-identity t)
412                    (riece-format-identity user-identity t)
413                    string))
414           "\n"))))))
415
416 (provide 'riece-handle)
417
418 ;;; riece-handle.el ends here