f2cbf06ccd26f4fb60276299326e42ca96fc72fe
[riece] / lisp / riece-handle.el
1 ;;; riece-handle.el --- basic message handlers -*- lexical-binding: t -*-
2 ;; Copyright (C) 1998-2003 Daiki Ueno
3
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
5 ;; Created: 1998-09-28
6 ;; Keywords: IRC, riece
7
8 ;; This file is part of Riece.
9
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)
13 ;; any later version.
14
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.
19
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.
24
25 ;;; Code:
26
27 (require 'riece-misc)
28 (require 'riece-message)
29 (require 'riece-channel)
30 (require 'riece-naming)
31 (require 'riece-signal)
32 (require 'riece-mode)
33 (require 'riece-000)
34 (require 'riece-200)
35 (require 'riece-300)
36 (require 'riece-400)
37 (require 'riece-500)
38
39 (defun riece-default-handle-numeric-reply
40   (client-prefix _prefix _number _name string)
41   (riece-insert
42    (list riece-dialogue-buffer riece-others-buffer)
43    (concat client-prefix
44            (riece-concat-server-name
45             (mapconcat #'identity (riece-split-parameters string) " "))
46            "\n")))
47
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
55                    riece-current-channel
56                    (mapcar (lambda (channel)
57                              (riece-make-identity channel riece-server-name))
58                            channels))))
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
63                                     (lambda (channel)
64                                       (riece-channel-buffer
65                                        (riece-make-identity
66                                         channel riece-server-name)))
67                                     channels))
68                          (format "%s -> %s\n"
69                                  (riece-format-identity old-identity t)
70                                  (riece-format-identity new-identity t)))
71     (riece-insert-change (if visible
72                              riece-dialogue-buffer
73                            (list riece-dialogue-buffer riece-others-buffer))
74                          (concat
75                           (riece-concat-server-name
76                            (format "%s -> %s"
77                                  (riece-format-identity old-identity t)
78                                  (riece-format-identity new-identity t)))
79                           "\n"))))
80
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) ","))
85          message)
86     (setq parameters (riece-split-parameters
87                       (riece-decoded-string-for-identity
88                        decoded
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
93                                               riece-server-name)
94                          (riece-make-identity (car targets)
95                                               riece-server-name)
96                          message
97                          nil
98                          (riece-identity-equal-no-server
99                           user riece-real-nickname)))))
100
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) ","))
106          message)
107     (setq parameters (riece-split-parameters
108                       (riece-decoded-string-for-identity
109                        decoded
110                        (riece-make-identity (car targets) riece-server-name)))
111           message (nth 1 parameters))
112     (if user
113         (riece-display-message
114          (riece-make-message (riece-make-identity user
115                                                   riece-server-name)
116                              (riece-make-identity (car targets)
117                                                   riece-server-name)
118                              message 'notice
119                              (if riece-real-nickname
120                                  (riece-identity-equal-no-server
121                                   user riece-real-nickname))))
122       ;; message from server
123       (riece-insert-notice
124        (list riece-dialogue-buffer riece-others-buffer)
125        (concat (riece-concat-server-name message) "\n")))))
126
127 (defun riece-handle-ping-message (_prefix string)
128   (riece-send-string (format "PONG :%s\r\n"
129                              (if (eq (aref string 0) ?:)
130                                  (substring string 1)
131                                string))))
132
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)))
139     (while channels
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       (let* ((channel-identity (riece-make-identity (car channels)
145                                                     riece-server-name))
146              (buffer (riece-channel-buffer channel-identity)))
147         (riece-insert-change
148          buffer
149          (format (riece-mcat "%s (%s) has joined %s\n")
150                  (riece-format-identity user-identity t)
151                  (riece-user-get-user-at-host user)
152                  (riece-format-identity channel-identity t)))
153         (riece-insert-change
154          (if (and riece-channel-buffer-mode
155                   (not (eq buffer riece-channel-buffer)))
156              (list riece-dialogue-buffer riece-others-buffer)
157            riece-dialogue-buffer)
158          (concat
159           (riece-concat-server-name
160            (format (riece-mcat "%s (%s) has joined %s")
161                    (riece-format-identity user-identity t)
162                    (riece-user-get-user-at-host user)
163                    (riece-format-identity channel-identity t)))
164           "\n")))
165       (setq channels (cdr channels)))))
166
167 (defun riece-handle-part-message (prefix decoded)
168   (let* ((user (riece-prefix-nickname prefix))
169          (parameters (riece-split-parameters (riece-decoded-string decoded)))
170          ;; RFC2812 3.2.2 doesn't recommend server to send part
171          ;; messages which contain multiple targets.
172          (channels (split-string (car parameters) ","))
173          (user-identity (riece-make-identity user riece-server-name)))
174     (while channels
175       (let* ((channel-identity (riece-make-identity (car channels)
176                                                     riece-server-name))
177              (buffer (riece-channel-buffer channel-identity))
178              message)
179         (setq parameters (riece-split-parameters
180                           (riece-decoded-string-for-identity decoded
181                                                              channel-identity))
182               message (nth 1 parameters))
183         (riece-insert-change
184          buffer
185          (concat
186           (riece-concat-message
187            (format (riece-mcat "%s has left %s")
188                    (riece-format-identity user-identity t)
189                    (riece-format-identity channel-identity t))
190            message)
191           "\n"))
192         (riece-insert-change
193          (if (and riece-channel-buffer-mode
194                   (not (eq buffer riece-channel-buffer)))
195              (list riece-dialogue-buffer riece-others-buffer)
196            riece-dialogue-buffer)
197          (concat
198           (riece-concat-server-name
199            (riece-concat-message
200             (format (riece-mcat "%s has left %s")
201                     (riece-format-identity user-identity t)
202                     (riece-format-identity channel-identity t))
203             message))
204           "\n")))
205       (riece-naming-assert-part user (car channels))
206       (setq channels (cdr channels)))))
207
208 (defun riece-handle-kick-message (prefix decoded)
209   (let* ((kicker (riece-prefix-nickname prefix))
210          (parameters (riece-split-parameters (riece-decoded-string decoded)))
211          (channel (car parameters))
212          (user (nth 1 parameters))
213          message
214          (kicker-identity (riece-make-identity kicker riece-server-name))
215          (channel-identity (riece-make-identity channel riece-server-name))
216          (user-identity (riece-make-identity user riece-server-name)))
217     (setq parameters (riece-split-parameters
218                       (riece-decoded-string-for-identity decoded
219                                                          channel-identity))
220           message (nth 2 parameters))
221     (riece-naming-assert-part user channel)
222     (let ((buffer (riece-channel-buffer channel-identity)))
223       (riece-insert-change
224        buffer
225        (concat
226         (riece-concat-message
227          (format (riece-mcat "%s kicked %s out from %s")
228                  (riece-format-identity kicker-identity t)
229                  (riece-format-identity user-identity t)
230                  (riece-format-identity channel-identity t))
231          message)
232         "\n"))
233       (riece-insert-change
234        (if (and riece-channel-buffer-mode
235                 (not (eq buffer riece-channel-buffer)))
236            (list riece-dialogue-buffer riece-others-buffer)
237          riece-dialogue-buffer)
238        (concat
239         (riece-concat-server-name
240          (riece-concat-message
241           (format (riece-mcat "%s kicked %s out from %s\n")
242                  (riece-format-identity kicker-identity t)
243                  (riece-format-identity user-identity t)
244                  (riece-format-identity channel-identity t))
245           message))
246         "\n")))))
247
248 (defun riece-handle-quit-message (prefix string)
249   (let* ((user (riece-prefix-nickname prefix))
250          (channels (copy-sequence (riece-user-get-channels user)))
251          (pointer channels)
252          (parameters (riece-split-parameters string))
253          (message (car parameters))
254          (user-identity (riece-make-identity user riece-server-name)))
255     ;; If you are talking with the user, quit it.
256     (if (riece-identity-member user-identity riece-current-channels)
257         (riece-part-channel user-identity))
258     (setq pointer channels)
259     (while pointer
260       (riece-naming-assert-part user (car pointer))
261       (setq pointer (cdr pointer)))
262     (let ((buffers
263            (delq nil (mapcar
264                       (lambda (channel)
265                         (riece-channel-buffer (riece-make-identity
266                                                channel riece-server-name)))
267                       channels))))
268       (riece-insert-change
269        buffers
270        (concat
271         (riece-concat-message
272          (format (riece-mcat "%s has left IRC")
273                  (riece-format-identity user-identity t))
274          message)
275         "\n"))
276       (riece-insert-change
277        (if (and riece-channel-buffer-mode
278                 (not (memq riece-channel-buffer buffers)))
279            (list riece-dialogue-buffer riece-others-buffer)
280          riece-dialogue-buffer)
281        (concat
282         (riece-concat-server-name
283          (riece-concat-message
284           (format (riece-mcat "%s has left IRC")
285                   (riece-format-identity user-identity t))
286           message))
287         "\n")))))
288
289 (defun riece-handle-kill-message (prefix string)
290   (let* ((killer (riece-prefix-nickname prefix))
291          (parameters (riece-split-parameters string))
292          (user (car parameters))
293          (message (nth 1 parameters))
294          (channels (copy-sequence (riece-user-get-channels user)))
295          (killer-identity (riece-make-identity killer riece-server-name))
296          (user-identity (riece-make-identity user riece-server-name))
297          pointer)
298     ;; If you are talking with the user, quit it.
299     (if (riece-identity-member user-identity riece-current-channels)
300         (riece-part-channel user))
301     (setq pointer channels)
302     (while pointer
303       (riece-naming-assert-part user (car pointer))
304       (setq pointer (cdr pointer)))
305     (let ((buffers
306            (delq nil (mapcar
307                       (lambda (channel)
308                         (riece-channel-buffer (riece-make-identity
309                                                channel riece-server-name)))
310                       channels))))
311       (riece-insert-change
312        buffers
313        (concat
314         (riece-concat-message
315          (format (riece-mcat "%s killed %s")
316                  (riece-format-identity killer-identity t)
317                  (riece-format-identity user-identity t))
318          message)
319         "\n"))
320       (riece-insert-change
321        (if (and riece-channel-buffer-mode
322                 (not (memq riece-channel-buffer buffers)))
323            (list riece-dialogue-buffer riece-others-buffer)
324          riece-dialogue-buffer)
325        (concat
326         (riece-concat-server-name
327          (riece-concat-message
328           (format (riece-mcat "%s killed %s")
329                  (riece-format-identity killer-identity t)
330                  (riece-format-identity user-identity t))
331           message))
332         "\n")))))
333
334 (defun riece-handle-invite-message (prefix string)
335   (let* ((user (riece-prefix-nickname prefix))
336          (parameters (riece-split-parameters string))
337          (invited (car parameters))
338          (channel (nth 1 parameters))
339          (channel-identity (riece-make-identity channel riece-server-name)))
340     (if (riece-identity-equal-no-server invited riece-real-nickname)
341         (setq riece-join-channel-candidate channel-identity))
342     (riece-insert-info
343      (list riece-dialogue-buffer riece-others-buffer)
344      (concat
345       (riece-concat-server-name
346        (format (riece-mcat "%s invites %s to %s")
347                (riece-format-identity (riece-make-identity
348                                        user riece-server-name))
349                (riece-format-identity (riece-make-identity
350                                        invited riece-server-name))
351                (riece-format-identity channel-identity)))
352       "\n"))))
353
354 (defun riece-handle-topic-message (prefix decoded)
355   (let* ((user (riece-prefix-nickname prefix))
356          (parameters (riece-split-parameters (riece-decoded-string decoded)))
357          (channel (car parameters))
358          topic
359          (user-identity (riece-make-identity user riece-server-name))
360          (channel-identity (riece-make-identity channel riece-server-name)))
361     (setq parameters (riece-split-parameters
362                       (riece-decoded-string-for-identity decoded
363                                                          channel-identity))
364           topic (nth 1 parameters))
365     (riece-channel-set-topic (riece-get-channel channel) topic)
366     (riece-emit-signal 'channel-topic-changed
367                        channel-identity topic)
368     (let ((buffer (riece-channel-buffer channel-identity)))
369       (riece-insert-change
370        buffer
371        (format (riece-mcat "Topic by %s: %s\n")
372                (riece-format-identity user-identity t)
373                topic))
374       (riece-insert-change
375        (if (and riece-channel-buffer-mode
376                 (not (eq buffer riece-channel-buffer)))
377            (list riece-dialogue-buffer riece-others-buffer)
378          riece-dialogue-buffer)
379        (concat
380         (riece-concat-server-name
381          (format (riece-mcat "Topic on %s by %s: %s")
382                  (riece-format-identity channel-identity t)
383                  (riece-format-identity user-identity t)
384                  topic))
385         "\n")))))
386
387 (defun riece-handle-mode-message (prefix string)
388   (let* ((user (riece-prefix-nickname prefix))
389          (user-identity (riece-make-identity user riece-server-name))
390          channel)
391     (when (string-match "^\\([^ ]+\\) *:?" string)
392       (setq channel (match-string 1 string)
393             string (substring string (match-end 0)))
394       (if (string-match (concat "^" riece-channel-regexp "$") channel)
395           (riece-naming-assert-channel-modes channel
396                                              (riece-parse-modes string)))
397       (let* ((channel-identity (riece-make-identity channel riece-server-name))
398              (buffer (riece-channel-buffer channel-identity)))
399         (riece-insert-change
400          buffer
401          (format (riece-mcat "Mode by %s: %s\n")
402                  (riece-format-identity user-identity t)
403                  string))
404         (riece-insert-change
405          (if (and riece-channel-buffer-mode
406                   (not (eq buffer riece-channel-buffer)))
407              (list riece-dialogue-buffer riece-others-buffer)
408            riece-dialogue-buffer)
409          (concat
410           (riece-concat-server-name
411            (format (riece-mcat "Mode on %s by %s: %s")
412                    (riece-format-identity channel-identity t)
413                    (riece-format-identity user-identity t)
414                    string))
415           "\n"))))))
416
417 (provide 'riece-handle)
418
419 ;;; riece-handle.el ends here