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 (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)))
64 (riece-redisplay-buffers)))
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 (speaker (riece-make-identity user riece-server-name)))
72 (riece-display-message
73 (riece-make-message speaker
74 (riece-make-identity (car targets)
79 speaker (riece-current-nickname))))))
81 (defun riece-handle-notice-message (prefix string)
82 (let* ((user (if prefix
83 (riece-prefix-nickname prefix)))
84 (parameters (riece-split-parameters string))
85 (targets (split-string (car parameters) ","))
86 (message (nth 1 parameters)))
88 (riece-display-message
89 (riece-make-message (riece-make-identity user
91 (riece-make-identity (car targets)
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)))
138 (riece-redisplay-buffers)))
140 (defun riece-handle-part-message (prefix string)
141 (let* ((user (riece-prefix-nickname prefix))
142 (parameters (riece-split-parameters string))
143 ;; RFC2812 3.2.2 doesn't recommend server to send part
144 ;; messages which contain multiple targets.
145 (channels (split-string (car parameters) ","))
146 (message (nth 1 parameters))
147 (user-identity (riece-make-identity user riece-server-name)))
149 (riece-naming-assert-part user (car channels))
150 (let* ((channel-identity (riece-make-identity (car channels)
152 (buffer (riece-channel-buffer channel-identity)))
156 (riece-concat-message
157 (format "%s has left %s"
158 (riece-format-identity user-identity t)
159 (riece-format-identity channel-identity t))
163 (if (and riece-channel-buffer-mode
164 (not (eq buffer riece-channel-buffer)))
165 (list riece-dialogue-buffer riece-others-buffer)
166 riece-dialogue-buffer)
168 (riece-concat-server-name
169 (riece-concat-message
170 (format "%s has left %s"
171 (riece-format-identity user-identity t)
172 (riece-format-identity channel-identity t))
175 (setq channels (cdr channels)))
176 (riece-redisplay-buffers)))
178 (defun riece-handle-kick-message (prefix string)
179 (let* ((kicker (riece-prefix-nickname prefix))
180 (parameters (riece-split-parameters string))
181 (channel (car parameters))
182 (user (nth 1 parameters))
183 (message (nth 2 parameters))
184 (kicker-identity (riece-make-identity kicker riece-server-name))
185 (channel-identity (riece-make-identity channel riece-server-name))
186 (user-identity (riece-make-identity user riece-server-name)))
187 (riece-naming-assert-part user channel)
188 (let ((buffer (riece-channel-buffer channel-identity)))
192 (riece-concat-message
193 (format "%s kicked %s out from %s"
194 (riece-format-identity kicker-identity t)
195 (riece-format-identity user-identity t)
196 (riece-format-identity channel-identity t))
200 (if (and riece-channel-buffer-mode
201 (not (eq buffer riece-channel-buffer)))
202 (list riece-dialogue-buffer riece-others-buffer)
203 riece-dialogue-buffer)
205 (riece-concat-server-name
206 (riece-concat-message
207 (format "%s kicked %s out from %s\n"
208 (riece-format-identity kicker-identity t)
209 (riece-format-identity user-identity t)
210 (riece-format-identity channel-identity t))
213 (riece-redisplay-buffers)))
215 (defun riece-handle-quit-message (prefix string)
216 (let* ((user (riece-prefix-nickname prefix))
217 (channels (copy-sequence (riece-user-get-channels user)))
219 (parameters (riece-split-parameters string))
220 (message (car parameters))
221 (user-identity (riece-make-identity user riece-server-name)))
222 ;; If you are talking with the user, quit it.
223 (if (riece-identity-member user-identity riece-current-channels)
224 (riece-part-channel user))
225 (setq pointer channels)
227 (riece-naming-assert-part user (car pointer))
228 (setq pointer (cdr pointer)))
232 (riece-channel-buffer (riece-make-identity channel
238 (riece-concat-message
239 (format "%s has left IRC"
240 (riece-format-identity user-identity t))
244 (if (and riece-channel-buffer-mode
245 (not (memq riece-channel-buffer buffers)))
246 (list riece-dialogue-buffer riece-others-buffer)
247 riece-dialogue-buffer)
249 (riece-concat-server-name
250 (riece-concat-message
251 (format "%s has left IRC"
252 (riece-format-identity user-identity t))
255 (riece-redisplay-buffers))
257 (defun riece-handle-kill-message (prefix string)
258 (let* ((killer (riece-prefix-nickname prefix))
259 (parameters (riece-split-parameters string))
260 (user (car parameters))
261 (message (nth 1 parameters))
262 (channels (copy-sequence (riece-user-get-channels user)))
263 (killer-identity (riece-make-identity killer riece-server-name))
264 (user-identity (riece-make-identity user riece-server-name))
266 ;; If you are talking with the user, quit it.
267 (if (riece-identity-member user-identity riece-current-channels)
268 (riece-part-channel user))
269 (setq pointer channels)
271 (riece-naming-assert-part user (car pointer))
272 (setq pointer (cdr pointer)))
276 (riece-channel-buffer (riece-make-identity channel
282 (riece-concat-message
283 (format "%s killed %s"
284 (riece-format-identity killer-identity t)
285 (riece-format-identity user-identity t))
289 (if (and riece-channel-buffer-mode
290 (not (memq riece-channel-buffer buffers)))
291 (list riece-dialogue-buffer riece-others-buffer)
292 riece-dialogue-buffer)
294 (riece-concat-server-name
295 (riece-concat-message
296 (format "%s killed %s"
297 (riece-format-identity killer-identity t)
298 (riece-format-identity user-identity t))
301 (riece-redisplay-buffers)))
303 (defun riece-handle-invite-message (prefix string)
304 (let* ((user (riece-prefix-nickname prefix))
305 (parameters (riece-split-parameters string))
306 (invited (car parameters))
307 (channel (nth 1 parameters))
308 (channel-identity (riece-make-identity channel riece-server-name)))
309 (if (riece-identity-equal-no-server invited riece-real-nickname)
310 (setq riece-join-channel-candidate channel-identity))
312 (list riece-dialogue-buffer riece-others-buffer)
314 (riece-concat-server-name
315 (format "%s invites %s to %s"
316 (riece-format-identity (riece-make-identity
317 user riece-server-name))
318 (riece-format-identity (riece-make-identity
319 invited riece-server-name))
320 (riece-format-identity channel-identity)))
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 (riece-channel-buffer 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 (riece-channel-buffer channel-identity)))
393 (format "Mode by %s: %s\n"
394 (riece-format-identity user-identity t)
397 (if (and riece-channel-buffer-mode
398 (not (eq buffer riece-channel-buffer)))
399 (list riece-dialogue-buffer riece-others-buffer)
400 riece-dialogue-buffer)
402 (riece-concat-server-name
403 (format "Mode on %s by %s: %s"
404 (riece-format-identity channel-identity t)
405 (riece-format-identity user-identity t)
408 (riece-redisplay-buffers)))))
410 (provide 'riece-handle)
412 ;;; riece-handle.el ends here