1 ;;; riece-handle.el --- basic message handlers
2 ;; Copyright (C) 1998-2003 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; Keywords: IRC, riece
8 ;; This file is part of Riece.
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)
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.
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.
28 (require 'riece-message)
29 (require 'riece-channel)
30 (require 'riece-naming)
31 (require 'riece-signal)
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
41 (mapcar (lambda (channel)
42 (riece-make-identity channel riece-server-name))
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
49 (riece-channel-buffer (riece-make-identity
50 channel riece-server-name)))
53 (riece-format-identity old-identity t)
54 (riece-format-identity new-identity t)))
55 (riece-insert-change (if visible
57 (list riece-dialogue-buffer riece-others-buffer))
59 (riece-concat-server-name
61 (riece-format-identity old-identity t)
62 (riece-format-identity new-identity t)))
65 (defun riece-handle-privmsg-message (prefix string)
66 (let* ((user (riece-prefix-nickname prefix))
67 (parameters (riece-split-parameters string))
68 (targets (split-string (car parameters) ","))
69 (message (nth 1 parameters)))
70 (riece-display-message
71 (riece-make-message (riece-make-identity user
73 (riece-make-identity (car targets)
76 (riece-identity-equal-no-server
77 user riece-real-nickname)))))
79 (defun riece-handle-notice-message (prefix string)
80 (let* ((user (if prefix
81 (riece-prefix-nickname prefix)))
82 (parameters (riece-split-parameters string))
83 (targets (split-string (car parameters) ","))
84 (message (nth 1 parameters)))
86 (riece-display-message
87 (riece-make-message (riece-make-identity user
89 (riece-make-identity (car targets)
92 (riece-identity-equal-no-server
93 user riece-real-nickname)))
94 ;; message from server
96 (list riece-dialogue-buffer riece-others-buffer)
97 (concat (riece-concat-server-name message) "\n")))))
99 (defun riece-handle-ping-message (prefix string)
100 (riece-send-string (format "PONG :%s\r\n"
101 (if (eq (aref string 0) ?:)
105 (defun riece-handle-join-message (prefix string)
106 (let* ((user (riece-prefix-nickname prefix))
107 ;; RFC2812 3.2.1 doesn't recommend server to send join
108 ;; messages which contain multiple targets.
109 (channels (split-string (car (riece-split-parameters string)) ","))
110 (user-identity (riece-make-identity user riece-server-name)))
112 (riece-naming-assert-join user (car channels))
113 (if (and riece-gather-channel-modes
114 (riece-identity-equal-no-server user riece-real-nickname))
115 (riece-send-string (format "MODE %s\r\n" (car channels))))
116 (let* ((channel-identity (riece-make-identity (car channels)
118 (buffer (riece-channel-buffer channel-identity)))
121 (format "%s (%s) has joined %s\n"
122 (riece-format-identity user-identity t)
123 (riece-user-get-user-at-host user)
124 (riece-format-identity channel-identity t)))
126 (if (and riece-channel-buffer-mode
127 (not (eq buffer riece-channel-buffer)))
128 (list riece-dialogue-buffer riece-others-buffer)
129 riece-dialogue-buffer)
131 (riece-concat-server-name
132 (format "%s (%s) has joined %s"
133 (riece-format-identity user-identity t)
134 (riece-user-get-user-at-host user)
135 (riece-format-identity channel-identity t)))
137 (setq channels (cdr channels)))))
139 (defun riece-handle-part-message (prefix string)
140 (let* ((user (riece-prefix-nickname prefix))
141 (parameters (riece-split-parameters string))
142 ;; RFC2812 3.2.2 doesn't recommend server to send part
143 ;; messages which contain multiple targets.
144 (channels (split-string (car parameters) ","))
145 (message (nth 1 parameters))
146 (user-identity (riece-make-identity user riece-server-name)))
148 (riece-naming-assert-part user (car channels))
149 (let* ((channel-identity (riece-make-identity (car channels)
151 (buffer (riece-channel-buffer channel-identity)))
155 (riece-concat-message
156 (format "%s has left %s"
157 (riece-format-identity user-identity t)
158 (riece-format-identity channel-identity t))
162 (if (and riece-channel-buffer-mode
163 (not (eq buffer riece-channel-buffer)))
164 (list riece-dialogue-buffer riece-others-buffer)
165 riece-dialogue-buffer)
167 (riece-concat-server-name
168 (riece-concat-message
169 (format "%s has left %s"
170 (riece-format-identity user-identity t)
171 (riece-format-identity channel-identity t))
174 (setq channels (cdr channels)))))
176 (defun riece-handle-kick-message (prefix string)
177 (let* ((kicker (riece-prefix-nickname prefix))
178 (parameters (riece-split-parameters string))
179 (channel (car parameters))
180 (user (nth 1 parameters))
181 (message (nth 2 parameters))
182 (kicker-identity (riece-make-identity kicker riece-server-name))
183 (channel-identity (riece-make-identity channel riece-server-name))
184 (user-identity (riece-make-identity user riece-server-name)))
185 (riece-naming-assert-part user channel)
186 (let ((buffer (riece-channel-buffer channel-identity)))
190 (riece-concat-message
191 (format "%s kicked %s out from %s"
192 (riece-format-identity kicker-identity t)
193 (riece-format-identity user-identity t)
194 (riece-format-identity channel-identity t))
198 (if (and riece-channel-buffer-mode
199 (not (eq buffer riece-channel-buffer)))
200 (list riece-dialogue-buffer riece-others-buffer)
201 riece-dialogue-buffer)
203 (riece-concat-server-name
204 (riece-concat-message
205 (format "%s kicked %s out from %s\n"
206 (riece-format-identity kicker-identity t)
207 (riece-format-identity user-identity t)
208 (riece-format-identity channel-identity t))
212 (defun riece-handle-quit-message (prefix string)
213 (let* ((user (riece-prefix-nickname prefix))
214 (channels (copy-sequence (riece-user-get-channels user)))
216 (parameters (riece-split-parameters string))
217 (message (car parameters))
218 (user-identity (riece-make-identity user riece-server-name)))
219 ;; If you are talking with the user, quit it.
220 (if (riece-identity-member user-identity riece-current-channels)
221 (riece-part-channel user))
222 (setq pointer channels)
224 (riece-naming-assert-part user (car pointer))
225 (setq pointer (cdr pointer)))
229 (riece-channel-buffer (riece-make-identity channel
235 (riece-concat-message
236 (format "%s has left IRC"
237 (riece-format-identity user-identity t))
241 (if (and riece-channel-buffer-mode
242 (not (memq riece-channel-buffer buffers)))
243 (list riece-dialogue-buffer riece-others-buffer)
244 riece-dialogue-buffer)
246 (riece-concat-server-name
247 (riece-concat-message
248 (format "%s has left IRC"
249 (riece-format-identity user-identity t))
253 (defun riece-handle-kill-message (prefix string)
254 (let* ((killer (riece-prefix-nickname prefix))
255 (parameters (riece-split-parameters string))
256 (user (car parameters))
257 (message (nth 1 parameters))
258 (channels (copy-sequence (riece-user-get-channels user)))
259 (killer-identity (riece-make-identity killer riece-server-name))
260 (user-identity (riece-make-identity user riece-server-name))
262 ;; If you are talking with the user, quit it.
263 (if (riece-identity-member user-identity riece-current-channels)
264 (riece-part-channel user))
265 (setq pointer channels)
267 (riece-naming-assert-part user (car pointer))
268 (setq pointer (cdr pointer)))
272 (riece-channel-buffer (riece-make-identity channel
278 (riece-concat-message
279 (format "%s killed %s"
280 (riece-format-identity killer-identity t)
281 (riece-format-identity user-identity t))
285 (if (and riece-channel-buffer-mode
286 (not (memq riece-channel-buffer buffers)))
287 (list riece-dialogue-buffer riece-others-buffer)
288 riece-dialogue-buffer)
290 (riece-concat-server-name
291 (riece-concat-message
292 (format "%s killed %s"
293 (riece-format-identity killer-identity t)
294 (riece-format-identity user-identity t))
298 (defun riece-handle-invite-message (prefix string)
299 (let* ((user (riece-prefix-nickname prefix))
300 (parameters (riece-split-parameters string))
301 (invited (car parameters))
302 (channel (nth 1 parameters))
303 (channel-identity (riece-make-identity channel riece-server-name)))
304 (if (riece-identity-equal-no-server invited riece-real-nickname)
305 (setq riece-join-channel-candidate channel-identity))
307 (list riece-dialogue-buffer riece-others-buffer)
309 (riece-concat-server-name
310 (format "%s invites %s to %s"
311 (riece-format-identity (riece-make-identity
312 user riece-server-name))
313 (riece-format-identity (riece-make-identity
314 invited riece-server-name))
315 (riece-format-identity channel-identity)))
318 (defun riece-handle-topic-message (prefix string)
319 (let* ((user (riece-prefix-nickname prefix))
320 (parameters (riece-split-parameters string))
321 (channel (car parameters))
322 (topic (nth 1 parameters))
323 (user-identity (riece-make-identity user riece-server-name))
324 (channel-identity (riece-make-identity channel riece-server-name)))
325 (riece-channel-set-topic (riece-get-channel channel) topic)
326 (riece-emit-signal 'channel-topic-changed
327 channel-identity topic)
328 (let ((buffer (riece-channel-buffer channel-identity)))
331 (format "Topic by %s: %s\n"
332 (riece-format-identity user-identity t)
335 (if (and riece-channel-buffer-mode
336 (not (eq buffer riece-channel-buffer)))
337 (list riece-dialogue-buffer riece-others-buffer)
338 riece-dialogue-buffer)
340 (riece-concat-server-name
341 (format "Topic on %s by %s: %s"
342 (riece-format-identity channel-identity t)
343 (riece-format-identity user-identity t)
347 (defun riece-parse-modes (string)
350 (while (and (string-match "[-+]\\([^ ]*\\) *" string start)
351 (= (match-beginning 0) start))
352 (let ((toggle (eq (aref string 0) ?+))
353 (modes (string-to-list (match-string 1 string))))
354 (setq start (match-end 0))
356 (if (and (string-match "\\([^-+][^ ]*\\) *" string start)
357 (= (match-beginning 0) start))
358 (setq start (match-end 0)
359 result (cons (list (car modes) toggle
360 (match-string 1 string))
362 (setq result (cons (list (car modes) toggle)
364 (setq modes (cdr modes)))))
367 (defun riece-handle-channel-modes (channel modes)
370 ((eq (car (car modes)) ?o)
371 (riece-channel-toggle-operator channel
374 (riece-emit-signal 'channel-operators-changed
375 (riece-make-identity channel
377 (riece-make-identity (nth 2 (car modes))
379 (nth 1 (car modes))))
380 ((eq (car (car modes)) ?v)
381 (riece-channel-toggle-speaker channel
384 (riece-emit-signal 'channel-speakers-changed
385 (riece-make-identity channel
387 (riece-make-identity (nth 2 (car modes))
389 (nth 1 (car modes))))
390 ((eq (car (car modes)) ?b)
391 (riece-channel-toggle-banned channel
393 (nth 1 (car modes))))
394 ((eq (car (car modes)) ?e)
395 (riece-channel-toggle-uninvited channel
397 (nth 1 (car modes))))
398 ((eq (car (car modes)) ?I)
399 (riece-channel-toggle-invited channel
401 (nth 1 (car modes))))
403 (apply #'riece-channel-toggle-mode channel (car modes))))
404 (setq modes (cdr modes)))
405 (riece-emit-signal 'channel-modes-changed
406 (riece-make-identity channel
409 (defun riece-handle-mode-message (prefix string)
410 (let* ((user (riece-prefix-nickname prefix))
411 (user-identity (riece-make-identity user riece-server-name))
413 (when (string-match "^\\([^ ]+\\) *:?" string)
414 (setq channel (match-string 1 string)
415 string (substring string (match-end 0)))
416 (if (string-match (concat "^" riece-channel-regexp "$") channel)
417 (riece-handle-channel-modes channel (riece-parse-modes string)))
418 (let* ((channel-identity (riece-make-identity channel riece-server-name))
419 (buffer (riece-channel-buffer channel-identity)))
422 (format "Mode by %s: %s\n"
423 (riece-format-identity user-identity t)
426 (if (and riece-channel-buffer-mode
427 (not (eq buffer riece-channel-buffer)))
428 (list riece-dialogue-buffer riece-others-buffer)
429 riece-dialogue-buffer)
431 (riece-concat-server-name
432 (format "Mode on %s by %s: %s"
433 (riece-format-identity channel-identity t)
434 (riece-format-identity user-identity t)
438 (provide 'riece-handle)
440 ;;; riece-handle.el ends here