Don't use old-style backquote in doc/ptexinfmt.el.
[riece] / lisp / riece-300.el
1 ;;; riece-300.el --- handlers for 300 replies
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-naming)
29 (require 'riece-signal)
30 (require 'riece-display)
31
32 (eval-when-compile
33   (autoload 'riece-default-handle-numeric-reply "riece-handle"))
34 (defun riece-handle-default-300-message (prefix number name string)
35   (riece-default-handle-numeric-reply
36    riece-info-prefix prefix number name string))
37
38 (defun riece-handle-302-message (prefix number name string)
39   "RPL_USERHOST \":*1<reply> *( \" \" <reply> )\""
40   (let ((replies (split-string (if (eq (aref string 0) ?:)
41                                    (substring string 1)
42                                  string)
43                                " ")))
44     (while replies
45       (if (string-match
46            (concat "^\\([^ ]+\\)\\(\\*\\)?=\\([-+]\\)\\([^ ]+\\)")
47            (car replies))
48           (let ((user (match-string 1 (car replies)))
49                 (operator (not (null (match-beginning 2))))
50                 (away (eq (match-string 3 (car replies)) ?-))
51                 (user-at-host (match-string 4 (car replies)))
52                 status)
53             (if away
54                 (setq status (cons "away" status)))
55             (if operator
56                 (setq status (cons "operator" status)))
57             (riece-user-toggle-away user away)
58             (riece-emit-signal 'user-away-changed
59                                (riece-make-identity user riece-server-name)
60                                away)
61             (riece-user-toggle-operator user operator)
62             (riece-emit-signal 'user-operator-changed
63                                (riece-make-identity user riece-server-name)
64                                operator)
65             (riece-insert-info
66              (list riece-dialogue-buffer riece-others-buffer)
67              (concat
68               (riece-concat-server-name
69                (riece-concat-user-status
70                 status
71                 (format (riece-mcat "%s is (%s)")
72                         (riece-format-identity
73                          (riece-make-identity user riece-server-name)
74                          t)
75                         (riece-strip-user-at-host user-at-host))))
76               "\n"))))
77       (setq replies (cdr replies)))))
78
79 (defun riece-handle-303-message (prefix number name string)
80   (riece-insert-info
81    (list riece-dialogue-buffer riece-others-buffer)
82    (concat
83     (riece-concat-server-name
84      (concat (riece-mcat "Online: ")
85              (mapconcat
86               (lambda (user)
87                 (riece-format-identity
88                  (riece-make-identity user riece-server-name)
89                  t))
90               (split-string (if (eq (aref string 0) ?:)
91                                 (substring string 1)
92                               string)
93                             " ")
94               "")))
95     "\n")))
96
97 (defun riece-handle-301-message (prefix number name string)
98   (if (string-match (concat "^\\([^ ]+\\) :?") string)
99       (let ((user (match-string 1 string))
100             (message (substring string (match-end 0))))
101         (riece-user-toggle-away user t)
102         (riece-emit-signal 'user-away-changed
103                            (riece-make-identity user riece-server-name)
104                            t)
105         (riece-insert-info
106          (list riece-dialogue-buffer riece-others-buffer)
107          (concat
108           (riece-concat-server-name
109            (format (riece-mcat "%s is away: %s")
110                    (riece-format-identity
111                     (riece-make-identity user riece-server-name)
112                     t)
113                    message))
114           "\n")))))
115
116 (defun riece-handle-305-message (prefix number name string)
117   (riece-user-toggle-away riece-real-nickname nil)
118   (riece-emit-signal 'user-away-changed
119                       (riece-make-identity riece-real-nickname
120                                            riece-server-name)
121                       nil))
122
123 (defun riece-handle-306-message (prefix number name string)
124   (riece-user-toggle-away riece-real-nickname t)
125   (riece-emit-signal 'user-away-changed
126                      (riece-make-identity riece-real-nickname
127                                           riece-server-name)
128                      t))
129
130 (defun riece-handle-311-message (prefix number name string)
131   (if (string-match
132        (concat "^\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\* :?")
133        string)
134       (let ((user (match-string 1 string))
135             (name (substring string (match-end 0)))
136             (user-at-host (concat (match-string 2 string) "@"
137                                   (match-string 3 string))))
138         (riece-insert-info
139          (list riece-dialogue-buffer riece-others-buffer)
140          (concat
141           (riece-concat-server-name
142            (format (riece-mcat "%s is %s (%s)")
143                    (riece-format-identity
144                     (riece-make-identity user riece-server-name)
145                     t)
146                    name
147                    user-at-host))
148           "\n")))))
149
150 (defun riece-handle-312-message (prefix number name string)
151   (if (string-match
152        (concat "^\\([^ ]+\\) \\([^ ]+\\) :?")
153        string)
154       (riece-insert-info
155        (list riece-dialogue-buffer riece-others-buffer)
156        (concat
157         (riece-concat-server-name
158          (format (riece-mcat "on via server %s: %s")
159                  (match-string 2 string)
160                  (substring string (match-end 0))))
161         "\n"))))
162
163 (defun riece-handle-313-message (prefix number name string)
164   (if (string-match "^[^ ]+" string)
165       (let ((user (match-string 0 string)))
166         (riece-insert-info
167          (list riece-dialogue-buffer riece-others-buffer)
168          (concat
169           (riece-concat-server-name
170            (format "%s is an IRC operator"
171                    (riece-format-identity
172                     (riece-make-identity user riece-server-name)
173                     t)))
174           "\n")))))
175
176 (defun riece-handle-317-message (prefix number name string)
177   (if (string-match
178        (concat "^\\([^ ]+\\) \\([0-9]+\\) ")
179        string)
180       (let* ((user (match-string 1 string))
181              (seconds (string-to-number (match-string 2 string)))
182              (units (list (cons (/ seconds 60 60 24) (riece-mcat "days"))
183                           (cons (mod (/ seconds 60 60) 24)
184                                 (riece-mcat "hours"))
185                           (cons (mod (/ seconds 60) 60) (riece-mcat "minutes"))
186                           (cons (mod seconds 60) (riece-mcat "seconds")))))
187         (riece-insert-info
188          (list riece-dialogue-buffer riece-others-buffer)
189          (concat
190           (riece-concat-server-name
191            (format (riece-mcat "%s is %s idle")
192                    (riece-format-identity
193                     (riece-make-identity user riece-server-name)
194                     t)
195                    (mapconcat #'identity
196                               (delq nil
197                                     (mapcar
198                                      (lambda (unit)
199                                        (if (/= (car unit) 0)
200                                            (format "%d %s"
201                                                    (car unit) (cdr unit))))
202                                      units))
203                               " ")))
204           "\n")))))
205
206 (defun riece-handle-319-message (prefix number name string)
207   (if (string-match (concat "^\\([^ ]+\\) :?") string)
208       (let ((user (match-string 1 string))
209             (channels
210              (mapconcat
211               (lambda (channel)
212                 (if (string-match
213                      (concat "^\\([@+]?\\)\\(" riece-channel-regexp "\\)")
214                      channel)
215                     (concat
216                      (match-string 1 channel)
217                      (riece-format-identity
218                       (riece-make-identity (match-string 2 channel)
219                                            riece-server-name)
220                       t))))
221               (split-string (substring string (match-end 0)) " ")
222               " ")))
223         (riece-insert-info
224          (list riece-dialogue-buffer riece-others-buffer)
225          (concat
226           (riece-concat-server-name
227            (format "%s: %s"
228                    (riece-format-identity
229                     (riece-make-identity user riece-server-name)
230                     t)
231                    channels))
232           "\n")))))
233
234 (defun riece-handle-351-message (prefix number name string)
235   (if (string-match "\\([^ ]+\\.[^ ]+\\) \\([^ ]+\\) :?" string)
236       (riece-insert-info
237        (list riece-dialogue-buffer riece-others-buffer)
238        (concat
239         (riece-concat-server-name
240          (format (riece-mcat "%s is running on %s: %s")
241                  (match-string 1 string)
242                  (match-string 2 string)
243                  (substring string (match-end 0))))
244         "\n"))))
245
246 (defvar riece-353-message-alist nil)
247 (defun riece-handle-353-message (prefix number name string)
248   "RPL_NAMREPLY \"[=\*@] <channel> :[[@|+]<nick> [[@|+]<nick> [...]]]\"."
249   (make-local-variable 'riece-353-message-alist)      
250   (if (string-match "^[=\*@] *\\([^ ]+\\) +:?" string)
251       (let* ((channel (match-string 1 string))
252              (entry (riece-identity-assoc channel riece-353-message-alist t)))
253         (if entry
254             (setcdr entry
255                     (concat (cdr entry)
256                             (substring string (match-end 0)) " "))
257           (setq riece-353-message-alist
258                 (cons (cons channel
259                             (concat (substring string (match-end 0)) " "))
260                       riece-353-message-alist))))))
261
262 (defun riece-handle-322-message (prefix number name decoded)
263   (let* ((parameters (riece-split-parameters (riece-decoded-string decoded)))
264          (channel (car parameters))
265          (visible (nth 1 parameters))
266          (channel-identity (riece-make-identity channel riece-server-name))
267          (buffer (riece-channel-buffer channel-identity))
268          topic)
269     (setq parameters (riece-split-parameters
270                       (riece-decoded-string-for-identity decoded
271                                                          channel-identity))
272           topic (nth 2 parameters))
273     (riece-channel-set-topic (riece-get-channel channel) topic)
274     (riece-insert-info buffer (format (riece-mcat "%s users, topic: %s\n")
275                                       visible topic))
276     (riece-insert-info
277      (if (and riece-channel-buffer-mode
278               (not (eq buffer riece-channel-buffer)))
279          (list riece-dialogue-buffer riece-others-buffer)
280        riece-dialogue-buffer)
281      (concat
282       (riece-concat-server-name
283        (format (riece-mcat "%s: %s users, topic: %s")
284                (riece-format-identity channel-identity t) visible topic))
285       "\n"))))
286
287 (defun riece-handle-324-message (prefix number name string)
288   (if (string-match "^\\([^ ]+\\) \\([^ ]+\\) " string)
289       (let* ((channel (match-string 1 string))
290              (mode-string (match-string 2 string)))
291         (riece-naming-assert-channel-modes channel
292                                            (riece-parse-modes mode-string))
293         (let* ((channel-identity (riece-make-identity channel
294                                                       riece-server-name))
295                (buffer (riece-channel-buffer channel-identity)))
296           (riece-insert-info buffer (concat (riece-mcat "Mode: ") mode-string
297                                             "\n"))
298           (riece-insert-info
299            (if (and riece-channel-buffer-mode
300                     (not (eq buffer riece-channel-buffer)))
301                (list riece-dialogue-buffer riece-others-buffer)
302              riece-dialogue-buffer)
303            (concat
304             (riece-concat-server-name
305              (format (riece-mcat "Mode for %s: %s")
306                      (riece-format-identity channel-identity t)
307                      mode-string))
308             "\n"))))))
309
310 (defun riece-handle-set-topic (prefix number name decoded remove)
311   (let* ((parameters (riece-split-parameters (riece-decoded-string decoded)))
312          (channel (car parameters))
313          topic
314          (channel-identity (riece-make-identity channel riece-server-name))
315          (buffer (riece-channel-buffer channel-identity)))
316     (if remove
317         (riece-channel-set-topic (riece-get-channel channel) nil)
318       (setq parameters (riece-split-parameters
319                         (riece-decoded-string-for-identity decoded
320                                                            channel-identity))
321             topic (nth 1 parameters))
322       (riece-channel-set-topic (riece-get-channel channel) topic)
323       (riece-insert-info buffer (concat (riece-mcat "Topic: ") topic "\n"))
324       (riece-insert-info
325        (if (and riece-channel-buffer-mode
326                 (not (eq buffer riece-channel-buffer)))
327            (list riece-dialogue-buffer riece-others-buffer)
328          riece-dialogue-buffer)
329        (concat
330         (riece-concat-server-name
331          (format (riece-mcat "Topic for %s: %s")
332                  (riece-format-identity channel-identity t)
333                  topic))
334         "\n")))
335     (riece-emit-signal 'channel-topic-changed channel-identity topic)))
336
337 (defun riece-handle-331-message (prefix number name string)
338   (riece-handle-set-topic prefix number name string t))
339
340 (defun riece-handle-332-message (prefix number name string)
341   (riece-handle-set-topic prefix number name string nil))
342
343 (defun riece-handle-341-message (prefix number name string)
344   (if (string-match "^\\([^ ]+\\) " string)
345       (let* ((channel (substring string (match-end 0)))
346              (user (match-string 1 string))
347              (channel-identity (riece-make-identity channel riece-server-name))
348              (buffer (riece-channel-buffer channel-identity)))
349         (riece-insert-info buffer (format (riece-mcat "Inviting %s\n") user))
350         (riece-insert-info
351          (if (and riece-channel-buffer-mode
352                   (not (eq buffer riece-channel-buffer)))
353              (list riece-dialogue-buffer riece-others-buffer)
354            riece-dialogue-buffer)
355          (concat
356           (riece-concat-server-name
357            (format (riece-mcat "Inviting %s to %s") user
358                    (riece-format-identity channel-identity t)))
359           "\n")))))
360
361 (defun riece-handle-352-message (prefix number name string)
362   (if (string-match "^\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([HG]\\)\\(\\*\\)?\\([@+]\\)? :\\([0-9]+\\) " string)
363       (let* ((channel (match-string 1 string))
364              (user (match-string 2 string))
365              (host (match-string 3 string))
366              (server (match-string 4 string))
367              (nick (match-string 5 string))
368              (away (equal (match-string 6 string) "G"))
369              (operator (not (null (match-beginning 7))))
370              (flag (match-string 8 string))
371              (hops (match-string 9 string))
372              (name (substring string (match-end 0)))
373              (buffer (riece-channel-buffer (riece-make-identity
374                                             channel riece-server-name)))
375              (info (format "%10s = %s (%s)"
376                            (concat
377                             (if (memq flag '(?@ ?+))
378                                 (char-to-string flag)
379                               " ")
380                             (riece-format-identity
381                              (riece-make-identity nick riece-server-name)
382                              t))
383                            name
384                            (riece-strip-user-at-host
385                             (concat user "@" host))))
386              status)
387         (if operator
388             (setq status (cons "operator" status)))
389         (if away
390             (setq status (cons "away" status)))
391         (unless (equal hops "0")
392           (setq status (cons (concat "on " server)
393                              (cons (concat hops " hops")
394                                    status))))
395         (if status
396             (setq status (nreverse status)))
397         (riece-naming-assert-join nick channel)
398         (riece-user-toggle-away user away)
399         (riece-emit-signal 'user-away-changed
400                            (riece-make-identity user riece-server-name)
401                            away)
402         (riece-user-toggle-operator user operator)
403         (riece-emit-signal 'user-operator-changed
404                            (riece-make-identity user riece-server-name)
405                            operator)
406         (riece-insert-info buffer (concat (riece-concat-user-status
407                                            status info)
408                                           "\n"))
409         (riece-insert-info
410          (if (and riece-channel-buffer-mode
411                   (not (eq buffer riece-channel-buffer)))
412              (list riece-dialogue-buffer riece-others-buffer)
413            riece-dialogue-buffer)
414          (concat
415           (riece-concat-server-name
416            (riece-concat-user-status
417             status
418             (concat
419              (riece-format-identity
420               (riece-make-identity channel riece-server-name)
421               t)
422              " "
423              info)))
424           "\n")))))
425
426 (defun riece-handle-315-message (prefix number name string))
427 (defun riece-handle-318-message (prefix number name string))
428 (defun riece-handle-323-message (prefix number name string))
429
430 (defun riece-handle-366-message (prefix number name string)
431   "RPL_ENDOFNAMES \"<channel> :End of NAMES list\""
432   (if (string-match "^\\([^ ]+\\) " string)
433       (let* ((channel (match-string 1 string))
434              (channel-identity (riece-make-identity channel
435                                                     riece-server-name))
436              (buffer (riece-channel-buffer channel-identity))
437              (entry (riece-identity-assoc channel riece-353-message-alist t))
438              (string (cdr entry))
439              (start 0)
440              users)
441         (if entry
442             (setq riece-353-message-alist
443                   (delq entry riece-353-message-alist)))
444         (while (string-match
445                 (concat "\\([@+]\\)?\\([^ ]+\\) +")
446                 string start)
447           (put-text-property (match-beginning 2) (match-end 2)
448                              'riece-identity
449                              (riece-make-identity (match-string 2 string)
450                                                   riece-server-name)
451                              string)
452           (setq start (match-end 0)
453                 users (cons (if (match-beginning 1)
454                                 (if (eq (aref string (match-beginning 1)) ?@)
455                                     (list (match-string 2 string) ?o)
456                                   (if (eq (aref string (match-beginning 1)) ?+)
457                                       (list (match-string 2 string) ?v)))
458                               (list (match-string 2 string)))
459                             users)))
460         (setq users (nreverse users))
461         (riece-naming-assert-channel-users users channel)
462         (riece-insert-info
463          buffer
464          (concat (format (riece-mcat "%d users: ") (length users)) string
465                  "\n"))
466         (riece-insert-info
467          (if (and riece-channel-buffer-mode
468                   (not (eq buffer riece-channel-buffer)))
469              (list riece-dialogue-buffer riece-others-buffer)
470            riece-dialogue-buffer)
471          (concat
472           (riece-concat-server-name
473            (concat (format (riece-mcat "%d users on %s: ")
474                            (length users)
475                            (riece-format-identity channel-identity t))
476                    string))
477           "\n")))))
478
479 (provide 'riece-300)
480
481 ;;; riece-300.el ends here