Fix -- user list buffer not updating when parts are hidden.
[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       (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)
148                                                       riece-server-name))
149                (buffer (riece-channel-buffer channel-identity)))
150           (riece-insert-change
151            buffer
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)))
156           (riece-insert-change
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)
161            (concat
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)))
167             "\n"))))
168       (setq channels (cdr channels)))))
169
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)))
177     (while channels
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)
182                                                       riece-server-name))
183                (buffer (riece-channel-buffer channel-identity))
184                message)
185           (setq parameters (riece-split-parameters
186                             (riece-decoded-string-for-identity decoded
187                                                                channel-identity))
188                 message (nth 1 parameters))
189           (riece-insert-change
190            buffer
191            (concat
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))
196              message)
197             "\n"))
198           (riece-insert-change
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)
203            (concat
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))
209               message))
210             "\n"))))
211       (riece-naming-assert-part user (car channels))
212       (setq channels (cdr channels)))))
213
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))
219          message
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
225                                                          channel-identity))
226           message (nth 2 parameters))
227     (riece-naming-assert-part user channel)
228     (let ((buffer (riece-channel-buffer channel-identity)))
229       (riece-insert-change
230        buffer
231        (concat
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))
237          message)
238         "\n"))
239       (riece-insert-change
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)
244        (concat
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))
251           message))
252         "\n")))))
253
254 (defun riece-handle-quit-message (prefix string)
255   (let* ((user (riece-prefix-nickname prefix))
256          (channels (copy-sequence (riece-user-get-channels user)))
257          (pointer channels)
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)
265     (while pointer
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)))
271       (let ((buffers
272              (delq nil (mapcar
273                         (lambda (channel)
274                           (riece-channel-buffer (riece-make-identity
275                                                  channel riece-server-name)))
276                         channels))))
277         (riece-insert-change
278          buffers
279          (concat
280           (riece-concat-message
281            (format (riece-mcat "%s has left IRC")
282                    (riece-format-identity user-identity t))
283            message)
284           "\n"))
285         (riece-insert-change
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)
290          (concat
291           (riece-concat-server-name
292            (riece-concat-message
293             (format (riece-mcat "%s has left IRC")
294                     (riece-format-identity user-identity t))
295             message))
296           "\n"))))))
297
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))
306          pointer)
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)
311     (while pointer
312       (riece-naming-assert-part user (car pointer))
313       (setq pointer (cdr pointer)))
314     (let ((buffers
315            (delq nil (mapcar
316                       (lambda (channel)
317                         (riece-channel-buffer (riece-make-identity
318                                                channel riece-server-name)))
319                       channels))))
320       (riece-insert-change
321        buffers
322        (concat
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))
327          message)
328         "\n"))
329       (riece-insert-change
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)
334        (concat
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))
340           message))
341         "\n")))))
342
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))
351     (riece-insert-info
352      (list riece-dialogue-buffer riece-others-buffer)
353      (concat
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)))
361       "\n"))))
362
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))
367          topic
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
372                                                          channel-identity))
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)))
378       (riece-insert-change
379        buffer
380        (format (riece-mcat "Topic by %s: %s\n")
381                (riece-format-identity user-identity t)
382                topic))
383       (riece-insert-change
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)
388        (concat
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)
393                  topic))
394         "\n")))))
395
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))
399          channel)
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)))
408         (riece-insert-change
409          buffer
410          (format (riece-mcat "Mode by %s: %s\n")
411                  (riece-format-identity user-identity t)
412                  string))
413         (riece-insert-change
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)
418          (concat
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)
423                    string))
424           "\n"))))))
425
426 (provide 'riece-handle)
427
428 ;;; riece-handle.el ends here