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-display)
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 (let ((pointer (riece-identity-member old-identity
46 riece-current-channels)))
48 (setcar pointer new-identity)
49 (with-current-buffer (riece-channel-buffer-name new-identity)
50 (rename-buffer (riece-channel-buffer-name new-identity)))
51 (if (riece-identity-equal new-identity riece-current-channel)
52 (riece-switch-to-channel new-identity))
53 (setq channels (cons new-identity channels))))
54 (riece-insert-change (mapcar
56 (riece-channel-buffer-name
57 (riece-make-identity channel riece-server-name)))
60 (riece-format-identity old-identity t)
61 (riece-format-identity new-identity t)))
62 (riece-insert-change (if visible
64 (list riece-dialogue-buffer riece-others-buffer))
66 (riece-concat-server-name
68 (riece-format-identity old-identity t)
69 (riece-format-identity new-identity t)))
71 (riece-redisplay-buffers)))
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 (riece-display-message
79 (riece-make-message (riece-make-identity user
81 (riece-make-identity (car targets)
85 (defun riece-handle-notice-message (prefix string)
86 (let* ((user (if prefix
87 (riece-prefix-nickname prefix)))
88 (parameters (riece-split-parameters string))
89 (targets (split-string (car parameters) ","))
90 (message (nth 1 parameters)))
92 (riece-display-message
93 (riece-make-message (riece-make-identity user
95 (riece-make-identity (car targets)
98 ;; message from server
100 (list riece-dialogue-buffer riece-others-buffer)
101 (concat (riece-concat-server-name message) "\n")))))
103 (defun riece-handle-ping-message (prefix string)
104 (riece-send-string (format "PONG :%s\r\n"
105 (if (eq (aref string 0) ?:)
109 (defun riece-handle-join-message (prefix string)
110 (let* ((user (riece-prefix-nickname prefix))
111 ;; RFC2812 3.2.1 doesn't recommend server to send join
112 ;; messages which contain multiple targets.
113 (channels (split-string (car (riece-split-parameters string)) ","))
114 (user-identity (riece-make-identity user riece-server-name)))
116 (riece-naming-assert-join user (car channels))
117 (let* ((channel-identity (riece-make-identity (car channels)
119 (buffer (get-buffer (riece-channel-buffer-name
123 (format "%s (%s) has joined %s\n"
124 (riece-format-identity user-identity t)
125 (riece-user-get-user-at-host user)
126 (riece-format-identity channel-identity t)))
128 (if (and riece-channel-buffer-mode
129 (not (eq buffer riece-channel-buffer)))
130 (list riece-dialogue-buffer riece-others-buffer)
131 riece-dialogue-buffer)
133 (riece-concat-server-name
134 (format "%s (%s) has joined %s"
135 (riece-format-identity user-identity t)
136 (riece-user-get-user-at-host user)
137 (riece-format-identity channel-identity t)))
139 (setq channels (cdr channels)))
140 (riece-redisplay-buffers)))
142 (defun riece-handle-part-message (prefix string)
143 (let* ((user (riece-prefix-nickname prefix))
144 (parameters (riece-split-parameters string))
145 ;; RFC2812 3.2.2 doesn't recommend server to send part
146 ;; messages which contain multiple targets.
147 (channels (split-string (car parameters) ","))
148 (message (nth 1 parameters))
149 (user-identity (riece-make-identity user riece-server-name)))
151 (riece-naming-assert-part user (car channels))
152 (let* ((channel-identity (riece-make-identity (car channels)
154 (buffer (get-buffer (riece-channel-buffer-name
159 (riece-concat-message
160 (format "%s has left %s"
161 (riece-format-identity user-identity t)
162 (riece-format-identity channel-identity t))
166 (if (and riece-channel-buffer-mode
167 (not (eq buffer riece-channel-buffer)))
168 (list riece-dialogue-buffer riece-others-buffer)
169 riece-dialogue-buffer)
171 (riece-concat-server-name
172 (riece-concat-message
173 (format "%s has left %s"
174 (riece-format-identity user-identity t)
175 (riece-format-identity channel-identity t))
178 (setq channels (cdr channels)))
179 (riece-redisplay-buffers)))
181 (defun riece-handle-kick-message (prefix string)
182 (let* ((kicker (riece-prefix-nickname prefix))
183 (parameters (riece-split-parameters string))
184 (channel (car parameters))
185 (user (nth 1 parameters))
186 (message (nth 2 parameters))
187 (kicker-identity (riece-make-identity kicker riece-server-name))
188 (channel-identity (riece-make-identity channel riece-server-name))
189 (user-identity (riece-make-identity user riece-server-name)))
190 (riece-naming-assert-part user channel)
191 (let ((buffer (get-buffer (riece-channel-buffer-name channel-identity))))
195 (riece-concat-message
196 (format "%s kicked %s out from %s"
197 (riece-format-identity kicker-identity t)
198 (riece-format-identity user-identity t)
199 (riece-format-identity channel-identity t))
203 (if (and riece-channel-buffer-mode
204 (not (eq buffer riece-channel-buffer)))
205 (list riece-dialogue-buffer riece-others-buffer)
206 riece-dialogue-buffer)
208 (riece-concat-server-name
209 (riece-concat-message
210 (format "%s kicked %s out from %s\n"
211 (riece-format-identity kicker-identity t)
212 (riece-format-identity user-identity t)
213 (riece-format-identity channel-identity t))
216 (riece-redisplay-buffers)))
218 (defun riece-handle-quit-message (prefix string)
219 (let* ((user (riece-prefix-nickname prefix))
220 (channels (copy-sequence (riece-user-get-channels user)))
222 (parameters (riece-split-parameters string))
223 (message (car parameters))
224 (user-identity (riece-make-identity user riece-server-name)))
225 ;; If you are talking with the user, quit it.
226 (if (riece-identity-member user-identity riece-current-channels)
227 (riece-part-channel user))
228 (setq pointer channels)
230 (riece-naming-assert-part user (car pointer))
231 (setq pointer (cdr pointer)))
236 (riece-channel-buffer-name
237 (riece-make-identity channel riece-server-name))))
242 (riece-concat-message
243 (format "%s has left IRC"
244 (riece-format-identity user-identity t))
248 (if (and riece-channel-buffer-mode
249 (not (memq riece-channel-buffer buffers)))
250 (list riece-dialogue-buffer riece-others-buffer)
251 riece-dialogue-buffer)
253 (riece-concat-server-name
254 (riece-concat-message
255 (format "%s has left IRC"
256 (riece-format-identity user-identity t))
259 (riece-redisplay-buffers))
261 (defun riece-handle-kill-message (prefix string)
262 (let* ((killer (riece-prefix-nickname prefix))
263 (parameters (riece-split-parameters string))
264 (user (car parameters))
265 (message (nth 1 parameters))
266 (channels (copy-sequence (riece-user-get-channels user)))
267 (killer-identity (riece-make-identity killer riece-server-name))
268 (user-identity (riece-make-identity user riece-server-name))
270 ;; If you are talking with the user, quit it.
271 (if (riece-identity-member user-identity riece-current-channels)
272 (riece-part-channel user))
273 (setq pointer channels)
275 (riece-naming-assert-part user (car pointer))
276 (setq pointer (cdr pointer)))
281 (riece-channel-buffer-name
282 (riece-make-identity channel riece-server-name))))
287 (riece-concat-message
288 (format "%s killed %s"
289 (riece-format-identity killer-identity t)
290 (riece-format-identity user-identity t))
294 (if (and riece-channel-buffer-mode
295 (not (memq riece-channel-buffer buffers)))
296 (list riece-dialogue-buffer riece-others-buffer)
297 riece-dialogue-buffer)
299 (riece-concat-server-name
300 (riece-concat-message
301 (format "%s killed %s"
302 (riece-format-identity killer-identity t)
303 (riece-format-identity user-identity t))
306 (riece-redisplay-buffers)))
308 (defun riece-handle-invite-message (prefix string)
309 (let* ((user (riece-prefix-nickname prefix))
310 (parameters (riece-split-parameters string))
311 (channel (car parameters)))
313 (list riece-dialogue-buffer riece-others-buffer)
315 (riece-concat-server-name
316 (format "%s invites you to %s"
317 (riece-format-identity (riece-make-identity
318 user riece-server-name))
319 (riece-format-identity (riece-make-identity
320 channel riece-server-name))))
323 (defun riece-handle-topic-message (prefix string)
324 (let* ((user (riece-prefix-nickname prefix))
325 (parameters (riece-split-parameters string))
326 (channel (car parameters))
327 (topic (nth 1 parameters))
328 (user-identity (riece-make-identity user riece-server-name))
329 (channel-identity (riece-make-identity channel riece-server-name)))
330 (riece-channel-set-topic (riece-get-channel channel) topic)
331 (let ((buffer (get-buffer (riece-channel-buffer-name channel-identity))))
334 (format "Topic by %s: %s\n"
335 (riece-format-identity user-identity t)
338 (if (and riece-channel-buffer-mode
339 (not (eq buffer riece-channel-buffer)))
340 (list riece-dialogue-buffer riece-others-buffer)
341 riece-dialogue-buffer)
343 (riece-concat-server-name
344 (format "Topic on %s by %s: %s"
345 (riece-format-identity channel-identity t)
346 (riece-format-identity user-identity t)
349 (riece-redisplay-buffers))))
351 (defsubst riece-parse-channel-modes (string channel)
352 (while (string-match "^[-+]\\([^ ]*\\) *" string)
353 (let ((toggle (aref string 0))
354 (modes (string-to-list (match-string 1 string))))
355 (setq string (substring string (match-end 0)))
357 (if (and (memq (car modes) '(?O ?o ?v ?k ?l ?b ?e ?I))
358 (string-match "\\([^-+][^ ]*\\) *" string))
359 (let ((parameter (match-string 1 string)))
360 (setq string (substring string (match-end 0)))
363 (riece-channel-toggle-operator channel parameter
366 (riece-channel-toggle-speaker channel parameter
369 (riece-channel-toggle-banned channel parameter
372 (riece-channel-toggle-uninvited channel parameter
375 (riece-channel-toggle-invited channel parameter
377 (riece-channel-toggle-mode channel (car modes)
379 (setq modes (cdr modes))))))
381 (defun riece-handle-mode-message (prefix string)
382 (let* ((user (riece-prefix-nickname prefix))
383 (user-identity (riece-make-identity user riece-server-name))
385 (when (string-match "\\([^ ]+\\) *:?" string)
386 (setq channel (match-string 1 string)
387 string (substring string (match-end 0)))
388 (riece-parse-channel-modes string channel)
389 (let* ((channel-identity (riece-make-identity channel riece-server-name))
390 (buffer (get-buffer (riece-channel-buffer-name
394 (format "Mode by %s: %s\n"
395 (riece-format-identity user-identity t)
398 (if (and riece-channel-buffer-mode
399 (not (eq buffer riece-channel-buffer)))
400 (list riece-dialogue-buffer riece-others-buffer)
401 riece-dialogue-buffer)
403 (riece-concat-server-name
404 (format "Mode on %s by %s: %s"
405 (riece-format-identity channel-identity t)
406 (riece-format-identity user-identity t)
409 (riece-redisplay-buffers)))))
411 (provide 'riece-handle)
413 ;;; riece-handle.el ends here