1 ;;; riece-handle.el --- basic message handlers -*- lexical-binding: t -*-
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., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
28 (require 'riece-message)
29 (require 'riece-channel)
30 (require 'riece-naming)
31 (require 'riece-signal)
39 (defun riece-default-handle-numeric-reply
40 (client-prefix _prefix _number _name string)
42 (list riece-dialogue-buffer riece-others-buffer)
44 (riece-concat-server-name
45 (mapconcat #'identity (riece-split-parameters string) " "))
48 (defun riece-handle-nick-message (prefix string)
49 (let* ((old (riece-prefix-nickname prefix))
50 (new (car (riece-split-parameters string)))
51 (old-identity (riece-make-identity old riece-server-name))
52 (new-identity (riece-make-identity new riece-server-name))
53 (channels (riece-user-get-channels old))
54 (visible (riece-identity-member
56 (mapcar (lambda (channel)
57 (riece-make-identity channel riece-server-name))
59 (riece-naming-assert-rename old new)
60 (if (riece-identity-member old-identity riece-current-channels)
61 (setq channels (cons new channels)))
62 (riece-insert-change (delq nil (mapcar
66 channel riece-server-name)))
69 (riece-format-identity old-identity t)
70 (riece-format-identity new-identity t)))
71 (riece-insert-change (if visible
73 (list riece-dialogue-buffer riece-others-buffer))
75 (riece-concat-server-name
77 (riece-format-identity old-identity t)
78 (riece-format-identity new-identity t)))
81 (defun riece-handle-privmsg-message (prefix decoded)
82 (let* ((user (riece-prefix-nickname prefix))
83 (parameters (riece-split-parameters (riece-decoded-string decoded)))
84 (targets (split-string (car parameters) ","))
86 (setq parameters (riece-split-parameters
87 (riece-decoded-string-for-identity
89 (riece-make-identity (car targets) riece-server-name)))
90 message (nth 1 parameters))
91 (riece-display-message
92 (riece-make-message (riece-make-identity user
94 (riece-make-identity (car targets)
98 (riece-identity-equal-no-server
99 user riece-real-nickname)))))
101 (defun riece-handle-notice-message (prefix decoded)
102 (let* ((user (if prefix
103 (riece-prefix-nickname prefix)))
104 (parameters (riece-split-parameters (riece-decoded-string decoded)))
105 (targets (split-string (car parameters) ","))
107 (setq parameters (riece-split-parameters
108 (riece-decoded-string-for-identity
110 (riece-make-identity (car targets) riece-server-name)))
111 message (nth 1 parameters))
113 (riece-display-message
114 (riece-make-message (riece-make-identity user
116 (riece-make-identity (car targets)
119 (if riece-real-nickname
120 (riece-identity-equal-no-server
121 user riece-real-nickname))))
122 ;; message from server
124 (list riece-dialogue-buffer riece-others-buffer)
125 (concat (riece-concat-server-name message) "\n")))))
127 (defun riece-handle-ping-message (_prefix string)
128 (riece-send-string (format "PONG :%s\r\n"
129 (if (eq (aref string 0) ?:)
133 (defun riece-handle-join-message (prefix string)
134 (let* ((user (riece-prefix-nickname prefix))
135 ;; RFC2812 3.2.1 doesn't recommend server to send join
136 ;; messages which contain multiple targets.
137 (channels (split-string (car (riece-split-parameters string)) ","))
138 (user-identity (riece-make-identity user riece-server-name)))
140 (riece-naming-assert-join user (car channels))
141 (if (and riece-gather-channel-modes
142 (riece-identity-equal-no-server user riece-real-nickname))
143 (riece-send-string (format "MODE %s\r\n" (car channels))))
144 (unless (and (memq 'joins riece-hide-list)
145 (not (riece-identity-equal-no-server
146 user riece-real-nickname)))
147 (let* ((channel-identity (riece-make-identity (car channels)
149 (buffer (riece-channel-buffer channel-identity)))
152 (format (riece-mcat "%s (%s) has joined %s\n")
153 (riece-format-identity user-identity t)
154 (riece-user-get-user-at-host user)
155 (riece-format-identity channel-identity t)))
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)
162 (riece-concat-server-name
163 (format (riece-mcat "%s (%s) has joined %s")
164 (riece-format-identity user-identity t)
165 (riece-user-get-user-at-host user)
166 (riece-format-identity channel-identity t)))
168 (setq channels (cdr channels)))))
170 (defun riece-handle-part-message (prefix decoded)
171 (let* ((user (riece-prefix-nickname prefix))
172 (parameters (riece-split-parameters (riece-decoded-string decoded)))
173 ;; RFC2812 3.2.2 doesn't recommend server to send part
174 ;; messages which contain multiple targets.
175 (channels (split-string (car parameters) ","))
176 (user-identity (riece-make-identity user riece-server-name)))
178 (unless (and (memq 'parts riece-hide-list)
179 (not (riece-identity-equal-no-server
180 user riece-real-nickname)))
181 (let* ((channel-identity (riece-make-identity (car channels)
183 (buffer (riece-channel-buffer channel-identity))
185 (setq parameters (riece-split-parameters
186 (riece-decoded-string-for-identity decoded
188 message (nth 1 parameters))
192 (riece-concat-message
193 (format (riece-mcat "%s has left %s")
194 (riece-format-identity user-identity t)
195 (riece-format-identity channel-identity t))
199 (if (and riece-channel-buffer-mode
200 (not (eq buffer riece-channel-buffer)))
201 (list riece-dialogue-buffer riece-others-buffer)
202 riece-dialogue-buffer)
204 (riece-concat-server-name
205 (riece-concat-message
206 (format (riece-mcat "%s has left %s")
207 (riece-format-identity user-identity t)
208 (riece-format-identity channel-identity t))
211 (riece-naming-assert-part user (car channels))
212 (setq channels (cdr channels)))))
214 (defun riece-handle-kick-message (prefix decoded)
215 (let* ((kicker (riece-prefix-nickname prefix))
216 (parameters (riece-split-parameters (riece-decoded-string decoded)))
217 (channel (car parameters))
218 (user (nth 1 parameters))
220 (kicker-identity (riece-make-identity kicker riece-server-name))
221 (channel-identity (riece-make-identity channel riece-server-name))
222 (user-identity (riece-make-identity user riece-server-name)))
223 (setq parameters (riece-split-parameters
224 (riece-decoded-string-for-identity decoded
226 message (nth 2 parameters))
227 (riece-naming-assert-part user channel)
228 (let ((buffer (riece-channel-buffer channel-identity)))
232 (riece-concat-message
233 (format (riece-mcat "%s kicked %s out from %s")
234 (riece-format-identity kicker-identity t)
235 (riece-format-identity user-identity t)
236 (riece-format-identity channel-identity t))
240 (if (and riece-channel-buffer-mode
241 (not (eq buffer riece-channel-buffer)))
242 (list riece-dialogue-buffer riece-others-buffer)
243 riece-dialogue-buffer)
245 (riece-concat-server-name
246 (riece-concat-message
247 (format (riece-mcat "%s kicked %s out from %s\n")
248 (riece-format-identity kicker-identity t)
249 (riece-format-identity user-identity t)
250 (riece-format-identity channel-identity t))
254 (defun riece-handle-quit-message (prefix string)
255 (let* ((user (riece-prefix-nickname prefix))
256 (channels (copy-sequence (riece-user-get-channels user)))
258 (parameters (riece-split-parameters string))
259 (message (car parameters))
260 (user-identity (riece-make-identity user riece-server-name)))
261 ;; If you are talking with the user, quit it.
262 (if (riece-identity-member user-identity riece-current-channels)
263 (riece-part-channel user-identity))
264 (setq pointer channels)
266 (riece-naming-assert-part user (car pointer))
267 (setq pointer (cdr pointer)))
268 (unless (and (memq 'quits riece-hide-list)
269 (not (riece-identity-equal-no-server
270 user riece-real-nickname)))
274 (riece-channel-buffer (riece-make-identity
275 channel riece-server-name)))
280 (riece-concat-message
281 (format (riece-mcat "%s has left IRC")
282 (riece-format-identity user-identity t))
286 (if (and riece-channel-buffer-mode
287 (not (memq riece-channel-buffer buffers)))
288 (list riece-dialogue-buffer riece-others-buffer)
289 riece-dialogue-buffer)
291 (riece-concat-server-name
292 (riece-concat-message
293 (format (riece-mcat "%s has left IRC")
294 (riece-format-identity user-identity t))
298 (defun riece-handle-kill-message (prefix string)
299 (let* ((killer (riece-prefix-nickname prefix))
300 (parameters (riece-split-parameters string))
301 (user (car parameters))
302 (message (nth 1 parameters))
303 (channels (copy-sequence (riece-user-get-channels user)))
304 (killer-identity (riece-make-identity killer riece-server-name))
305 (user-identity (riece-make-identity user riece-server-name))
307 ;; If you are talking with the user, quit it.
308 (if (riece-identity-member user-identity riece-current-channels)
309 (riece-part-channel user))
310 (setq pointer channels)
312 (riece-naming-assert-part user (car pointer))
313 (setq pointer (cdr pointer)))
317 (riece-channel-buffer (riece-make-identity
318 channel riece-server-name)))
323 (riece-concat-message
324 (format (riece-mcat "%s killed %s")
325 (riece-format-identity killer-identity t)
326 (riece-format-identity user-identity t))
330 (if (and riece-channel-buffer-mode
331 (not (memq riece-channel-buffer buffers)))
332 (list riece-dialogue-buffer riece-others-buffer)
333 riece-dialogue-buffer)
335 (riece-concat-server-name
336 (riece-concat-message
337 (format (riece-mcat "%s killed %s")
338 (riece-format-identity killer-identity t)
339 (riece-format-identity user-identity t))
343 (defun riece-handle-invite-message (prefix string)
344 (let* ((user (riece-prefix-nickname prefix))
345 (parameters (riece-split-parameters string))
346 (invited (car parameters))
347 (channel (nth 1 parameters))
348 (channel-identity (riece-make-identity channel riece-server-name)))
349 (if (riece-identity-equal-no-server invited riece-real-nickname)
350 (setq riece-join-channel-candidate channel-identity))
352 (list riece-dialogue-buffer riece-others-buffer)
354 (riece-concat-server-name
355 (format (riece-mcat "%s invites %s to %s")
356 (riece-format-identity (riece-make-identity
357 user riece-server-name))
358 (riece-format-identity (riece-make-identity
359 invited riece-server-name))
360 (riece-format-identity channel-identity)))
363 (defun riece-handle-topic-message (prefix decoded)
364 (let* ((user (riece-prefix-nickname prefix))
365 (parameters (riece-split-parameters (riece-decoded-string decoded)))
366 (channel (car parameters))
368 (user-identity (riece-make-identity user riece-server-name))
369 (channel-identity (riece-make-identity channel riece-server-name)))
370 (setq parameters (riece-split-parameters
371 (riece-decoded-string-for-identity decoded
373 topic (nth 1 parameters))
374 (riece-channel-set-topic (riece-get-channel channel) topic)
375 (riece-emit-signal 'channel-topic-changed
376 channel-identity topic)
377 (let ((buffer (riece-channel-buffer channel-identity)))
380 (format (riece-mcat "Topic by %s: %s\n")
381 (riece-format-identity user-identity t)
384 (if (and riece-channel-buffer-mode
385 (not (eq buffer riece-channel-buffer)))
386 (list riece-dialogue-buffer riece-others-buffer)
387 riece-dialogue-buffer)
389 (riece-concat-server-name
390 (format (riece-mcat "Topic on %s by %s: %s")
391 (riece-format-identity channel-identity t)
392 (riece-format-identity user-identity t)
396 (defun riece-handle-mode-message (prefix string)
397 (let* ((user (riece-prefix-nickname prefix))
398 (user-identity (riece-make-identity user riece-server-name))
400 (when (string-match "^\\([^ ]+\\) *:?" string)
401 (setq channel (match-string 1 string)
402 string (substring string (match-end 0)))
403 (if (string-match (concat "^" riece-channel-regexp "$") channel)
404 (riece-naming-assert-channel-modes channel
405 (riece-parse-modes string)))
406 (let* ((channel-identity (riece-make-identity channel riece-server-name))
407 (buffer (riece-channel-buffer channel-identity)))
410 (format (riece-mcat "Mode by %s: %s\n")
411 (riece-format-identity user-identity t)
414 (if (and riece-channel-buffer-mode
415 (not (eq buffer riece-channel-buffer)))
416 (list riece-dialogue-buffer riece-others-buffer)
417 riece-dialogue-buffer)
419 (riece-concat-server-name
420 (format (riece-mcat "Mode on %s by %s: %s")
421 (riece-format-identity channel-identity t)
422 (riece-format-identity user-identity t)
426 (provide 'riece-handle)
428 ;;; riece-handle.el ends here