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 (riece-display-message
72 (riece-make-message (riece-make-identity user
74 (riece-make-identity (car targets)
77 (riece-identity-equal-no-server
78 user riece-real-nickname)))))
80 (defun riece-handle-notice-message (prefix string)
81 (let* ((user (if prefix
82 (riece-prefix-nickname prefix)))
83 (parameters (riece-split-parameters string))
84 (targets (split-string (car parameters) ","))
85 (message (nth 1 parameters)))
87 (riece-display-message
88 (riece-make-message (riece-make-identity user
90 (riece-make-identity (car targets)
93 (riece-identity-equal-no-server
94 user riece-real-nickname)))
95 ;; message from server
97 (list riece-dialogue-buffer riece-others-buffer)
98 (concat (riece-concat-server-name message) "\n")))))
100 (defun riece-handle-ping-message (prefix string)
101 (riece-send-string (format "PONG :%s\r\n"
102 (if (eq (aref string 0) ?:)
106 (defun riece-handle-join-message (prefix string)
107 (let* ((user (riece-prefix-nickname prefix))
108 ;; RFC2812 3.2.1 doesn't recommend server to send join
109 ;; messages which contain multiple targets.
110 (channels (split-string (car (riece-split-parameters string)) ","))
111 (user-identity (riece-make-identity user riece-server-name)))
113 (riece-naming-assert-join user (car channels))
114 (if (and riece-gather-channel-modes
115 (riece-identity-equal-no-server user riece-real-nickname))
116 (riece-send-string (format "MODE %s\r\n" (car channels))))
117 (let* ((channel-identity (riece-make-identity (car channels)
119 (buffer (riece-channel-buffer channel-identity)))
122 (format "%s (%s) has joined %s\n"
123 (riece-format-identity user-identity t)
124 (riece-user-get-user-at-host user)
125 (riece-format-identity channel-identity t)))
127 (if (and riece-channel-buffer-mode
128 (not (eq buffer riece-channel-buffer)))
129 (list riece-dialogue-buffer riece-others-buffer)
130 riece-dialogue-buffer)
132 (riece-concat-server-name
133 (format "%s (%s) has joined %s"
134 (riece-format-identity user-identity t)
135 (riece-user-get-user-at-host user)
136 (riece-format-identity channel-identity t)))
138 (setq channels (cdr channels)))
139 (riece-redisplay-buffers)))
141 (defun riece-handle-part-message (prefix string)
142 (let* ((user (riece-prefix-nickname prefix))
143 (parameters (riece-split-parameters string))
144 ;; RFC2812 3.2.2 doesn't recommend server to send part
145 ;; messages which contain multiple targets.
146 (channels (split-string (car parameters) ","))
147 (message (nth 1 parameters))
148 (user-identity (riece-make-identity user riece-server-name)))
150 (riece-naming-assert-part user (car channels))
151 (let* ((channel-identity (riece-make-identity (car channels)
153 (buffer (riece-channel-buffer channel-identity)))
157 (riece-concat-message
158 (format "%s has left %s"
159 (riece-format-identity user-identity t)
160 (riece-format-identity channel-identity t))
164 (if (and riece-channel-buffer-mode
165 (not (eq buffer riece-channel-buffer)))
166 (list riece-dialogue-buffer riece-others-buffer)
167 riece-dialogue-buffer)
169 (riece-concat-server-name
170 (riece-concat-message
171 (format "%s has left %s"
172 (riece-format-identity user-identity t)
173 (riece-format-identity channel-identity t))
176 (setq channels (cdr channels)))
177 (riece-redisplay-buffers)))
179 (defun riece-handle-kick-message (prefix string)
180 (let* ((kicker (riece-prefix-nickname prefix))
181 (parameters (riece-split-parameters string))
182 (channel (car parameters))
183 (user (nth 1 parameters))
184 (message (nth 2 parameters))
185 (kicker-identity (riece-make-identity kicker riece-server-name))
186 (channel-identity (riece-make-identity channel riece-server-name))
187 (user-identity (riece-make-identity user riece-server-name)))
188 (riece-naming-assert-part user channel)
189 (let ((buffer (riece-channel-buffer channel-identity)))
193 (riece-concat-message
194 (format "%s kicked %s out from %s"
195 (riece-format-identity kicker-identity t)
196 (riece-format-identity user-identity t)
197 (riece-format-identity channel-identity t))
201 (if (and riece-channel-buffer-mode
202 (not (eq buffer riece-channel-buffer)))
203 (list riece-dialogue-buffer riece-others-buffer)
204 riece-dialogue-buffer)
206 (riece-concat-server-name
207 (riece-concat-message
208 (format "%s kicked %s out from %s\n"
209 (riece-format-identity kicker-identity t)
210 (riece-format-identity user-identity t)
211 (riece-format-identity channel-identity t))
214 (riece-redisplay-buffers)))
216 (defun riece-handle-quit-message (prefix string)
217 (let* ((user (riece-prefix-nickname prefix))
218 (channels (copy-sequence (riece-user-get-channels user)))
220 (parameters (riece-split-parameters string))
221 (message (car parameters))
222 (user-identity (riece-make-identity user riece-server-name)))
223 ;; If you are talking with the user, quit it.
224 (if (riece-identity-member user-identity riece-current-channels)
225 (riece-part-channel user))
226 (setq pointer channels)
228 (riece-naming-assert-part user (car pointer))
229 (setq pointer (cdr pointer)))
233 (riece-channel-buffer (riece-make-identity channel
239 (riece-concat-message
240 (format "%s has left IRC"
241 (riece-format-identity user-identity t))
245 (if (and riece-channel-buffer-mode
246 (not (memq riece-channel-buffer buffers)))
247 (list riece-dialogue-buffer riece-others-buffer)
248 riece-dialogue-buffer)
250 (riece-concat-server-name
251 (riece-concat-message
252 (format "%s has left IRC"
253 (riece-format-identity user-identity t))
256 (riece-redisplay-buffers))
258 (defun riece-handle-kill-message (prefix string)
259 (let* ((killer (riece-prefix-nickname prefix))
260 (parameters (riece-split-parameters string))
261 (user (car parameters))
262 (message (nth 1 parameters))
263 (channels (copy-sequence (riece-user-get-channels user)))
264 (killer-identity (riece-make-identity killer riece-server-name))
265 (user-identity (riece-make-identity user riece-server-name))
267 ;; If you are talking with the user, quit it.
268 (if (riece-identity-member user-identity riece-current-channels)
269 (riece-part-channel user))
270 (setq pointer channels)
272 (riece-naming-assert-part user (car pointer))
273 (setq pointer (cdr pointer)))
277 (riece-channel-buffer (riece-make-identity channel
283 (riece-concat-message
284 (format "%s killed %s"
285 (riece-format-identity killer-identity t)
286 (riece-format-identity user-identity t))
290 (if (and riece-channel-buffer-mode
291 (not (memq riece-channel-buffer buffers)))
292 (list riece-dialogue-buffer riece-others-buffer)
293 riece-dialogue-buffer)
295 (riece-concat-server-name
296 (riece-concat-message
297 (format "%s killed %s"
298 (riece-format-identity killer-identity t)
299 (riece-format-identity user-identity t))
302 (riece-redisplay-buffers)))
304 (defun riece-handle-invite-message (prefix string)
305 (let* ((user (riece-prefix-nickname prefix))
306 (parameters (riece-split-parameters string))
307 (invited (car parameters))
308 (channel (nth 1 parameters))
309 (channel-identity (riece-make-identity channel riece-server-name)))
310 (if (riece-identity-equal-no-server invited riece-real-nickname)
311 (setq riece-join-channel-candidate channel-identity))
313 (list riece-dialogue-buffer riece-others-buffer)
315 (riece-concat-server-name
316 (format "%s invites %s to %s"
317 (riece-format-identity (riece-make-identity
318 user riece-server-name))
319 (riece-format-identity (riece-make-identity
320 invited riece-server-name))
321 (riece-format-identity channel-identity)))
324 (defun riece-handle-topic-message (prefix string)
325 (let* ((user (riece-prefix-nickname prefix))
326 (parameters (riece-split-parameters string))
327 (channel (car parameters))
328 (topic (nth 1 parameters))
329 (user-identity (riece-make-identity user riece-server-name))
330 (channel-identity (riece-make-identity channel riece-server-name)))
331 (riece-channel-set-topic (riece-get-channel channel) topic)
332 (let ((buffer (riece-channel-buffer channel-identity)))
335 (format "Topic by %s: %s\n"
336 (riece-format-identity user-identity t)
339 (if (and riece-channel-buffer-mode
340 (not (eq buffer riece-channel-buffer)))
341 (list riece-dialogue-buffer riece-others-buffer)
342 riece-dialogue-buffer)
344 (riece-concat-server-name
345 (format "Topic on %s by %s: %s"
346 (riece-format-identity channel-identity t)
347 (riece-format-identity user-identity t)
350 (riece-redisplay-buffers))))
352 (defsubst riece-parse-channel-modes (string channel)
353 (while (string-match "^[-+]\\([^ ]*\\) *" string)
354 (let ((toggle (aref string 0))
355 (modes (string-to-list (match-string 1 string))))
356 (setq string (substring string (match-end 0)))
358 (if (and (memq (car modes) '(?O ?o ?v ?k ?l ?b ?e ?I))
359 (string-match "\\([^-+][^ ]*\\) *" string))
360 (let ((parameter (match-string 1 string)))
361 (setq string (substring string (match-end 0)))
364 (riece-channel-toggle-operator channel parameter
367 (riece-channel-toggle-speaker channel parameter
370 (riece-channel-toggle-banned channel parameter
373 (riece-channel-toggle-uninvited channel parameter
376 (riece-channel-toggle-invited channel parameter
378 (riece-channel-toggle-mode channel (car modes)
380 (setq modes (cdr modes))))))
382 (defun riece-handle-mode-message (prefix string)
383 (let* ((user (riece-prefix-nickname prefix))
384 (user-identity (riece-make-identity user riece-server-name))
386 (when (string-match "\\([^ ]+\\) *:?" string)
387 (setq channel (match-string 1 string)
388 string (substring string (match-end 0)))
389 (riece-parse-channel-modes string channel)
390 (let* ((channel-identity (riece-make-identity channel riece-server-name))
391 (buffer (riece-channel-buffer channel-identity)))
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