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