Remove xetla pkg
[packages] / xemacs-packages / zenirc / src / zenirc.el
1 ;;; zenirc.el --- Waste time on Internet Relay Chat (ZenIRC client)
2
3 ;; Copyright (C) 1993, 1994 Ben A. Mesander
4 ;; Copyright (C) 1993, 1994, 1995 Noah S. Friedman
5 ;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998 Per Persson
6
7 ;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
8 ;;         Noah Friedman <friedman@prep.ai.mit.edu>
9 ;;         Per Persson <pp@sno.pp.se>
10 ;; Major contributors:
11 ;;         Charles Hannum <mycroft@gnu.ai.mit.edu>
12 ;;         Richard Todd <rmtodd@essex.ecn.uoknor.edu>
13 ;;         Eric Prestemon <ecp@io.com>
14 ;;         Mark Bailen <msbailen@msbdcolka.cr.usgs.gov>
15 ;;         Jason Bastek <jason@marilyn.oit.umass.edu>
16 ;;         Ray Jones <rjones@pobox.com>
17 ;; Maintainer: pp@sno.pp.se
18 ;; Keywords: extensions, zenirc
19 ;; Created: 1993-06-03
20
21 ;; This program is free software; you can redistribute it and/or modify
22 ;; it under the terms of the GNU General Public License as published by
23 ;; the Free Software Foundation; either version 2, or (at your option)
24 ;; any later version.
25 ;;
26 ;; This program is distributed in the hope that it will be useful,
27 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
28 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
29 ;; GNU General Public License for more details.
30 ;;
31 ;; You should have received a copy of the GNU General Public License
32 ;; along with this program; if not, you can either send email to this
33 ;; program's maintainer or write to: The Free Software Foundation,
34 ;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
35
36 ;;; Commentary:
37
38 ;;       <vuori> The first Lisp-interpreter of the People's Republic
39 ;;               of China, Lisp-130, was written for a Chinese
40 ;;               minicomputer at the Shenyang Science Academy's
41 ;;               processing automation department in 1980. It was an
42 ;;               implementation of Lisp 1.5, which include 94
43 ;;               functions programmed in assembler.
44 ;;
45 ;;               -- Eero Hyvänen, Juko Seppänen: Lisp-world 2, the
46 ;;                  development of Lisp-languages and systems.
47 ;;
48 ;;          <fn> 1960-03-14  LISP introduced, 
49
50 ;;; Code:
51
52 ;; Current version of ZenIRC.
53 (defconst zenirc-version "2.112")
54
55 (and (string= (substring emacs-version 0 2) "18")
56      (require 'zenirc-18))
57
58 \f
59 ;;; User options
60
61 (defvar zenirc-buffer-name "*zenirc*"
62   "*Basic buffer name for Zen Internet Relay Chat.")
63
64 (defvar zenirc-userinfo "Oink."
65   "*Reply to USERINFO ctcp.")
66
67 (defvar zenirc-ignore-list
68   '(;; Ignore messages with more than four CTCP strings
69     "\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a"
70     )
71   "*Patterns of messages from server to ignore.
72 This should be a list of regular expressions that match IRC protocol messages.
73 For example, if you wanted to ignore all messages from `foo@bar.com', put
74 \"PRIVMSG [^!]+!foo@bar\\\\.com \" in the list.")
75
76 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
77 ;;;
78 ;;;     BEEP.  (Female voice:)  Hi Tony, this is Sheila.  I can't stop
79 ;;;     thinking about you.  When can we get together?  I want to grab
80 ;;;     you and undress you and then BEEP
81 ;;;
82 ;;;     -- From the "Canonical List of Anwering Machine Messages."
83 ;;;       
84 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
85
86 (defvar zenirc-signal-list '()
87   "*List of regular expressions which cause signal notification.")
88
89 (defvar zenirc-beep-on-signal nil
90   "*If t, beep on signals when not seen.
91 If 'always, beep on all signals.")
92
93 (defvar zenirc-send-confirmation t
94   "*If nil, don't confirm sent PRIVMSG/NOTICE.
95 If t, confirm sent PRIVMSG/NOTICE in the process buffer.
96 If 'message, confirm sent PRIVMSG/NOTICE in the echo area.
97
98 The confirmation looks like \"(sent to #emacs)\".")
99
100 (defvar zenirc-timestamp nil
101   "*If nil, don't timestamp messages.
102 If t, timestamp messages.")
103
104 (defvar zenirc-timestamp-prefix "["
105   "*What to add before the timestamp string")
106
107 (defvar zenirc-timestamp-suffix "]"
108   "*What do add after the timestamp string")
109
110 (defvar zenirc-always-show-channelname t
111   "*If nil, don't show channelname in PRIVMSG/NOTICE when it's the same as 
112 zenirc-current-victim.
113 If t, always show channelnames in PRIVMSG/NOTICE (when appropriate).")
114
115 (defvar zenirc-delete-preceding-whitespaces nil
116   "*Whether ZenIRC should delete any whitespaces before the first word 
117 before sending it off to the server.")
118
119 (defvar zenirc-whowas-on-401 nil
120   "*Wheter ZenIRC should issue a WHOWAS command if WHOIS returns no nick.")
121
122 (defvar zenirc-send-ctcp-errmsg-on-unknown t
123   "*If non-`nil', reply to unknown CTCP queries with an ERRMSG reply.
124
125 The IRC protocol requires that each query requires a separate error reply,
126 yet most server implementations will close your connection if you send too
127 many messages at once (\"flooding\").  This gives malicious users a way to
128 disconnect you from IRC, but setting this variable to `nil' will prevent it
129 by simply not replying to invalid CTCP requests.
130
131 See also `zenirc-send-ctcp-errmsg-on-unbalanced'.")
132
133 (defvar zenirc-send-ctcp-errmsg-on-unbalanced t
134   "*If non-`nil', reply to unbalanced CTCP queries with an ERRMSG reply.
135 See the documentation for `zenirc-send-ctcp-errmsg-on-unknown' for further
136 information on why it may be useful to set this to `nil'.")
137
138 (defvar zenirc-verbose-ctcp t
139   "*Should ZenIRC tell you when you send CTCP replies to people?")
140
141 (defvar zenirc-fingerdata
142   (format "%s <%s@%s>" (user-full-name) (user-real-login-name) (system-name))
143   "*CTCP FINGER reply data.")
144
145 (defvar zenirc-command-char ?/
146   "*Char that begins a command at the beginning of a line")
147 \f
148 ;;; IRC connection-related variables.
149
150 (defvar zenirc-server-alist nil
151   "*Association list of port/password/nick info for each server.
152 This is initialized via `zenirc-ircserver-string->alist' the first time you
153 start a zenirc session.")
154
155 (defvar zenirc-ircserver-environment-variable-name "IRCSERVER"
156   "*Name of environment variable containing server/port info.
157 This variable is used by `zenirc-ircserver-string->alist'.
158 It is user-settable so that you can potentially define different
159 environment variables for different clients.")
160
161 ;; Give a default for this since there's no easy way of guessing a server
162 ;; name if you don't know any.
163 (defvar zenirc-server-default "irc.stealth.net"
164   "*Server to use if no other is specified.
165 See `zenirc-server-alist' and `zenirc-establish-server-connection'.")
166
167 (defvar zenirc-nick-default nil
168   "*Nickname to use if no other is specified.
169 See `zenirc-server-alist' and `zenirc-establish-server-connection'.")
170
171 (defvar zenirc-password-default nil
172   "*Default server password to use if no other is specified.
173 See `zenirc-server-alist' and `zenirc-establish-server-connection'.")
174
175 (defvar zenirc-port-default nil
176   "*Default server port to use if no other is specified.
177 See `zenirc-server-alist' and `zenirc-establish-server-connection'.")
178
179 (defvar zenirc-user-full-name-default nil
180   "*Default full name used to describe yourself on irc.
181 See `zenirc-establish-server-connection'.")
182
183 (defvar zenirc-user-login-name-default nil
184   "*Default user name to use if no other is specified.
185 See `zenirc-server-alist' and `zenirc-establish-server-connection'.")
186
187 (defvar zenirc-process-connect-function 'open-network-stream
188   "*Function used to establish server connection.
189 This is called by `zenirc-establish-server-connection' and should take the
190 same arguments normally given to `open-network-stream'.
191 This function can be used to make proxy connections.")
192
193 \f
194 ;;; Misc variables of interest.
195 ;;; Most of these are reasonable for users to modify.
196
197 (defconst zenirc-message-length-limit 450
198   "Maximum length of messages that can be sent on a single line.
199
200 Actually, this isn't really the length of the message the client is allowed
201 to send; it includes cruft that might be added by the server and over which
202 you have little knowledge or control.  For example, if your system is not
203 configured so that gethostname returns the FQDN for your host, the
204 calculations in zenirc-send-multi-line may be off from what the server
205 considers is your hostname.  Another way in which it can fail is if your
206 host name is shorter than the corresponding IP address and the server
207 failed to resolve your hostname.
208
209 In light of these possibilities, this constant is set to 450 even though
210 the theoretical maximum allowed is 512 according to RFC1459.")
211
212 (defvar zenirc-mode-map '()
213   "*Sparse keymap for zenirc-mode")
214 (cond
215  ((null zenirc-mode-map)
216   (setq zenirc-mode-map (make-sparse-keymap))
217   (define-key zenirc-mode-map "\n" 'zenirc-send-line)
218   (define-key zenirc-mode-map "\C-m" 'zenirc-send-line)
219   (define-key zenirc-mode-map "\C-c\C-t" 'zenirc-toggle-channel)
220   (define-key zenirc-mode-map "\C-c\C-r" 'zenirc-send-privmsg-last-rec)
221   (define-key zenirc-mode-map "\C-c\C-s" 'zenirc-send-privmsg-last-sent)
222   (define-key zenirc-mode-map ":" 'zenirc-self-insert-or-send-privmsg-last-rec)
223   (define-key zenirc-mode-map ";" 
224     'zenirc-self-insert-or-send-privmsg-last-sent)))
225
226 ;; These strings should be in the format "ftp-server:directory:file".
227 (defvar zenirc-source-list
228   '("ftp.splode.com:/pub/zenirc:zenirc.tar.gz")
229   "Where to retrieve ZenIRC from.")
230
231 ;; Existing client messages are recycled here where possible, as it makes
232 ;; it more likely that other clients will format them correctly.
233 (defvar zenirc-clientinfo-list
234   '((ACTION . "ACTION contains action descriptions for atmosphere")
235     (CLIENTINFO
236      . "CLIENTINFO gives information about available CTCP commands")
237     (ECHO . "ECHO returns string sent by other person")
238     (ERRMSG . "ERRMSG returns error messages")
239     (FINGER . "FINGER shows real name, and login name of user")
240     (PING . "PING returns the arguments it receives")
241     ;; sojge sure is a wordy bastard.
242     ;; The description is made up out of zero or more lines followed by an
243     ;; end marker.
244     ;; Every line is a CTCP reply with the SOURCE keyword, a space, the
245     ;; name of a FTP-server, a colon, a directory name, a colon, and 0 or
246     ;; more file names.
247     ;; If no file names are given, all the files in the named directory are
248     ;; needed.  The end marker contains just the keyword.
249     (SOURCE . "SOURCE Where to find the source code for this client")
250     (TIME . "TIME tells you the time on the user's host")
251     (USERINFO . "USERINFO returns user settable information")
252     (VERSION . "VERSION shows client type, version, and environment"))
253   "*Association list of CLIENTINFO CTCP help strings")
254
255 (defvar zenirc-clientinfo-string "ACTION CLIENTINFO ECHO ERRMSG FINGER PING SOURCE TIME USERINFO VERSION :Use CLIENTINFO <COMMAND> to get more specific information"
256   "*CLIENTINFO Help string, showing list of CTCP commands supported")
257
258 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
259 ;;;
260 ;;;     "I wish this video had some explosions. That would be cool."
261 ;;;     "Heh heh henh hmm heh. It does have some explosions. Heh henh hmm."
262 ;;;     "Faries grant wishes. Huh huh heh huh hunh."
263 ;;;
264 ;;;     -- Beavis & Butthead
265 ;;;
266 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
267
268 ;; debugging variables.  for the adventurous.
269 (defvar zenirc-debug-mainloop nil)
270 (defvar zenirc-debug-ignore nil)
271 (defvar zenirc-debug-signal nil)
272 (defvar zenirc-debug-ctcp nil)
273 (defvar zenirc-debug-commands nil)
274 (defvar zenirc-debug-timer nil)
275 (defvar zenirc-bug-address "zenirc-bug@splode.com")
276
277 \f
278 ;;; local state variables.
279 ;;; It's probably not useful for the user to change these, unless necessary
280 ;;; for particular extensions.
281
282 (defvar zenirc-server nil)
283 (make-variable-buffer-local 'zenirc-server)
284
285 (defvar zenirc-port nil)
286 (make-variable-buffer-local 'zenirc-port)
287
288 (defvar zenirc-password nil)
289 (make-variable-buffer-local 'zenirc-password)
290
291 (defvar zenirc-nick nil)
292 (make-variable-buffer-local 'zenirc-nick)
293
294 (defvar zenirc-user-login-name nil)
295 (make-variable-buffer-local 'zenirc-user-login-name)
296
297 (defvar zenirc-user-full-name nil)
298 (make-variable-buffer-local 'zenirc-user-full-name)
299
300 ;; The name the current IRC server calls itself.
301 ;; This can differ from `zenirc-server' if one is just a network alias of
302 ;; the other.
303 (defvar zenirc-current-server-name nil)
304 (make-variable-buffer-local 'zenirc-current-server-name)
305
306 ;; current channel or luser, or nil
307 (defvar zenirc-current-victim nil)
308 (make-variable-buffer-local 'zenirc-current-victim)
309
310 ;; variables to store the nick you last sent to or that last sent to you
311 (defvar zenirc-privmsg-last-rec "")
312 (make-variable-buffer-local 'zenirc-privmsg-last-rec)
313
314 (defvar zenirc-privmsg-last-sent "")
315 (make-variable-buffer-local 'zenirc-privmsg-last-sent)
316
317 ;; remember last person we saw a privmsg from.
318 (defvar zenirc-privmsg-last-seen nil)
319 (make-variable-buffer-local 'zenirc-privmsg-last-seen)
320
321 ;; a list of channels the client is on
322 (defvar zenirc-channel-list '())
323 (make-variable-buffer-local 'zenirc-channel-list)
324
325 ;; We use this marker instead of the process mark, because the latter goes
326 ;; away when a process exits, which is a gratuitous nuisance.
327 (defvar zenirc-process-mark nil)
328 (make-variable-buffer-local 'zenirc-process-mark)
329
330 ;; unprocessed data read from socket
331 (defvar zenirc-unprocessed-output nil)
332 (make-variable-buffer-local 'zenirc-unprocessed-output)
333
334 ;; standard vector into which parsed messages are stashed, to avoid
335 ;; consing new vectors each time.
336 (defvar zenirc-message-vector (make-vector 12 nil))
337 (make-variable-buffer-local 'zenirc-message-vector)
338
339 ;; allowed server modes (set in 004 reply)
340 (defvar zenirc-server-modes nil)
341 (make-variable-buffer-local 'zenirc-server-modes)
342
343 ;; server version (set in 004 reply)
344 (defvar zenirc-server-version nil)
345 (make-variable-buffer-local 'zenirc-server-version)
346
347 (defvar zenirc-time-last-event nil)
348 (make-variable-buffer-local 'zenirc-time-last-event)
349
350 ;; allowed user modes (set in 004 reply)
351 (defvar zenirc-user-modes nil)
352 (make-variable-buffer-local 'zenirc-user-modes)
353
354 \f
355 ;;; Standard hooks
356
357 ;; TODO: implement "filters" and turn this into one.
358 (defvar zenirc-format-nickuserhost-hook
359   '(identity)
360   "*List of filters used to format nicknames in displayed messages.")
361
362 (defvar zenirc-mode-hook nil
363   "*Hook to run at the end of zenirc-mode.")
364
365 (defvar zenirc-startup-hook nil
366   "*Hook run before establishing a server connection.")
367
368 (defvar zenirc-exit-hook nil
369   "*Hook to run when zenirc exits.")
370
371 (defvar zenirc-connect-hook nil
372   "*Hook to run registering with an IRC server.")
373
374 (defvar zenirc-timer-hook nil
375   "*Timer hook variable.")
376
377 (defvar zenirc-signal-hook '(zenirc-signal)
378   "*Signal hook variable.")
379
380 (defvar zenirc-message-hook nil
381   "*Hook to run whenever a message is inserted in the zenirc buffer.
382 The buffer is narrowed to the region containing the newly-inserted text,
383 and is called with two arguments: the process (if known) and the unmodified
384 string.  This string may not match exactly what is currently in the buffer,
385 since functions on this hook can easily modify the latter.")
386
387 ;; Hooks for various server commands.
388 ;; These are commands that the user types, e.g. "/quit" (the best command
389 ;; of all!).  For any given command CMD, the hook zenirc-command-CMD-hook
390 ;; is run.  If the user types a command for which there is no hook, the
391 ;; command is passed directly to the server.
392 (defvar zenirc-command-away-hook '(zenirc-command-away))
393 (defvar zenirc-command-action-hook '(zenirc-command-action))
394 (defvar zenirc-command-command-char-hook '(zenirc-command-command-char))
395 (defvar zenirc-command-ctcp-hook '(zenirc-command-ctcp))
396 (defvar zenirc-command-kick-hook '(zenirc-command-kick))
397 (defvar zenirc-command-kill-hook '(zenirc-command-kill))
398 (defvar zenirc-command-language-hook '(zenirc-command-language))
399 (defvar zenirc-command-m-hook '(zenirc-command-m))
400 (defvar zenirc-command-me-hook '(zenirc-command-me))
401 (defvar zenirc-command-msg-hook '(zenirc-command-msg))
402 (defvar zenirc-command-notice-hook '(zenirc-command-notice))
403 (defvar zenirc-command-oper-hook '(zenirc-command-oper))
404 (defvar zenirc-command-part-hook '(zenirc-command-part))
405 (defvar zenirc-command-ping-hook '(zenirc-command-ping))
406 (defvar zenirc-command-privmsg-hook '(zenirc-command-privmsg))
407 (defvar zenirc-command-query-hook '(zenirc-command-query))
408 (defvar zenirc-command-quit-hook '(zenirc-command-quit))
409 (defvar zenirc-command-quote-hook '(zenirc-command-quote))
410 (defvar zenirc-command-server-hook '(zenirc-command-server))
411 (defvar zenirc-command-squit-hook '(zenirc-command-squit))
412 (defvar zenirc-command-topic-hook '(zenirc-command-topic))
413
414 ;; Hooks run after various kinds of messages are sent
415 ;; These hooks get several args: a process, a format specifier to use if
416 ;; the message sent had to be sent in multiple chunks, and format specifier
417 ;; to use if the entire message fit in one line, the recipient, and the
418 ;; number of chunks actually sent.
419 ;; See zenirc-send-confirmation-generic for an example.
420 (defvar zenirc-send-confirmation-privmsg-hook
421   '(zenirc-send-confirmation-generic))
422 (defvar zenirc-send-confirmation-notice-hook
423   '(zenirc-send-confirmation-generic))
424 (defvar zenirc-send-confirmation-me-hook '(zenirc-send-confirmation-generic))
425 (defvar zenirc-send-line-hook nil
426   "*Hook run after a line of input is sent to the server.
427 Functions on this hook get three args: two integers specifying the
428 beginning and ending points in the buffer containing the text sent, and a
429 string representing the formatted text actually sent to the server (the
430 main difference is that embedded newlines are mapped to spaces).")
431
432 ;; Hooks run to generate replies to CTCP queries.
433 (defvar zenirc-ctcp-reply-PING-hook '(zenirc-ctcp-reply-PING))
434 (defvar zenirc-ctcp-query-ACTION-hook '(zenirc-ctcp-query-ACTION))
435 (defvar zenirc-ctcp-query-CLIENTINFO-hook '(zenirc-ctcp-query-CLIENTINFO))
436 (defvar zenirc-ctcp-query-ECHO-hook '(zenirc-ctcp-query-ECHO))
437 (defvar zenirc-ctcp-query-ERRMSG-hook '(zenirc-ctcp-query-ERRMSG))
438 (defvar zenirc-ctcp-query-FINGER-hook '(zenirc-ctcp-query-FINGER))
439 (defvar zenirc-ctcp-query-PING-hook '(zenirc-ctcp-query-PING))
440 (defvar zenirc-ctcp-query-SOURCE-hook '(zenirc-ctcp-query-SOURCE))
441 (defvar zenirc-ctcp-query-TIME-hook '(zenirc-ctcp-query-TIME))
442 (defvar zenirc-ctcp-query-USERINFO-hook '(zenirc-ctcp-query-USERINFO))
443 (defvar zenirc-ctcp-query-VERSION-hook '(zenirc-ctcp-query-VERSION))
444
445 ;; Hooks run in response to messages from the server.
446 ;; For any message of type TYPE, the hook zenirc-server-TYPE-hook is run.
447 (defvar zenirc-server-ERROR-hook '(zenirc-server-ERROR))
448 (defvar zenirc-server-INVITE-hook '(zenirc-server-INVITE))
449 (defvar zenirc-server-JOIN-hook '(zenirc-server-JOIN))
450 (defvar zenirc-server-KICK-hook '(zenirc-server-KICK))
451 (defvar zenirc-server-KILL-hook '(zenirc-server-KILL))
452 (defvar zenirc-server-MODE-hook '(zenirc-server-MODE))
453 (defvar zenirc-server-NICK-hook '(zenirc-server-NICK))
454 (defvar zenirc-server-NOTICE-hook '(zenirc-server-NOTICE))
455 (defvar zenirc-server-PART-hook '(zenirc-server-PART))
456 (defvar zenirc-server-PING-hook '(zenirc-server-PING))
457 (defvar zenirc-server-PONG-hook '(zenirc-server-PONG))
458 (defvar zenirc-server-PRIVMSG-hook '(zenirc-server-PRIVMSG))
459 (defvar zenirc-server-QUIT-hook '(zenirc-server-QUIT))
460 (defvar zenirc-server-TOPIC-hook '(zenirc-server-TOPIC))
461 (defvar zenirc-server-WALLOPS-hook '(zenirc-server-WALLOPS))
462 (defvar zenirc-server-001-hook '(zenirc-server-001))
463 (defvar zenirc-server-002-hook '(zenirc-server-002))
464 (defvar zenirc-server-003-hook '(zenirc-server-003))
465 (defvar zenirc-server-004-hook '(zenirc-server-004))
466 (defvar zenirc-server-200-hook '(zenirc-server-200))
467 (defvar zenirc-server-201-hook '(zenirc-server-201))
468 (defvar zenirc-server-202-hook '(zenirc-server-202))
469 (defvar zenirc-server-203-hook '(zenirc-server-203))
470 (defvar zenirc-server-204-hook '(zenirc-server-204))
471 (defvar zenirc-server-205-hook '(zenirc-server-205))
472 (defvar zenirc-server-206-hook '(zenirc-server-206))
473 (defvar zenirc-server-208-hook '(zenirc-server-208))
474 (defvar zenirc-server-209-hook '(zenirc-server-209))
475 (defvar zenirc-server-211-hook '(zenirc-server-211))
476 (defvar zenirc-server-212-hook '(zenirc-server-212))
477 (defvar zenirc-server-213-hook '(zenirc-server-213))
478 (defvar zenirc-server-214-hook '(zenirc-server-214))
479 (defvar zenirc-server-215-hook '(zenirc-server-215))
480 (defvar zenirc-server-216-hook '(zenirc-server-216))
481 (defvar zenirc-server-217-hook '(zenirc-server-217))
482 (defvar zenirc-server-218-hook '(zenirc-server-218))
483 (defvar zenirc-server-219-hook '(zenirc-server-219))
484 (defvar zenirc-server-221-hook '(zenirc-server-221))
485 (defvar zenirc-server-241-hook '(zenirc-server-241))
486 (defvar zenirc-server-242-hook '(zenirc-server-242))
487 (defvar zenirc-server-243-hook '(zenirc-server-243))
488 (defvar zenirc-server-244-hook '(zenirc-server-244))
489 (defvar zenirc-server-249-hook '(zenirc-server-249))
490 (defvar zenirc-server-251-hook '(zenirc-server-251))
491 (defvar zenirc-server-252-hook '(zenirc-server-252))
492 (defvar zenirc-server-253-hook '(zenirc-server-253))
493 (defvar zenirc-server-254-hook '(zenirc-server-254))
494 (defvar zenirc-server-255-hook '(zenirc-server-255))
495 (defvar zenirc-server-256-hook '(zenirc-server-256))
496 (defvar zenirc-server-257-hook '(zenirc-server-257))
497 (defvar zenirc-server-258-hook '(zenirc-server-258))
498 (defvar zenirc-server-259-hook '(zenirc-server-259))
499 (defvar zenirc-server-261-hook '(zenirc-server-261))
500 (defvar zenirc-server-262-hook '(zenirc-server-262))
501 (defvar zenirc-server-301-hook '(zenirc-server-301))
502 (defvar zenirc-server-302-hook '(zenirc-server-302))
503 (defvar zenirc-server-303-hook '(zenirc-server-303))
504 (defvar zenirc-server-305-hook '(zenirc-server-305))
505 (defvar zenirc-server-306-hook '(zenirc-server-306))
506 (defvar zenirc-server-311-hook '(zenirc-server-311))
507 (defvar zenirc-server-312-hook '(zenirc-server-312))
508 (defvar zenirc-server-313-hook '(zenirc-server-313))
509 (defvar zenirc-server-314-hook '(zenirc-server-314))
510 (defvar zenirc-server-315-hook '(zenirc-server-315))
511 (defvar zenirc-server-317-hook '(zenirc-server-317))
512 (defvar zenirc-server-318-hook '(zenirc-server-318))
513 (defvar zenirc-server-319-hook '(zenirc-server-319))
514 (defvar zenirc-server-321-hook '(zenirc-server-321))
515 (defvar zenirc-server-322-hook '(zenirc-server-322))
516 (defvar zenirc-server-323-hook '(zenirc-server-323))
517 (defvar zenirc-server-324-hook '(zenirc-server-324))
518 (defvar zenirc-server-331-hook '(zenirc-server-331))
519 (defvar zenirc-server-332-hook '(zenirc-server-332))
520 (defvar zenirc-server-333-hook '(zenirc-server-333))
521 (defvar zenirc-server-341-hook '(zenirc-server-341))
522 (defvar zenirc-server-342-hook '(zenirc-server-342))
523 (defvar zenirc-server-351-hook '(zenirc-server-351))
524 (defvar zenirc-server-352-hook '(zenirc-server-352))
525 (defvar zenirc-server-353-hook '(zenirc-server-353))
526 (defvar zenirc-server-364-hook '(zenirc-server-364))
527 (defvar zenirc-server-365-hook '(zenirc-server-365))
528 (defvar zenirc-server-366-hook '(zenirc-server-366))
529 (defvar zenirc-server-367-hook '(zenirc-server-367))
530 (defvar zenirc-server-368-hook '(zenirc-server-368))
531 (defvar zenirc-server-369-hook '(zenirc-server-369))
532 (defvar zenirc-server-371-hook '(zenirc-server-371))
533 (defvar zenirc-server-372-hook '(zenirc-server-372))
534 (defvar zenirc-server-374-hook '(zenirc-server-374))
535 (defvar zenirc-server-375-hook '(zenirc-server-375))
536 (defvar zenirc-server-376-hook '(zenirc-server-376))
537 (defvar zenirc-server-381-hook '(zenirc-server-381))
538 (defvar zenirc-server-382-hook '(zenirc-server-382))
539 (defvar zenirc-server-391-hook '(zenirc-server-391))
540 (defvar zenirc-server-392-hook '(zenirc-server-392))
541 (defvar zenirc-server-393-hook '(zenirc-server-393))
542 (defvar zenirc-server-394-hook '(zenirc-server-394))
543 (defvar zenirc-server-395-hook '(zenirc-server-395))
544 (defvar zenirc-server-401-hook '(zenirc-server-401))
545 (defvar zenirc-server-402-hook '(zenirc-server-402))
546 (defvar zenirc-server-403-hook '(zenirc-server-403))
547 (defvar zenirc-server-404-hook '(zenirc-server-404))
548 (defvar zenirc-server-405-hook '(zenirc-server-405))
549 (defvar zenirc-server-406-hook '(zenirc-server-406))
550 (defvar zenirc-server-407-hook '(zenirc-server-407))
551 (defvar zenirc-server-409-hook '(zenirc-server-409))
552 (defvar zenirc-server-411-hook '(zenirc-server-411))
553 (defvar zenirc-server-412-hook '(zenirc-server-412))
554 (defvar zenirc-server-413-hook '(zenirc-server-413))
555 (defvar zenirc-server-414-hook '(zenirc-server-414))
556 (defvar zenirc-server-415-hook '(zenirc-server-415))
557 (defvar zenirc-server-421-hook '(zenirc-server-421))
558 (defvar zenirc-server-422-hook '(zenirc-server-422))
559 (defvar zenirc-server-423-hook '(zenirc-server-423))
560 (defvar zenirc-server-424-hook '(zenirc-server-424))
561 (defvar zenirc-server-431-hook '(zenirc-server-431))
562 (defvar zenirc-server-432-hook '(zenirc-server-432))
563 (defvar zenirc-server-433-hook '(zenirc-server-433))
564 (defvar zenirc-server-436-hook '(zenirc-server-436))
565 (defvar zenirc-server-437-hook '(zenirc-server-437))
566 (defvar zenirc-server-441-hook '(zenirc-server-441))
567 (defvar zenirc-server-442-hook '(zenirc-server-442))
568 (defvar zenirc-server-443-hook '(zenirc-server-443))
569 (defvar zenirc-server-444-hook '(zenirc-server-444))
570 (defvar zenirc-server-445-hook '(zenirc-server-445))
571 (defvar zenirc-server-446-hook '(zenirc-server-446))
572 (defvar zenirc-server-451-hook '(zenirc-server-451))
573 (defvar zenirc-server-461-hook '(zenirc-server-461))
574 (defvar zenirc-server-462-hook '(zenirc-server-462))
575 (defvar zenirc-server-463-hook '(zenirc-server-463))
576 (defvar zenirc-server-464-hook '(zenirc-server-464))
577 (defvar zenirc-server-465-hook '(zenirc-server-465))
578 (defvar zenirc-server-467-hook '(zenirc-server-467))
579 (defvar zenirc-server-471-hook '(zenirc-server-471))
580 (defvar zenirc-server-472-hook '(zenirc-server-472))
581 (defvar zenirc-server-473-hook '(zenirc-server-473))
582 (defvar zenirc-server-474-hook '(zenirc-server-474))
583 (defvar zenirc-server-475-hook '(zenirc-server-475))
584 (defvar zenirc-server-477-hook '(zenirc-server-477))
585 (defvar zenirc-server-481-hook '(zenirc-server-481))
586 (defvar zenirc-server-482-hook '(zenirc-server-482))
587 (defvar zenirc-server-483-hook '(zenirc-server-483))
588 (defvar zenirc-server-491-hook '(zenirc-server-491))
589 (defvar zenirc-server-501-hook '(zenirc-server-501))
590 (defvar zenirc-server-502-hook '(zenirc-server-502))
591
592 (defvar zenirc-font-lock-keywords
593   '(("^\\[\\([^]]+\\)\\].*"        1 font-lock-type-face)
594     ("^\\[[^]]+\\]\\(.*\\)$"       1 font-lock-comment-face)
595     ("^<\\([^>!]+[^>]+\\)>"        1 font-lock-keyword-face)
596     ("^<[^>!]+!\\([^#>]+\\)[^>]+>" 1 font-lock-string-face t)
597     ("^<[^>#]+\\(#[^>]+\\)>"       1 font-lock-function-name-face t)
598     ("^<[^>]+> \\([^ :]+:\\)"      1 font-lock-keyword-face t))
599   "Default expressions to highlight in zenirc mode.")
600  
601 (put 'zenirc-mode 'font-lock-defaults
602      '(zenirc-font-lock-keywords nil nil ((?_ . "w"))))
603
604 \f
605 (defun zenirc-mode ()
606   "Major mode for wasting major time on IRC."
607   (kill-all-local-variables)
608
609   (setq mode-name "ZenIRC")
610   (setq major-mode 'zenirc-mode)
611   (use-local-map zenirc-mode-map)
612   (setq mode-line-process '(":%s"))
613   (setq mode-line-format
614         '( ""
615            mode-line-modified
616            mode-line-buffer-identification
617            " "
618            global-mode-string
619            " "
620            (-3 . "%p")
621            " %[("
622            mode-name
623            mode-line-process
624            "%n"
625            minor-mode-alist
626            ")%] "
627            zenirc-nick
628            (zenirc-current-victim ("->" zenirc-current-victim))
629            " "
630            "%-"))
631   (font-lock-set-defaults)
632   (zenirc-run-hook 'zenirc-mode-hook))
633
634 \f
635 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
636 ;;; Code to handle connection to server
637 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
638
639 ;;;###autoload
640 (defun zenirc (&optional prefix)
641   "Waste time on IRC.
642
643 If an irc session already exists, switch to that session.
644 With prefix arg, start a new session even if another exists.
645
646 If buffer exists but zenirc process is not running, make new process.
647 If buffer exists and zenirc process is running, just switch to that buffer.
648 If an explicit numeric prefix argument is given (or this function is called
649 from lisp with a numeric argument), switch to the buffer named
650 \"*zenirc*<prefix>\", e.g. \"*zenirc*<2>\".  If there is no process in that
651 buffer, start one.
652 If a prefix argument is given but it is not a number, create a new buffer
653 and start a process in it.  This is the same as calling the function from
654 lisp with an argument of `t'."
655   (interactive "P")
656   (let* ((zenirc-buffer (if prefix
657                             (generate-new-buffer zenirc-buffer-name)
658                           (get-buffer-create zenirc-buffer-name)))
659          (process (get-buffer-process zenirc-buffer)))
660     (pop-to-buffer zenirc-buffer)
661
662     (cond
663      ((and process
664            (memq (process-status process) '(open run))))
665      (t
666       (zenirc-mode)
667
668       (or zenirc-server-alist
669           (setq zenirc-server-alist (zenirc-ircserver-string->alist)))
670
671       (setq zenirc-unprocessed-output "")
672       (setq zenirc-current-victim nil)
673
674       ;; Time of last event in zenirc - set it to "now"
675       (setq zenirc-time-last-event
676             (zenirc-time-to-int (current-time-string)))
677
678       ;; note the semantics here that the current buffer when
679       ;; zenirc-startup-hook is run is zenirc-buffer.
680       (zenirc-run-hook 'zenirc-startup-hook)
681
682       ;; Do this before opening network stream, if currently unset.
683       ;; If already set, preserve so that user can save input.
684       (or zenirc-process-mark
685           (setq zenirc-process-mark
686                 (set-marker (make-marker) (point-max) zenirc-buffer)))
687
688       (or (setq process
689                 (zenirc-establish-server-connection zenirc-buffer))
690           (error "zenirc: could not establish any server connection."))
691
692       (set-process-buffer process zenirc-buffer)
693       (set-process-filter process 'zenirc-filter)
694       (set-process-sentinel process 'zenirc-sentinel)
695       (zenirc-login process)
696       (zenirc-run-hook 'zenirc-connect-hook process)))))
697
698 (defun zenirc-select (&optional server port nick)
699   "Run manually or by issuing /server from a ZenIRC buffer.
700
701 This function starts a new ZenIRC buffer and connects to a given server.
702 Variables not already given are queried for, using zenirc-server-alist 
703 for default values. zenirc-server-alist is also updated each time this
704 function is issued."
705
706   (interactive)
707   (if (integerp port) (setq port (int-to-string port)))
708   (let ((new-server) (new-port) (new-nick))
709     (setq 
710      new-server
711      ; server to connect to
712      (or server
713      ; server is not given, query user
714          (completing-read "Server: " zenirc-server-alist nil nil 
715                           (or
716                            (car (car zenirc-server-alist))
717                            ; last resort default
718                            zenirc-server-default)))
719      new-port
720      ; port to connect to
721      (or
722       port
723       ; port is not given, query user
724       (read-string "Port: " 
725                    (or
726                     (if (car (cdr (assoc new-server zenirc-server-alist)))
727                         (int-to-string
728                          (car (cdr (assoc new-server zenirc-server-alist)))))
729                     (if zenirc-port (int-to-string zenirc-port))
730                     ; last resort default
731                     (getenv "IRCPORT")
732                     "6667")))
733      new-nick
734      ; nickname to use
735      (or 
736       nick
737       ; nickname is not given, query user
738       (read-string "Nickname: " 
739                    (or 
740                     (car (nthcdr 3 (assoc new-server zenirc-server-alist)))
741                     zenirc-nick
742                     (getenv "IRCNICK")
743                     ; last resort default
744                     (user-login-name)))))
745     ; update zenirc-server-alist
746     (let ((new-list (list new-server (string-to-int new-port) nil new-nick)))
747       (if (not (member new-list zenirc-server-alist))
748           ; a new entry is given
749           (setq zenirc-server-alist 
750                 (cons new-list zenirc-server-alist))
751         ; move old entry to the top of zenirc-server-alist
752         (setq zenirc-server-alist (delete new-list zenirc-server-alist)
753               zenirc-server-alist (cons new-list zenirc-server-alist)))
754       ; make sure we don't try to connect to anything else then the
755       ; given server
756       (let ((zenirc-server-alist (list new-list)))
757         ; run the actual connection, at last
758         (zenirc t)))))
759
760 (defun zenirc-establish-server-connection (buffer &optional alist)
761   "Waste time by connecting to an irc server.
762 This function takes two arguments: a buffer and an optional alist
763 of the same form as that returned by `zenirc-ircserver-string->alist'.
764 If none is specified, the default is `zenirc-server-alist'.
765
766 For each server in the alist, attempt to connect to it on the appropriate
767 port and with the appropriate nicknames, etc.
768
769 If any of the elements in the list for a server is unspecified, one of the
770 following defaults is used, in the specified order of priority (names in
771 caps preceded with `$' are environment variables):
772
773    port:     zenirc-port-default, $IRCPORT
774    password: zenirc-password-default
775    nickname: zenirc-nick-default, $IRCNICK, (user-login-name)
776    username: zenirc-user-login-name-default, $USER, (user-login-name)
777
778 Finally, if zenirc-server-alist is nil and no other alist is specified,
779 connect to `zenirc-server-default', or $IRCSERVER, using defaults as
780 described above."
781   (save-excursion
782     (set-buffer buffer)
783     (or alist
784         (setq alist zenirc-server-alist)
785         (setq alist (list (list zenirc-server-default))))
786     (let ((procname (concat "zenirc:" (buffer-name)))
787           ent server port proc)
788       (while alist
789         (setq ent (car alist))
790         (setq alist (cdr alist))
791         
792         ;; Note that we check the environment variable before the
793         ;; -default variable.  This is pretty much the only exception.
794         (setq server (or (car ent)
795                          (let ((server (getenv "IRCSERVER")))
796                            (and server
797                                 (substring server 0
798                                            (string-match " \\|:" server))))
799                          zenirc-server-default
800                          (error "no server specified.")))
801         
802         (setq port (or (nth 1 ent)
803                        (let ((p (getenv "IRCPORT")))
804                          (and p (string-to-int p)))
805                        zenirc-port-default
806                        6667))
807         
808         (condition-case data
809             (progn
810               (zenirc-message buffer 'connect-try server port)
811               ;; Do a redisplay before connecting, in case the server is
812               ;; slow to respond.
813               (sit-for 0)
814               (setq proc (funcall zenirc-process-connect-function
815                                   procname buffer server port))
816               ;; Update connection status in modeline.
817               (force-mode-line-update)
818               (setq alist nil)
819               (setq zenirc-server          server)
820               ;; This might get reset later, but initialize it.
821               (setq zenirc-current-server-name server)
822               
823               (setq zenirc-port            port)
824               (setq zenirc-password        (or (nth 2 ent)
825                                                zenirc-password-default))
826               (setq zenirc-nick            (or (nth 3 ent)
827                                                zenirc-nick-default
828                                                (getenv "IRCNICK")
829                                                (user-login-name)
830                                                "Thoth")) ; it -is- funny
831               (setq zenirc-user-full-name  (or (nth 4 ent)
832                                                zenirc-user-full-name-default
833                                                (getenv "IRCNAME")
834                                                (user-full-name)
835                                                "Thoth"))
836               (setq zenirc-user-login-name (or (nth 5 ent)
837                                                zenirc-user-login-name-default
838                                                (getenv "USER")
839                                                (user-login-name)
840                                                "Thoth")))
841           (quit
842            (setq alist nil)
843            (zenirc-message buffer 'connect-abort))
844           
845           (file-error
846            ;; file-error "connection failed" "connection timed out" host proc
847            ;; file-error "connection failed" "connection refused" host proc
848            (if (string= (nth 1 data) "connection failed")
849                (zenirc-message buffer 'connect-failed server port
850                                (nth 2 data))
851              (signal 'file-error data)))
852           (error
853            ;; data == (error "Unknown host \"foo\"")
854            (if (string-match "^Unknown host" (nth 1 data))
855                (zenirc-message buffer 'connect-failed server port
856                                (nth 1 data))
857              (apply 'signal data)))))
858       proc)))
859
860 (defun zenirc-ircserver-string->alist (&optional str)
861   "*Create association list of server to port/password/nick/username.
862
863 This function takes a string of the form
864
865       \"SERVER1:PORT1:PASSWORD1:NICKNAME1:USERNAME1  SERVER2:...\"
866
867 If more than one entry is desired, separate each entry in the string
868 variable with any nonzero amount of whitespace composed of spaces, tabs,
869 and/or newlines.
870
871 If no string is specified, the value of the environment variable
872 specified by `zenirc-ircserver-environment-variable-name'.
873
874 The alist returned consist of lists containing the following elements,
875 and satisfy the corresponding type predicates:
876
877     SERVER:   `stringp'
878     PORT:     `natnump' or `null'
879     PASSWORD: `stringp' or `null'
880     NICKNAME: `stringp' or `null'
881     USERNAME: `stringp' or `null'
882
883 These alists specify a list of servers and related data with which zenirc
884 should attempt to connect to servers; generally, each one is tried until a
885 successful connection is made.  See `zenirc-establish-server-connection'."
886   (or str (setq str (getenv zenirc-ircserver-environment-variable-name)))
887   (cond
888    ((null str) nil)
889    ((let ((len (length str))
890           (pos 0)
891           (result nil)
892           tmp tmplen tmppos
893           tmplist)
894       (save-match-data
895         (and (string-match "^[ \t\r\n]+" str pos)
896              (setq pos (match-end 0)))
897
898         (while (< pos len)
899           (cond ((string-match "[ \t\r\n]+" str pos)
900                  (setq tmplen (- (match-beginning 0) pos))
901                  (setq tmp (substring str pos (+ pos tmplen)))
902                  (setq pos (match-end 0)))
903                 (t
904                  (setq tmplen (- len pos))
905                  (setq tmp (if (zerop pos)
906                                str
907                              (substring str pos)))
908                  (setq pos len)))
909
910           (setq tmppos 0)
911           (setq tmplist nil)
912           (while (< tmppos tmplen)
913             (cond ((string-match ":" tmp tmppos)
914                    (setq tmplist
915                          (cons (substring tmp tmppos (match-beginning 0))
916                                tmplist))
917                    (and (string= (car tmplist) "")
918                         (setcar tmplist nil))
919                    (setq tmppos (match-end 0)))
920                   (t
921                    (and (string= tmp "")
922                         (setq tmp nil))
923                    (setq tmplist (cons (if (zerop tmppos)
924                                            tmp
925                                          (substring tmp tmppos))
926                                        tmplist))
927                    (setq tmppos tmplen))))
928           (and tmplist
929                (progn
930                  (setq tmplist (nreverse tmplist))
931                  (and (stringp (nth 1 tmplist))
932                       ;; convert port number to int
933                       (setcar (nthcdr 1 tmplist)
934                               (string-to-int (nth 1 tmplist))))
935                  (setq result (cons tmplist result))))))
936       (nreverse result)))))
937
938 ;; send nick, user@host information
939 ;; NICK zenirc-nick
940 ;; USER zenirc-user-login-name (system-name) zenirc-server 
941 ;;                                  :zenirc-user-full-name
942 (defun zenirc-login (proc)
943   (and zenirc-password
944        (process-send-string proc (format "PASS %s\n" zenirc-password)))
945   ;; Send user info first; some servers reject connections otherwise.
946   (process-send-string proc (format "USER %s %s %s :%s\n"
947                                     zenirc-user-login-name
948                                     (system-name)
949                                     zenirc-server
950                                     zenirc-user-full-name))
951   (process-send-string proc (format "NICK %s\n" zenirc-nick)))
952     
953 (defun zenirc-sentinel (proc str)
954   (save-excursion
955     (set-buffer (process-buffer proc))
956     (zenirc-run-hook 'zenirc-exit-hook proc str)
957     (zenirc-message proc 'sentinel (current-time-string))))
958
959
960 ;; This function takes a chunk of text from the server, and any text
961 ;; left over from the last chunk, and passes it to zenirc-parse-output
962 ;; to be interpreted.
963 (defun zenirc-filter (proc string)
964   (let ((orig-buffer (current-buffer)))
965     (unwind-protect
966         (progn
967           (set-buffer (process-buffer proc))
968           (setq zenirc-unprocessed-output
969                 (zenirc-parse-output proc string zenirc-unprocessed-output)))
970       (set-buffer orig-buffer))))
971
972 ;; This routine takes a bunch of text from the server, and any remnants
973 ;; from the last bunch, and splits it into lines. The lines are passed to
974 ;; zenirc-parse-server-message to be parsed and then whatever needs to be
975 ;; done for that server message is done.
976 (defun zenirc-parse-output (proc string unparsed-output)
977   (let* ((unparsed (concat unparsed-output string))
978          (proc-window (get-buffer-window (process-buffer proc)))
979          (ignored nil)
980          eol line parsed)
981     (save-match-data
982       (while (setq eol (string-match "\n" unparsed))
983
984         ;; Somewhere around ircd 2.8.16.0, server messages start coming in
985         ;; with a C-m (ascii 13, carriage return) at the end.
986         ;; (Incidentally, that is the correct thing to do; all textually
987         ;; based network protocols should use CRLF rather than just LF, for
988         ;; the sake of consistency.  --friedman)
989         (if (= (aref unparsed (1- eol)) ?\C-m)
990             (setq line (substring unparsed 0 (1- eol)))
991           (setq line (substring unparsed 0 eol)))
992         (setq unparsed (substring unparsed (1+ eol)))
993         (cond
994          ((zenirc-ignore-p line)
995           (and zenirc-debug-ignore
996                (zenirc-message proc 'debug (concat "Ignored: " line))
997                (setq ignored t)))
998          (t
999           (let* ((parsed (zenirc-parse-server-message line))
1000                  (hook-name (concat "zenirc-server-" (aref parsed 0) "-hook"))
1001                  (hook (intern-soft hook-name)))
1002             (cond
1003              (zenirc-debug-mainloop
1004               (zenirc-message proc 'debug (concat "Hook: " hook-name))
1005               (zenirc-message proc 'debug
1006                               (concat "Parsed: "
1007                                       (prin1-to-string parsed)))))
1008
1009             (zenirc-timer-handler proc)
1010             (if (and hook (boundp hook))
1011                 (zenirc-run-hook hook proc parsed)
1012               (zenirc-message proc 'server line))
1013             (if (and (not ignored)
1014                      (zenirc-signal-p line))
1015                 (zenirc-run-hook 'zenirc-signal-hook proc parsed))))))
1016       ;; return the unprocessed partial line, if any.
1017       unparsed)))
1018 \f
1019 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1020 ;;; utility subroutines
1021 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1022
1023 ;; Returns a string indicating emacs variant.
1024 (defun zenirc-emacs-variant ()
1025   (let ((case-fold-search t)
1026         (alist '(("^Nemacs\\b"   . "Nemacs")
1027                  ("^Epoch\\b"    . "Epoch")
1028                  ("\\bXEmacs\\b" . "XEmacs")
1029                  ("\\bLucid\\b"  . "Lucid Emacs")
1030                  ("^GNU Emacs"   . "GNU Emacs")))
1031         (version (cond
1032                   ((fboundp 'nemacs-version)
1033                    (nemacs-version))
1034                   (t
1035                    (emacs-version))))
1036         result)
1037     (save-match-data
1038       (while alist
1039         (cond
1040          ((string-match (car (car alist)) version)
1041           (setq result (cdr (car alist)))
1042           (setq alist nil))
1043          (t
1044           (setq alist (cdr alist))))))
1045     result))
1046
1047 ;; Update the modeline, or whatever it takes to actually update the modeline
1048 ;; depending on which version of Emacs we're using.
1049 ;;
1050 ;; ``Consistency is the last refuge of the unimaginative'' 
1051 ;;              -- Oscar Wilde
1052 ;;
1053 (defun zenirc-update-modeline ()
1054   (let ((version (emacs-version)))
1055     (cond ((string-match "Emacs 19" version)
1056            (force-mode-line-update))
1057           ((string-match "XEmacs" version)
1058            (redraw-modeline))
1059           (t
1060            (redraw-display)))))
1061
1062 (defun zenirc-match-string (n &optional s)
1063   "Return string matched by last search.
1064 N specifies the nth parenthesized expression in the last regexp.
1065 N=0 means the entire text matched by the whole regexp or whole string.
1066 S should be given if the last search was by `string-match' on string S.
1067
1068 Return value is nil if there is no Nth match."
1069   (and (match-beginning n)
1070        (if s
1071            (substring s (match-beginning n) (match-end n))
1072          (buffer-substring (match-beginning n) (match-end n)))))
1073
1074 (defun zenirc-string-match-list (msg regexp-list)
1075   (let ((match-data (match-data))
1076         (found nil))
1077     (while (and (not found) regexp-list)
1078       (setq found (string-match (car regexp-list) msg))
1079       (setq regexp-list (cdr regexp-list)))
1080     (or found
1081         (store-match-data match-data))
1082     found))
1083
1084 ;; t if we are at the beginning of the input area
1085 (defun zenirc-beginning-of-input-p (&optional proc)
1086   (or proc
1087       (setq proc (get-buffer-process (current-buffer))))
1088   ;; Note you can compare markers and positions safely; `=' looks at the
1089   ;; marker's position.
1090   (= (point) zenirc-process-mark))
1091
1092 ;; t if point is in the "input area" (i.e. beyond the process mark)
1093 (defun zenirc-in-input-p ()
1094   ;; Note you can compare markers and positions safely; `=' looks at the
1095   ;; marker's position.
1096   (>= (point) zenirc-process-mark))
1097
1098 ;; return t if arg is a channel name, else nil
1099 (defun zenirc-channel-p (arg)
1100   (memq (aref arg 0) '(?# ?& ?+)))
1101
1102 ;; ignore processing - msg is a server message sent to the client.
1103 ;; Return non-nil if it is to be ignored, nil if it is not to be ignored.
1104 (defun zenirc-ignore-p (msg)
1105   (zenirc-string-match-list msg zenirc-ignore-list))
1106
1107 ;; Return t if both names are equivalent, ignoring differences in case.
1108 ;; This uses zenirc-downcase-name to handle weird chars.
1109 ;; 
1110 ;; This function is used to check whether a given nickname matches a
1111 ;; nickname fed to us by the server. As the function is used to check
1112 ;; this on recieved PRIVMSGs and NOTICEs we also need to check if the
1113 ;; sending side used one of the more obscure addressing schemes:
1114 ;;      nickname@servername
1115 ;;      username%hostname
1116 ;; As @ and % are illegal characters in a nickname, we can safely
1117 ;; check if n1 contains one of them to see if the recieved string
1118 ;; matches whatever the server thinks we are. --pp
1119 ;;
1120 ;; Because of the fact mentioned above we need to define what n1 and
1121 ;; n2 should be. I hereby declare that n1 is whatever the server has
1122 ;; fed us and n2 is our own given string. This only needs to be true
1123 ;; when the optional argument "recieving-privmsg" is set, but it
1124 ;; should be the standard way to address the function. --pp
1125 (defun zenirc-names-equal-p (n1 n2 &optional recieving-privmsg)
1126   ;; I (Noah) have checked the emacs source code, and the size of strings
1127   ;; is stored in the Lisp_Object structure, so it can be referenced in
1128   ;; constant time.  Checking size first avoids the need for extra string
1129   ;; consing and regexp searching in zenirc-downcase-name if we know the
1130   ;; names can't possibly be equal.
1131   (or
1132    (and (= (length n1) (length n2))
1133         (string= (zenirc-downcase-name n1) (zenirc-downcase-name n2)))
1134    (and recieving-privmsg
1135         (or (string-match "@" n1)
1136             (string-match "%" n1)))))
1137     
1138 ;  (and (= (length n1) (length n2))
1139 ;       (string= (zenirc-downcase-name n1) (zenirc-downcase-name n2))))
1140
1141 ;; RFC1459 says that, because of IRC's scandanavian origin, the
1142 ;; characters {}| are considered to be the lower case equivalents of the
1143 ;; characters []\, respectively.  This is a critical issue when determining
1144 ;; the equivalence of two nicknames or channel names.
1145 (defun zenirc-downcase-name (s)
1146   (setq s (downcase s))
1147   (let ((c '((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|)))
1148         (p 0))
1149     (save-match-data
1150       (while (string-match "[][\\]" s p)
1151         (aset s (match-beginning 0)
1152               (cdr (assq (aref s (match-beginning 0)) c)))
1153         (setq p (match-end 0)))))
1154   s)
1155
1156 ;; determine if an event is worthy of a signal
1157 (defun zenirc-signal-p (msg)
1158   (zenirc-string-match-list msg zenirc-signal-list))
1159
1160 ;; returns nil if nick is actually a server name.
1161 (defun zenirc-extract-nick (nickuserhost)
1162   (save-match-data
1163     (cond ((string-match "[!.]" nickuserhost)
1164            (if (= (aref nickuserhost (match-beginning 0)) ?.)
1165                nil
1166              (substring nickuserhost 0 (match-beginning 0))))
1167           (t nickuserhost))))
1168
1169 (defun zenirc-extract-userhost (nickuserhost)
1170   (save-match-data
1171     (and (string-match "!" nickuserhost)
1172          (substring nickuserhost (match-end 0)))))
1173
1174 (defun zenirc-extract-host (nickuserhost)
1175   (save-match-data
1176     (and (string-match "@" nickuserhost)
1177          (substring nickuserhost (match-end 0)))))
1178
1179 ;; Parse a line into its constituent parts (words separated by
1180 ;; whitespace).  Return a list of the words.
1181 (defun zenirc-parse-words (line)
1182   (let ((list '())
1183         (posn 0))
1184     (save-match-data
1185       (while (string-match "[^ \t\n]+" line posn)
1186         (setq list (cons (zenirc-match-string 0 line) list))
1187         (setq posn (match-end 0))))
1188     (nreverse list)))
1189
1190 ;; Parse the first n words in line, returning a list consisting of each
1191 ;; word, plus any remaining portion of the string.
1192 (defun zenirc-parse-n-words (n line)
1193   (let ((i 0)
1194         (len (length line))
1195         (posn 0)
1196         (result nil))
1197     (save-match-data
1198       (while (and (< i n)
1199                   (string-match "[^ \t\n]+" line posn))
1200         (setq result (cons (zenirc-match-string 0 line) result))
1201         (setq posn (match-end 0))
1202         (setq i (1+ i)))
1203       (and (string-match "[ \t\n]+" line posn)
1204            (setq posn (match-end 0)))
1205       (and (< posn len)
1206            (setq result (cons (substring line posn) result)))
1207       (nreverse result))))
1208
1209 ;; parse a line into the first word and the rest.
1210 ;;
1211 ;; This returns ("word" . "rest"), where word means adjacent non-space
1212 ;; characters. Any amount of whitespace is skipped after the first word,
1213 ;; and "rest" is the rest of the line. If there is no "rest", a "rest"
1214 ;;  of "" is constructed.
1215 (defun zenirc-parse-firstword (str)
1216   (let ((cell (cons nil nil)))
1217     (save-match-data
1218       (cond ((string-match "[^ \t\n]+" str)
1219              (setcar cell (zenirc-match-string 0 str))
1220              (if (string-match "[^ \t\n]+" str (match-end 0))
1221                  (setcdr cell (substring str (match-beginning 0)))
1222                (setcdr cell ""))
1223              cell)))))
1224
1225 ;; parse a server message into the zenirc-message-vector
1226 ;; the result looks like ["msgtype" "sender" "to" "arg1" ... "argn"]
1227 (defun zenirc-parse-server-message (string)
1228   (save-match-data
1229     (let ((posn (if (eq (aref string 0) ?:)
1230                     (string-match " " string)
1231                   0))
1232           (msg zenirc-message-vector)
1233           (n 2))
1234       (fillarray msg nil)
1235
1236       (aset msg 1 (if (eq posn 0)
1237                       (or zenirc-current-server-name zenirc-server)
1238                     (substring string 1 posn)))
1239
1240       (aset msg 0 (let* ((bposn (string-match "[^ ]" string posn))
1241                          (eposn (string-match " " string bposn)))
1242                     (setq posn (and eposn
1243                                     (string-match "[^ ]" string eposn)))
1244                     (substring string bposn eposn)))
1245
1246       (while (and posn
1247                   (not (eq (aref string posn) ?:)))
1248         (aset msg n (let* ((bposn posn)
1249                            (eposn (string-match " " string bposn)))
1250                       (setq posn (and eposn
1251                                       (string-match "[^ ]" string eposn)))
1252                       (substring string bposn eposn)))
1253         (setq n (1+ n)))
1254       (if posn
1255           (aset msg n (substring string (1+ posn))))
1256       msg)))
1257
1258 ;; Try matching msg in regexp-list.
1259 ;; If no match is found, preserve old match data and return nil.
1260 ;; Otherwise, return value of successful string-match and leave modified
1261 ;; match-data intact.
1262 ;; do a signal (pop up buffer, beep, whatever)
1263 (defun zenirc-signal (proc msg)
1264   (cond ((and proc-window
1265               (pos-visible-in-window-p zenirc-process-mark proc-window)
1266               (not (string-equal zenirc-beep-on-signal 'always))))
1267         (t
1268          (and zenirc-beep-on-signal (ding t))
1269          (zenirc-message nil 'signal (buffer-name)))))
1270
1271 (defun zenirc-message (proc-or-buffer string &rest args)
1272   (let ((proc nil)
1273         (buffer nil)
1274         (sym nil))
1275
1276     (cond ((processp proc-or-buffer)
1277            (setq buffer (process-buffer proc-or-buffer))
1278            (setq proc proc-or-buffer))
1279           ((or (bufferp proc-or-buffer)
1280                (stringp proc-or-buffer))
1281            (setq buffer (get-buffer proc-or-buffer))
1282            (setq proc (get-buffer-process buffer))))
1283
1284     (cond
1285      ((symbolp string)
1286       (setq sym string)
1287       (setq string (zenirc-lang-retrieve-catalog-entry string))))
1288     (and args
1289          (if string
1290              (setq string (apply 'format string args))
1291            (setq string (format "[raw] %s" args))))
1292     (cond
1293      ((null proc-or-buffer)
1294       (message "%s" string))
1295      (t
1296       (setq string (concat string "\n"))
1297       (let ((orig-buffer (current-buffer))
1298             region-begin
1299             window
1300             window-point
1301             current-point-mark)
1302         (unwind-protect
1303             (progn
1304               (set-buffer buffer)
1305               (setq window (get-buffer-window buffer))
1306               (setq region-begin (marker-position zenirc-process-mark))
1307               (setq current-point-mark (point-marker))
1308
1309               ;; If process mark is at window start, insert-before-markers
1310               ;; will insert text off-window since it's also inserting before
1311               ;; the start window mark.  Preserve window start's point in
1312               ;; that case.
1313               (and window
1314                    (= zenirc-process-mark (window-start window))
1315                    (setq window-point region-begin))
1316
1317               (goto-char zenirc-process-mark)
1318               (insert-before-markers string)
1319               (goto-char region-begin)
1320               (while (search-forward "\C-m" zenirc-process-mark t)
1321                 (delete-char -1))
1322               (and zenirc-message-hook
1323                    (save-restriction
1324                      (narrow-to-region region-begin zenirc-process-mark)
1325                      (zenirc-run-hook 'zenirc-message-hook proc sym string)))
1326               (goto-char current-point-mark)
1327               (and window-point
1328                    (set-window-start window window-point 'noforce)))
1329           (set-buffer orig-buffer)))))))
1330
1331 ;; Insert the string "(sent to foo)" for arbitrary foo in the zenirc buffer.
1332 ;; This might be a useful thing to put in your zenirc-command-msg-hook.
1333 ;; `data' is either a simple string or a parsed message list.  The
1334 ;; structure of a partially-parsed message differs a little; the rest of
1335 ;; the string is directly in the cdr, instead of each substring being in
1336 ;; its own cons.  --friedman
1337 (defun zenirc-display-recipient-confirmation (proc data &optional n)
1338   (or n (setq n 1))
1339   (let ((to (cond
1340              ((stringp data)
1341               data)
1342              ((and (consp data)
1343                    (consp (cdr data))
1344                    (> (length data) 1))
1345               (car (cdr data)))
1346              ((listp data)
1347               (car (zenirc-parse-firstword (cdr data))))
1348              ((signal 'wrong-type-argument (list 'string-or-list-p data))))))
1349     (if (string-equal 'message zenirc-send-confirmation)
1350         (setq proc nil))
1351     (if (> n 1)
1352         (zenirc-message proc 'send-multi to n)
1353       (zenirc-message proc 'send to))))
1354
1355 ;; Handle a zenirc / command typed by the user.  Check to see if there's a
1356 ;; hook for the command and if so, execute the hook, otherwise just send the
1357 ;; command line unaltered to the server.
1358 (defun zenirc-do-command (proc cmdline)
1359   (let* ((parsedcmd (zenirc-parse-firstword cmdline))
1360          (cmdname (car parsedcmd))
1361          (hook-name (concat "zenirc-command-" cmdname "-hook"))
1362          (hook (intern-soft hook-name)))
1363     (cond
1364      (zenirc-debug-commands
1365       (zenirc-message proc 'debug (concat "Hook: " hook-name))
1366       (zenirc-message proc 'debug
1367                       (concat "Parsed: " (prin1-to-string parsedcmd)))))
1368     ;; Call the hook, if it's bound and non-nil.
1369     ;; Otherwise, just send the unparsed command to the server.
1370     (if (and hook
1371              (boundp hook)
1372              (symbol-value hook))
1373         (zenirc-run-hook hook proc parsedcmd)
1374       (process-send-string proc (concat cmdline "\n")))))
1375
1376 (defun zenirc-send-line ()
1377   "Send current line to IRC server."
1378   (interactive)
1379   (cond
1380    ((zenirc-in-input-p)
1381     (end-of-line)
1382     (let* ((proc (get-buffer-process (current-buffer)))
1383            (input-start (copy-marker zenirc-process-mark))
1384            (input-end (point))
1385            (string (buffer-substring input-start input-end))
1386            (posn 0))
1387       (if (= (point) (point-max))
1388           (insert "\n")
1389         ;; skip over line already present
1390         (goto-char (1+ (point))))
1391       (set-marker zenirc-process-mark (point))
1392       (zenirc-timer-handler proc)
1393       (save-match-data
1394         (cond
1395          ;; Ignore lines composed only of whitespace
1396          ((not (string-match "\\`\\s-*\\'" string))
1397           ;; convert newlines in input to spaces (decimal ascii 32)
1398           (while (string-match "\n" string posn)
1399             (aset string (match-beginning 0) 32)
1400             (setq posn (match-end 0)))
1401           ;; Remove preceding whitespaces, if user wants us to.
1402           (if (and zenirc-delete-preceding-whitespaces
1403                    (string-match (concat "^\\( \\)*"
1404                                          (char-to-string zenirc-command-char))
1405                                  string))
1406               (setq string 
1407                     (substring string (string-match "[^ ]" string))))
1408           ;; Run this hook after string has been formatted, but before
1409           ;; invoking any hooks since they may do unpredictable things like
1410           ;; change the current buffer.
1411           (zenirc-run-hook 'zenirc-send-line-hook
1412                            input-start input-end string)
1413           (cond ((= (aref string 0) zenirc-command-char)
1414                  (zenirc-do-command proc (substring string 1)))
1415                 ((string= zenirc-current-victim nil)
1416                  (zenirc-message proc 'nosend))
1417                 (t
1418                  (let ((n (zenirc-send-multi-line
1419                            proc
1420                            (concat "PRIVMSG " zenirc-current-victim)
1421                            string)))
1422                    (zenirc-run-hook 'zenirc-send-confirmation-privmsg-hook
1423                                     proc 'send-multi 'send
1424                                     zenirc-current-victim n)))))))))
1425    (t
1426     (goto-char (point-max)))))
1427
1428 ;; Returns the number of chunks required to send the message
1429 (defun zenirc-send-multi-line (proc prefix string)
1430   (let* ((maxlen (- zenirc-message-length-limit
1431                     (length prefix)
1432                     ;; when the server sends your message, it prepends a
1433                     ;; string of the form ":nick!user@host "
1434                     ;; Plus we add a newline and a separator ourselves.
1435                     (length zenirc-nick)
1436                     (length zenirc-user-login-name)
1437                     (length (system-name))
1438                     ;;(length ": !@ :\r\n")
1439                     8))
1440          (strlen (length string))
1441          (posn 0)
1442          (n 0)
1443          (count 0))
1444     (while (< posn strlen)
1445       (setq n (min maxlen (- strlen posn)))
1446       (process-send-string
1447          proc (concat prefix " :" (substring string posn (+ posn n)) "\r\n"))
1448       (setq posn (+ posn n))
1449       (setq count (1+ count)))
1450     count))
1451
1452 ;; This is the default action for most zenirc-send-confirmation-FOO-hooks.
1453 (defun zenirc-send-confirmation-generic (proc multi single to n)
1454   (if zenirc-send-confirmation
1455       (progn
1456         (and (string-equal 'message zenirc-send-confirmation)
1457              (setq proc nil))
1458         (let ((msg (if (> n 1) multi single)))
1459           (zenirc-message proc msg to n)))))
1460
1461 ;; Delete a cell from a list, case-insensitively.
1462 (defun zenirc-delete-case-insensitive (elt list)
1463   "Delete by side effect any occurrences of ELT as a member of LIST.
1464 The modified LIST is returned.  Comparison is done with `equal'.
1465 If the first member of LIST is ELT, deleting it is not a side effect;
1466 it is simply using a different list.
1467 Therefore, write `(setq foo (delete element foo))'
1468 to be sure of changing the value of `foo'.
1469
1470 This function compares things case-insensitively (according to RFC1459)."
1471   (let ((p list)
1472         (l (cdr list)))
1473     (while l
1474       (if (equal (zenirc-downcase-name elt) (zenirc-downcase-name (car l)))
1475           (setcdr p (cdr l))
1476         (setq p (cdr p)))
1477       (setq l (cdr l))))
1478   (if (equal (zenirc-downcase-name elt) (zenirc-downcase-name (car list)))
1479       (cdr list)
1480     list))
1481
1482 \f
1483 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1484 ;;;
1485 ;;; ZenIRC message catalogs
1486 ;;;
1487 ;;;      "Hello, hello, obarrayter?"
1488 ;;;      "This is the obarrayter."
1489 ;;;      "Could you please call an internist?"
1490 ;;;      "What's the problem, sir?"
1491 ;;;      "Oh, just some bad hash.  But I'd like to consult a professional
1492 ;;;       just to be safe."
1493 ;;;      "I understand, sir."
1494 ;;;      ...dum dee dum...
1495 ;;;      'Tis a gift to be symbol
1496 ;;;      'tis a gift to be freed...
1497 ;;;                -- Karl Fogel
1498 ;;;
1499 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1500
1501 (defvar zenirc-lang-catalogs (make-vector 13 0)
1502   "Obarray used to store message for all languages, indexed by symbol.")
1503
1504 ;; 211 buckets should be more than enough for message catalogs (remember to
1505 ;; use a prime number to get good hashing characteristics).
1506 ;; This is not the total number of messages you can store, but just the number
1507 ;; of "buckets" in which they can go.  Even if the catalog eventually
1508 ;; contains more entries than this, it isn't really necessary to increase
1509 ;; the size of this table.  Note that right now, there are about 175
1510 ;; messages in the english catalog with a few extra libraries loaded.
1511 (defconst zenirc-lang-obarray-size 211
1512   "*The default hash table size for newly created message catalogs")
1513
1514 (defvar zenirc-lang-current-language 'english
1515   "Current language in use in zenirc.")
1516
1517 ;; This works on existing catalogs, but will overwrite any entry already in
1518 ;; the catalog.
1519 (defun zenirc-lang-define-catalog (lang alist)
1520   (let* ((catalog-name (if (stringp lang)
1521                            lang
1522                          (symbol-name lang)))
1523          (catalog-sym (intern catalog-name zenirc-lang-catalogs))
1524          catalog)
1525
1526     (or (boundp catalog-sym)
1527         (set catalog-sym (make-vector zenirc-lang-obarray-size 0)))
1528     (setq catalog (symbol-value catalog-sym))
1529
1530     (while alist
1531       (set (intern (symbol-name (car (car alist))) catalog) (cdr (car alist)))
1532       (setq alist (cdr alist)))))
1533
1534 ;; This creates a new catalog if none exists for the language specified.
1535 ;; It is more efficient to use zenirc-lang-define-catalog if defining many
1536 ;; entries at once.
1537 (defun zenirc-lang-store-catalog-entry (sym str lang)
1538   (or lang (setq lang zenirc-lang-current-language))
1539   (let* ((catalog-name (if (stringp lang)
1540                            lang
1541                          (symbol-name lang)))
1542          (sym-name (if (stringp sym)
1543                        sym
1544                      (symbol-name sym)))
1545          (catalog-sym (intern catalog-name zenirc-lang-catalogs)))
1546     (or (boundp catalog-sym)
1547         (set catalog-sym (make-vector zenirc-lang-obarray-size 0)))
1548     (set (intern sym-name (symbol-value catalog-sym)) str)))
1549
1550 ;; This returns nil for any undefined entry type, or if there is no
1551 ;; catalog for the language specified.
1552 (defun zenirc-lang-retrieve-catalog-entry (sym &optional lang)
1553   (if (not lang) (setq lang zenirc-lang-current-language))
1554   (or (zenirc-lang-retrieve-catalog-entry-1 sym lang)
1555       ;; For now, if a message entry isn't defined for the
1556       ;; current language, default to english.  There are
1557       ;; many new message types and the other catalogs
1558       ;; aren't completely up to date.
1559       (and (not (string-equal lang 'english))
1560            (zenirc-lang-retrieve-catalog-entry-1 sym 'english))))
1561
1562 (defun zenirc-lang-retrieve-catalog-entry-1 (sym lang)
1563   (or lang (setq lang zenirc-lang-current-language))
1564   (let* ((catalog-name (if (stringp lang)
1565                            lang
1566                          (symbol-name lang)))
1567          (catalog-sym (intern-soft catalog-name zenirc-lang-catalogs))
1568          catalog
1569          (sym-name (if (stringp sym)
1570                        sym
1571                      (symbol-name sym)))
1572          msg-sym)
1573     (cond ((or (null catalog-sym)
1574                (not (boundp catalog-sym)))
1575            nil)
1576           (t
1577            (setq catalog (symbol-value catalog-sym))
1578            (setq msg-sym (intern-soft sym-name catalog))
1579            (and msg-sym
1580                 (boundp msg-sym)
1581                 (symbol-value msg-sym))))))
1582
1583 ;; If called interactively and language is undefined, signal an error.
1584 (defun zenirc-lang-set-current-language (lang)
1585   (interactive (list (completing-read "Switch to language: "
1586                                       zenirc-lang-catalogs 'boundp t)))
1587   (let* ((name (if (stringp lang)
1588                    lang
1589                  (symbol-name lang)))
1590          (catalog (intern-soft name zenirc-lang-catalogs)))
1591
1592     (cond ((and catalog (boundp catalog))
1593            ;; Set the current language to a symbol interned in the global
1594            ;; obarray.  This makes it more convenient to compare against
1595            ;; other symbols with eq.
1596            (setq zenirc-lang-current-language (intern name))
1597            (zenirc-message (current-buffer) 'newcatalog name))
1598           (t
1599            (zenirc-message (current-buffer) 'nocatalog name)
1600            nil))))
1601
1602 \f
1603 ;; English is the default catalog.  Other catalogs are available in
1604 ;; separate files.
1605 (defun zenirc-lang-define-english-catalog ()
1606   (zenirc-lang-define-catalog 'english
1607     '((s001 . "[info] You are wasting time.")
1608       (s002 . "[info] Your IRC server is %s running ircd version %s")
1609       (s003 . "[info] This server was created %s")
1610       (s200 . "[info] %s (%s) Link -> %s") ; Version reply from /trace
1611       (s201 . "[info] %s Try  -> %s")
1612       (s202 . "[info] %s H.S. -> %s")
1613       (s203 . "[info] %s Hmmm -> IP address: %s") ; Unknown connection
1614       (s204 . "[info] %s Oper -> %s") ; Operator connection
1615       (s205 . "[info] %s User -> %s") ; User connection
1616       (s206 . "[info] %s Serv -> %s %s %s %s ") ; Server connection
1617       (s208 . "[info] %s %s -> %s") ; New type connection
1618       (s209 . "[info] %s Clas -> %s = %s") ; What the classes means
1619       (s211 . "[info] %s link up %s sec\nSent: %s/%s, Rcvd: %s/%s, SendQ: %s")
1620       (s212 . "[info] %s\t->\ttimes: %s\tbytes: %s") ; Command stats
1621       (s213 . "[info] C hst/nme/prt/cls: %s/%s/%s/%s")      ; C-lines
1622       (s214 . "[info] N hst/nme/prt/cls: %s/%s/%s/%s") ; N-lines
1623       (s215 . "[info] %s host/name/class:\t%s/%s/%s") ; I-lines
1624       (s216 . "[info] K host/username:\t%s/%s") ; K-lines
1625       (s217 . "[info] Q %s/%s/%s/%s/%s") ; Q-lines
1626       (s218 . "[info] Class: %s Ping freq: %s Conn.freq: %s Max Links: %s Sendq: %s") ; Y-lines
1627       (s219 . "[info] End of /stats.")
1628       (s221 . "[info] Your current user mode is: %s")
1629       (s241 . "[info] LEAF hostmask/depth:\t\t%s/%s") ; L-lines
1630       (s242 . "[info] %s") ; Uptime of server
1631       ;; O-lines and o-lines; the latter are for local ops
1632       (s243 . "[info] %s nickname/user@host:\t%s/%s")
1633       (s244 . "[info] HUB  hostmask/servername:\t%s/%s") ; H-lines
1634       (s249 . "[info] %s; %s") ; /stats Z info.
1635       (s251 . "[info] There are %s/%s visible/invisible users on %s servers.")
1636       (s251-29 . "[info] There are %s users and %s services on %s servers.")
1637       (s252 . "[info] There are %s major dweebs online.")
1638       (s253 . "[info] There are %s unknown connections.")
1639       (s254 . "[info] There are %s channels")
1640       (s255 . "[info] There are %s clients and %s servers connected to this server")
1641       (s255-29 . "[info] There are %s clients, %s services and %s servers connected to this server")
1642       (s256 . "[info] Administrative information for %s:") ; /admin line 1
1643       (s257 . "[info] %s") ; /admin line 2
1644       (s258 . "[info] %s") ; /admin line 3
1645       (s259 . "[info] %s") ; /admin line 4
1646       (s261 . "[info] %s File -> %s %s") ; Logfile trace
1647       (s262 . "[info] %s Vers -> %s")
1648       (s301 . "[info] %s is away: %s")
1649       (s302 . "[info] userhost: %s") ; userhost reply
1650       (s303 . "[info] Currently wasting time: %s") ; ison reply
1651       (s305 . "[info] You are no longer away")
1652       (s306 . "[info] You are away")
1653       (s311 . "[info] %s (%s@%s) is %s") ; user part of /whois list
1654       (s312 . "[info] %s iswas using server %s (%s)")
1655       (s313 . "[info] %s is a major dweeb.") ; /whois operator status
1656       (s314 . "[info] %s (%s@%s) was %s") ; user part of /whowas list
1657       (s315 . "[info] End of /who.")
1658       (s317 . "[info] %s has been idle %s") ; /whois idle time
1659       (s318 . "[info] End of /whois.")
1660       (s319 . "[info] %s is on: %s") ; channel part of whois data
1661       (s321 . "[info] Channel         Users Topic") ; header for LIST cmd
1662       (s322 . "[info] %-15s %-5s %s")  ; each channel in LIST cmd
1663       (s323 . "[info] End of /list.")  ; trailer for LIST cmd
1664       (s324 . "[info] Mode for %s is %s %s") ; channel mode
1665       (s331 . "[info] %s has no topic") ; no topic message
1666       (s332 . "[info] %s topic: %s")   ; topic message
1667       (s333 . "[info] %s topic set by %s at %s") ; topic set time
1668       (s341 . "[info] You are inviting %s to %s") ; invite reply
1669       (s342 . "[info] You are asking %s to waste time") ; summon reply
1670       (s351 . "[info] Version: %s %s %s") ; version reply
1671       (s352_header . "[info] Nickname  Stat Name of Channel User@host (Hop count  Name)") ; header for /who list reply
1672       (s352 . "[info] %-9s %-3s  %-15s %s@%s (%s)") ; /who list reply
1673       (s353 . "[info] Users on %s: %s") ; displayed after channel join
1674       (s364 . "[info] %s %s %s")       ; /links reply
1675       (s365 . "[info] end of /links")  ; end of /links reply
1676       (s367 . "[info] %s ban %s")      ; banlist reply
1677       (s368 . "[info] end of banlist") ; end of banlist reply
1678       (s371 . "[info] %s")             ; info reply
1679       (s372 . "[motd] %s")              ; message of the day
1680       (s375 . "[motd] Message Of The Day:") ; start of motd
1681       (s376 . "[motd] End of motd")    ; displayed at end of motd
1682       (s381 . "[info] You are now a major dweeb") ; irc op status
1683       (s382 . "[info] Rehashing: %s")  ; rehash server msg
1684       (s391 . "[info] Time for server %s: %s") ; TIME reply
1685       (s392 . "[info] Userid   Terminal  Host") ; header for users rpl
1686       (s393 . "[info] %s")             ; body of users rpl
1687       (s395 . "[info] Nobody logged on") ; nobody for users rpl
1688       (s401 . "[info] No such nick/channel: %s") ; there is no such nick/chan
1689       (s402 . "[info] No such nick/server: %s") ; there is no such server
1690       (s403 . "[info] No such channel: %s") ; there is no such channel
1691       (s404 . "[info] You cannot send to %s.") ; you can't send to channel
1692       (s405 . "[info] Too many channels: %s") ; too many channels
1693       (s406 . "[info] Server has no record of nickname: %s") ; no whowas data
1694       (s407 . "[info] Duplicate recipients. No message sent: %s") ; user@host
1695       (s409 . "[info] No origin specified.") ; ping error reply
1696       (s411 . "[info] No recipient given.") ; no recipient given
1697       (s412 . "[info] No text to send.") ; you didn't send anything.
1698       (s413 . "[info] No toplevel domain: %s") ; no toplevel domain spec
1699       (s414 . "[info] Wildcard in toplevel domain: %s") ; wild toplevel
1700       (s415 . "[info] Bad server/host mask: %s") ; wild toplevel
1701       (s421 . "[info] This looks like spam to me: %s") ; you sent server spam
1702       (s422 . "[info] No motd (flame major dweeb listed in /admin)")
1703       (s423 . "[info] No admin info.  Ignorant major dweeb running server.")
1704       (s431 . "[info] No nickname given") ; you didn't provide a nick
1705       (s432 . "[info] Invalid nickname: %s")
1706       (s433 . "[info] Nickname already in use: %s")
1707       (s436 . "[info] Nick collision kill: %s")
1708       (s437 . "[info] Nick/channel temporarily unavailable: %s")
1709       (s441 . "[info] %s is not on %s") ; can't do it to those not present
1710       (s442 . "[info] You are not on %s.") ; you can't do that dave.
1711       (s443 . "[info] %s is already on channel %s.") ; invite error
1712       (s444 . "[info] %s is not logged in") ; SUMMON reply
1713       (s445 . "[info] Some major dweeb won't let you do summon")
1714       (s446 . "[info] Some major dweeb won't let you do /users")
1715       (s451 . "[info] You have not registered") ; gotta do the USER NICK thing
1716       (s461 . "[info] Not enough parameters: %s") ; as 421
1717       (s462 . "[info] You may not reregister") ; cannot USER twice
1718       (s463 . "[info] Some fascist major dweeb will not let you connect")
1719       (s464 . "[info] Password is incorrect") ; bad PASS command
1720       (s465 . "[info] You are not allowed to use this server.") ; creep
1721       (s467 . "[info] Key for %s is already set.") ; chan key set already
1722       (s471 . "[info] Cannot join %s (user limit reached).") ; too many ppl
1723       (s472 . "[info] %s is an unknown mode character.") ; duh
1724       (s473 . "[info] Cannot join %s (invite only).") ; fascist nerds
1725       (s474 . "[info] Cannot join %s (ban).") ; you're banned
1726       (s475 . "[info] Cannot join %s (channel key).") ; bad key
1727       (s477 . "[info] Channel %s doesn't support modes.")
1728       (s481 . "[info] You are not a big enough dweeb to do that.") ; oper only
1729       (s482 . "[info] You are not a powermonger for %s.") ; chanop needed
1730       (s483 . "[info] Duh.  You cannot kill a server") ; can't kill a server
1731       (s491 . "[info] No major dweebs allowed from your host") ; no o-line
1732       (s501 . "[info] Unknown user mode flag") ; you did something silly
1733       (s502 . "[info] Cannot change mode for other users") ; as above
1734       (action . "(sent to %s)") ; ctcp action sent
1735       (connect-failed . "[error] Couldn't connect to %s port %d, reason: %s")
1736       (connect-try . "[info] Connecting to %s port %d...")
1737       (connect-abort . "[info] Aborted attempt to connect to an irc server.")
1738       (ctcp_action . "[action->%s] %s %s") ; ctcp ACTION display
1739       (ctcp_action_nochannel . "[action] %s %s")
1740       (ctcp_clientinfo . "[query] CLIENTINFO from %s to %s")
1741       (ctcp_echo . "[query] ECHO from %s to %s containing: %s")
1742       (ctcp_errmsg . "[query] ERRMSG from %s to %s")
1743       (ctcp_finger . "[query] FINGER from %s to %s")
1744       (ctcp_ping . "[query] PING from %s to %s")
1745       (ctcp_ping_reply . "[reply] PING: %s is %s seconds away")
1746       (ctcp_source . "[query] SOURCE from %s to %s")
1747       (ctcp_time . "[query] TIME from %s to %s")
1748       (ctcp_userinfo . "[query] USERINFO from %s to %s")
1749       (ctcp_version . "[query] VERSION from %s to %s")
1750       (debug  . "[debug] %s")          ; displayed by debugging code
1751       (error . "[%s] %s")              ; server error message
1752       (invite . "[info] %s invites you to %s.") ; invite
1753       (join_you . "[info] Joining channel: %s")
1754       (join . "[info] %s has joined %s")
1755       (join_mode . "[info] %s joined %s (+%s).")
1756       (kick . "[info] %s has been kicked from %s by %s") ; someone was peeved
1757       (kick_you . "[info] You have been kicked from %s by %s") ; loser
1758       (kill . "[info] You have been killed: %s") ; your time is up.
1759       (mode . "[info] %s has changed mode for %s: %s") ; MODE change
1760       (nick . "[info] %s has changed nick to %s") ; nick change
1761       (newcatalog . "[info] Current message catalog set to %s")
1762       (nocatalog . "[error] No message catalog defined for %s")
1763       (nosend . "[info] you have no current victim to send to") ; msg not sent
1764       (notice . "{%s%s} %s")           ; NOTICE
1765       (notice_nochannel . "{%s} %s")           ; NOTICE
1766       (notice_you . "{%s} %s")         ; NOTICE sent to your nick
1767       (now_querying . "[info] Current victim is %s.") ; /query foo
1768       (part_you . "[info] Leaving: %s (%s)") ; your part from channel message
1769       (part . "[info] %s has left %s (%s)") ; part from channel message
1770       (pong . "[info] %s says ojnk.")  ; pong message from server
1771       (privmsg . "<%s%s> %s")          ; PRIVMSG
1772       (privmsg_nochannel . "<%s> %s")          ; PRIVMSG
1773       (privmsg_you . "*%s* %s")        ; PRIVMSG sent to your nick
1774       (protocol_violation . "[error] The following line is in violation of the IRC protocol.\n[error] Please tell the server administrator:\n%s: %s")
1775       (query . "[query] from %s to %s content %s") ; ctcp query
1776       (query_unknown . "is an unknown CTCP query")
1777       (query_unbalanced . "[UNBALANCED query] from %s to %s content %s")
1778       (query_unbalanced_reply . "is an unbalanced CTCP query")
1779       (quit . "[info] %s stopped wasting time: %s") ; user signoff
1780       (reply . "[reply] from %s to %s content %s") ; ctcp reply
1781       (reply_unbalanced . "[UNBALANCED reply] from %s to %s content %s")
1782       (send . "(sent to %s)") ; you sent a message/notice
1783       (send-multi . "(sent to %s in %d parts)") ; sent a long message/notice
1784       (sentinel . "\nZenIRC ended at %s") ; process sentinel message
1785       (server . "[server] %s")         ; unknown server message
1786       (signal . "[signal in %s]")        ; signal in echo area
1787       (topic . "[info] %s changed the topic on %s to: %s") ; topic message
1788       (wallops . "-%s- %s")            ; WALLOPS notice
1789      )))
1790
1791 \f
1792 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1793 ;;;
1794 ;;; ZenIRC hook handling functions
1795 ;;;
1796 ;;; ZenIRC uses a somewhat nonstandard hook mechanism. Hook symbols
1797 ;;; are manipulated with zenirc-add-hook and zenirc-delete-hook, and
1798 ;;; are executed with zenirc-run-hook. A hook symbol is a list of
1799 ;;; symbols that are function names. When a hook is run with
1800 ;;; zenirc-run-hook, each symbol in the list is run in turn - unless
1801 ;;; one of the hooks sets the variable zenirc-run-next-hook to nil. In
1802 ;;; this case, zenirc-run-hook immediatelly returns to the caller.
1803 ;;; Unlike emacs 19 hooks, ZenIRC hooks are called with arguments.
1804 ;;; ZenIRC hooks return the value of the last hook run.
1805 ;;;
1806 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1807
1808 (defun zenirc-run-hook (hooksym &rest args)
1809   "Take hook name HOOKSYM and run it, passing optional args ARGS.
1810 HOOKSYM should be a symbol, a hook variable.
1811 If the hook symbol has a non-nil value, that value may be a function
1812 or a list of functions to be called to run the hook.
1813 If the value is a function, it is called with args ARGS.
1814 If it is a list, the elements are called, in order, with ARGS, if
1815 zenirc-run-next-hook is t (the default). Otherwise, the hooks after
1816 the one that set zenirc-run-next-hook are not called, and control is
1817 returned to the caller. (zenirc-run-hook) returns the value returned
1818 from the last hook run."
1819       (let ((zenirc-run-next-hook t)
1820             (result))
1821         (and (boundp hooksym)
1822              (symbol-value hooksym)
1823              (let ((value (symbol-value hooksym)))
1824                (if (and (listp value)
1825                         (not (eq (car value) 'lambda)))
1826                    (while (and value zenirc-run-next-hook)
1827                      (setq result (apply (car value) args))
1828                      (setq value (cdr value)))
1829                  (setq result (apply value args)))))
1830         result))
1831
1832 (defun zenirc-add-hook (hook function &optional append)
1833   "Add to the value of HOOK the function FUNCTION.
1834 FUNCTION is not added if already present.
1835 FUNCTION is added (if necessary) at the beginning of the hook list
1836 unless the optional argument APPEND is non-nil, in which case
1837 FUNCTION is added at the end.
1838
1839 HOOK should be a symbol, and FUNCTION may be any valid function.  If
1840 HOOK is void, it is first set to nil.  If HOOK's value is a single
1841 function, it is changed to a list of functions."
1842   (or (boundp hook) (set hook nil))
1843   ;; If the hook value is a single function, turn it into a list.
1844   (let ((old (symbol-value hook)))
1845     (if (or (not (listp old)) (eq (car old) 'lambda))
1846         (set hook (list old))))
1847   (or (if (consp function)
1848           (member function (symbol-value hook))
1849         (memq function (symbol-value hook)))
1850       (set hook
1851            (if append
1852                (nconc (symbol-value hook) (list function))
1853              (cons function (symbol-value hook))))))
1854
1855 (defun zenirc-remove-hook (hook function)
1856   "Remove from the value of HOOK the function FUNCTION.
1857 HOOK should be a symbol, and FUNCTION may be any valid function.  If
1858 FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
1859 list of hooks to run in HOOK, then nothing is done.  See `add-hook'."
1860   (if (or (not (boundp hook))           ;unbound symbol, or
1861           (null (symbol-value hook))    ;value is nil, or
1862           (null function))              ;function is nil, then
1863       nil                               ;Do nothing.
1864     (let ((hook-value (symbol-value hook)))
1865       (if (consp hook-value)
1866           (setq hook-value (delete function hook-value))
1867         (if (equal hook-value function)
1868             (setq hook-value nil)))
1869       (set hook hook-value))))
1870
1871 (fset 'zenirc-delete-hook 'zenirc-remove-hook)
1872
1873 \f
1874 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1875 ;;; ZenIRC time handling functions
1876 ;;;
1877 ;;; These functions are used to implement time handling in ZenIRC.
1878 ;;; Much of this code was lifted from the Kiwi 4.30 irc client.
1879 ;;;
1880 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1881
1882 (defun zenirc-time-to-int (timestr)
1883   "Convert from time in string format as returned by current-time-string
1884 to a double integer format, as returned by file-attributes.
1885
1886 Written by Stephen Ma <ma_s@maths.su.oz.au>"
1887   (let* ((norm+ '(lambda (num1 num2)
1888                   (let ((sumh (+ (car num1) (car num2)))
1889                         (suml (+ (car (cdr num1)) (car (cdr num2)))))
1890                     (list (+ sumh (/ suml 65536)) (% suml 65536)))))
1891          (norm* '(lambda (num1 num2)
1892                   (let ((prodh (* num1 (car num2)))
1893                         (prodl (* num1 (car (cdr num2)))))
1894                     (list (+ prodh (/ prodl 65536)) (% prodl 65536)))))
1895          (seconds (string-to-int (substring timestr 17 19)))
1896          (minutes (string-to-int (substring timestr 14 16)))
1897          (hours (string-to-int (substring timestr 11 13)))
1898          (partdays (1- (string-to-int (substring timestr 8 10))))
1899          (years (string-to-int (substring timestr 20 24)))
1900          (days (+ partdays
1901                   (cond ((and (= (% years 4) 0)
1902                               (/= (% years 100) 0))
1903                          (cdr (assoc (substring timestr 4 7)
1904                                      '(("Jan" . 0)
1905                                        ("Feb" . 31)
1906                                        ("Mar" . 60)
1907                                        ("Apr" . 91)
1908                                        ("May" . 121)
1909                                        ("Jun" . 152)
1910                                        ("Jul" . 182)
1911                                        ("Aug" . 213)
1912                                        ("Sep" . 244)
1913                                        ("Oct" . 274)
1914                                        ("Nov" . 305)
1915                                        ("Dec" . 335)))))
1916                         (t (cdr (assoc (substring timestr 4 7)
1917                                        '(("Jan" . 0)
1918                                          ("Feb" . 31)
1919                                          ("Mar" . 59)
1920                                          ("Apr" . 90)
1921                                          ("May" . 120)
1922                                          ("Jun" . 151)
1923                                          ("Jul" . 181)
1924                                          ("Aug" . 212)
1925                                          ("Sep" . 243)
1926                                          ("Oct" . 273)
1927                                          ("Nov" . 304)
1928                                          ("Dec" . 334))))))
1929                   (* (- years 1970) 365)
1930                   (/ (- years 1969) 4)
1931                   (- (/ (- years 1901) 100)))))
1932     (funcall norm+
1933              (funcall norm*
1934                       60
1935                       (funcall norm+
1936                                (funcall norm*
1937                                         60
1938                                         (funcall norm+
1939                                                  (funcall norm*
1940                                                           24
1941                                                           (list 0 days))
1942                                                  (list 0 hours)))
1943                                (list 0 minutes)))
1944              (list 0 seconds))))
1945
1946 (defun zenirc-time= (a b)
1947   "Compare two times, and return true if they are equal."
1948   (and (= (nth 0 a) (nth 0 b))
1949        (= (nth 1 a) (nth 1 b))))
1950
1951 (defun zenirc-time< (a b)
1952   "Compare two times, and return t if the first is earlier than the second."
1953   (or (< (nth 0 a) (nth 0 b))
1954       (and (= (nth 0 a) (nth 0 b))
1955            (< (nth 1 a) (nth 1 b)))))
1956
1957 (defun zenirc-time-diff (a b)
1958   "Return the difference between two times. This function requires
1959 the second argument to be earlier in time than the first argument."
1960   (cond ((= (nth 0 a) (nth 0 b)) (list 0 (- (nth 1 a) (nth 1  b))))
1961         ((> (nth 1 b) (nth 1 a)) (list (- (nth 0 a) (nth 0 b) 1)
1962                                        (- (+ 65536 (nth 1 a)) (nth 1 b))))
1963         (t (list (- (nth 0 a) (nth 0 b))
1964                  (- (nth 1 a) (nth 1 b))))))
1965
1966 ;; Convert a number of seconds since the epoch (in ASCII) into an
1967 ;; ASCII string representing the time.
1968 (defun zenirc-epoch-seconds-to-time (seconds)
1969   (save-match-data
1970     (let (millions units high low)
1971       (if (string-match "^\\(.*\\)\\(......\\)$" seconds)
1972           (setq millions (string-to-int (substring seconds
1973                                                    (match-beginning 1)
1974                                                    (match-end 1)))
1975                 units (string-to-int (substring seconds
1976                                                 (match-beginning 2)
1977                                                 (match-end 2))))
1978         (setq millions 0
1979               units (string-to-int seconds)))
1980       (setq high (+ (* millions 15) (/ (* millions 265) 1024) (/ units 65536))
1981             low (+ (% (+ (* (% millions 4) 16384) (* millions 576)) 65536)
1982                    (% units 65536)))
1983       (if (> low 65535)
1984           (setq low (- low 65536)
1985                 high (1+ high)))
1986       (list high low))))
1987
1988 (defun zenirc-timer-handler (proc)
1989   "Call zenirc-timer-hook as often as possible. The maximum delay between
1990 calls of zenirc-timer-hook is how often a server pings the client."
1991   (let ((now (zenirc-time-to-int (current-time-string))))
1992     (if (zenirc-time< '(0 0) (zenirc-time-diff now zenirc-time-last-event))
1993         (progn
1994           (and zenirc-debug-timer
1995                (zenirc-message proc
1996                                "[debug] timer: %s\n" (current-time-string)))
1997           (zenirc-run-hook 'zenirc-timer-hook proc now)
1998           (setq zenirc-time-last-event now)))))
1999 \f
2000 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2001 ;;; command handling subroutines
2002 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2003
2004 (defun zenirc-insert-at-proc-mark (&rest args)
2005     (cond ((= (point) zenirc-process-mark)
2006            (apply 'insert args))
2007           (t
2008            (let ((point (point-marker)))
2009              (goto-char zenirc-process-mark)
2010              (apply 'insert args)
2011              (goto-char point)))))
2012
2013 (defun zenirc-send-privmsg-last-rec ()
2014   (interactive)
2015   (zenirc-insert-at-proc-mark (concat (char-to-string zenirc-command-char) 
2016                                       "msg ") zenirc-privmsg-last-rec " "))
2017
2018 (defun zenirc-send-privmsg-last-sent ()
2019   (interactive)
2020   (zenirc-insert-at-proc-mark (concat (char-to-string zenirc-command-char) 
2021                                       "msg ") zenirc-privmsg-last-sent " "))
2022
2023 (defun zenirc-self-insert-or-send-privmsg-last-rec ()
2024   (interactive)
2025   (if (zenirc-beginning-of-input-p)
2026       (zenirc-send-privmsg-last-rec)
2027     (if (string-match "XEmacs" emacs-version)
2028         (insert last-command-char)
2029       (insert (this-command-keys)))))
2030
2031 (defun zenirc-self-insert-or-send-privmsg-last-sent ()
2032   (interactive)
2033   (if (zenirc-beginning-of-input-p)
2034       (zenirc-send-privmsg-last-sent)
2035     (if (string-match "XEmacs" emacs-version)
2036         (insert last-command-char)
2037       (insert (this-command-keys)))))
2038
2039 ;; change zenirc-current-victim by toggling between all channels in
2040 ;; zenirc-channel-list, original code by <vuori@sci.fi>
2041 (defun zenirc-toggle-channel ()
2042   (interactive)
2043   (let ((list zenirc-channel-list)
2044         (orig-victim zenirc-current-victim))
2045     (while list
2046       (if (string-equal (zenirc-downcase-name zenirc-current-victim) 
2047                         (car list))
2048           ; this is the current victim cell of the list
2049           (if (cdr list)
2050               ; it's not the last cell
2051               (setq zenirc-current-victim (or (car (cdr list))
2052                                               zenirc-current-victim)
2053                     list nil)
2054             ; it is the last cell, use the first cell
2055             (setq zenirc-current-victim (car zenirc-channel-list))))
2056       (setq list (cdr list)))
2057     ; if the victim wasn't in the zenirc-channel-list, default to
2058     ; first cell of zenirc-channel-list
2059     (if (string-equal orig-victim zenirc-current-victim)
2060         (setq zenirc-current-victim (car zenirc-channel-list)))
2061     (zenirc-update-modeline)))
2062     
2063 ;; /action victim text
2064 ;; send a ctcp action to the specified victim
2065 (defun zenirc-command-action (proc parsed)
2066   (let* ((l (zenirc-parse-firstword (cdr parsed)))
2067          (n (zenirc-send-multi-line proc
2068                                    (concat "PRIVMSG " (car l))
2069                                    (concat "\^AACTION " (cdr l) "\^A"))))
2070     (zenirc-run-hook 'zenirc-send-confirmation-me-hook
2071                      proc 'send-multi 'send (car l) n)))
2072
2073 ;; /away [message]
2074 ;; set your away message (or remove it if not present)
2075 (defun zenirc-command-away (proc parsedcmd)
2076   (process-send-string proc (concat "AWAY :" (cdr parsedcmd) "\n")))
2077
2078 ;; /command-char command-char
2079 ;; No string does nothing.
2080 (defun zenirc-command-command-char (proc parsedcmd)
2081   (if (not (string= "" (cdr parsedcmd)))
2082            (setq zenirc-command-char (string-to-char (cdr parsedcmd)))))
2083
2084 ;; /ctcp victim query [text]
2085 ;; does the ^A ctcp things and uppercases the argument.
2086 (defun zenirc-command-ctcp (proc parsedcmd)
2087   (let* ((parsedarg (zenirc-parse-firstword (cdr parsedcmd)))
2088          (argument (zenirc-parse-firstword (cdr parsedarg))))
2089     (process-send-string
2090      proc
2091      (concat "PRIVMSG "
2092              (car parsedarg)
2093              " :\C-a"
2094              (upcase (car argument))
2095              (if (not (string-equal "" (cdr argument)))
2096                  " ")
2097              (cdr argument)
2098              "\C-a\n"))))
2099
2100 ;; /kick nick #channel [reason]
2101 (defun zenirc-command-kick (proc parsedcmd)
2102   (let* ((l (zenirc-parse-n-words 2 (cdr parsedcmd)))
2103          (n (length l))
2104          (v [nil nil "KICK %s %s\n" "KICK %s %s :%s\n"]))
2105     (cond ((< n 2)
2106            ;; Invalid format for command
2107            (zenirc-message proc 's421
2108                            (format "/%s %s" (car parsedcmd) (cdr parsedcmd))))
2109           (t
2110            (process-send-string proc (apply 'format (aref v n) l))))))
2111
2112 ;; /kill nick reason
2113 (defun zenirc-command-kill (proc parsedcmd)
2114   (let* ((l (zenirc-parse-n-words 1 (cdr parsedcmd)))
2115          (n (length l))
2116          (v [nil "KILL %s\n" "KILL %s :%s\n"]))
2117     (cond ((< n 1)
2118            ;; Invalid format for command
2119            (zenirc-message proc 's421
2120                            (format "/%s %s" (car parsedcmd) (cdr parsedcmd))))
2121           (t
2122            (process-send-string proc (apply 'format (aref v n) l))))))
2123
2124 ;; /language [lang]
2125 ;; switches message catalogs
2126 ;; note that you must have the catalog in question loaded already, before
2127 ;; you can switch to it.
2128 (defun zenirc-command-language (proc parsedcmd)
2129   (let ((lang (car (zenirc-parse-firstword (cdr parsedcmd)))))
2130     (zenirc-lang-set-current-language lang)))
2131
2132 ;; /m victim message
2133 ;; send a message to someone who is not the current victim
2134 (defun zenirc-command-m (proc parsedmsg)
2135   (zenirc-command-privmsg proc parsedmsg))
2136
2137 ;; /me message
2138 ;; send a ctcp action to the current victim
2139 (defun zenirc-command-me (proc parsed)
2140   (let ((n (zenirc-send-multi-line proc
2141                                    (concat "PRIVMSG " zenirc-current-victim)
2142                                    (concat "\^AACTION " (cdr parsed) "\^A"))))
2143     (zenirc-run-hook 'zenirc-send-confirmation-me-hook
2144                      proc 'send-multi 'send
2145                      zenirc-current-victim n)))
2146
2147 ;; /msg victim message
2148 ;; send a message to someone who is not the current victim
2149 (defun zenirc-command-msg (proc parsedmsg)
2150   (zenirc-command-privmsg proc parsedmsg))
2151
2152 ;; /oper handler
2153 ;;
2154 ;; Always remember, the lame deserve to lose.
2155 ;;
2156 ;; I did not add this, but neither do I have any intention of removing it.
2157 ;; --friedman
2158 ;; Neither have I, removing this would be like removing the spirit of ZenIRC.
2159 ;; --pp
2160 (defun zenirc-command-oper (proc parsedmsg)
2161   (process-send-string proc (concat "QUIT :" (cdr parsedmsg) "\n")))
2162
2163 ;; /notice nick message
2164 (defun zenirc-command-notice (proc parsedmsg)
2165   (let* ((pair (zenirc-parse-firstword (cdr parsedmsg)))
2166          (n (zenirc-send-multi-line proc
2167                                     (concat "NOTICE " (car pair))
2168                                     (cdr pair))))
2169     (setq zenirc-privmsg-last-sent (car pair))
2170     (zenirc-run-hook 'zenirc-send-confirmation-notice-hook
2171                      proc 'send-multi 'send (car pair) n)))
2172
2173 ;; /part channel [message]
2174 ;; exit channel, displaying optional message
2175 (defun zenirc-command-part (proc parsedcmd)
2176   (let* ((parsedtext (zenirc-parse-firstword (cdr parsedcmd))))
2177     (if (not (string= (cdr parsedtext) ""))
2178         (process-send-string proc (concat "PART " (car parsedtext)
2179                                           " :" (cdr parsedtext) "\n"))
2180       (process-send-string proc (concat 
2181                                  "PART " (car parsedtext) 
2182                                  " :Started wasting time elsewhere\n")))))
2183
2184 ;; /ping victim
2185 ;; TODO: Rewrite this code.
2186 (defun zenirc-command-ping (proc parsedmsg)
2187   (process-send-string
2188    proc
2189    (concat "PRIVMSG " (cdr parsedmsg) " :\C-aPING "
2190            (car (cdr (zenirc-time-to-int (current-time-string)))) "\C-a\n")))
2191
2192 ;; /privmsg victim message
2193 (defun zenirc-command-privmsg (proc parsedmsg)
2194   (let* ((pair (zenirc-parse-firstword (cdr parsedmsg)))
2195          (n (zenirc-send-multi-line proc
2196                                     (concat "PRIVMSG " (car pair))
2197                                     (cdr pair))))
2198     (setq zenirc-privmsg-last-sent (car pair))
2199     (zenirc-run-hook 'zenirc-send-confirmation-privmsg-hook
2200                      proc 'send-multi 'send (car pair) n)))
2201
2202 ;; /query [victim]
2203 ;; If we gave it an argument, set zenirc-current-victim to that arg.
2204 ;; If not, just display what zenirc-current-victim is.
2205 (defun zenirc-command-query (proc parsedmsg)
2206   (if (not (string= (cdr parsedmsg) ""))
2207       (setq zenirc-current-victim
2208             (car (zenirc-parse-firstword (cdr parsedmsg))))
2209     ;; no arguments, just display who we're querying.
2210     (zenirc-message proc 'now_querying zenirc-current-victim))
2211   (zenirc-update-modeline))
2212
2213 ;; /quit [message]
2214 ;; exit irc, displaying optional message
2215 (defun zenirc-command-quit (proc parsedcmd)
2216   (if (string= "" (cdr parsedcmd))
2217       (process-send-string proc "QUIT :Started wasting time elsewhere\n")
2218     (process-send-string proc (concat "QUIT :" (cdr parsedcmd) "\n"))))
2219
2220 ;; /quote [raw irc command]
2221 ;;
2222 ;; send raw text to irc server
2223 (defun zenirc-command-quote (proc parsedcmd)
2224   (process-send-string proc (concat (cdr parsedcmd) "\n")))
2225
2226 ;; /server [server [port [nickname]]]
2227 (defun zenirc-command-server (proc parsedcmd)
2228   (if (string= "" (cdr parsedcmd))
2229       (zenirc-select)
2230     (let* ((parsedarg (cdr parsedcmd)))
2231       (zenirc-select (car (zenirc-parse-n-words 1 parsedarg))
2232                      (or (car (cdr (zenirc-parse-n-words 2 parsedarg)))
2233                          zenirc-port)
2234                      (or (car (cdr (cdr  (zenirc-parse-n-words 3 parsedarg))))
2235                          zenirc-nick)))))
2236
2237 ;; /squit server [reason]
2238 (defun zenirc-command-squit (proc parsedcmd)
2239   (let* ((l (zenirc-parse-n-words 1 (cdr parsedcmd)))
2240          (n (length l))
2241          (v [nil "SQUIT %s\n" "SQUIT %s :%s\n"]))
2242     (cond ((< n 1)
2243            ;; Invalid format for command
2244            (zenirc-message proc 's421
2245                            (format "/%s %s" (car parsedcmd) (cdr parsedcmd))))
2246           (t
2247            (process-send-string proc (apply 'format (aref v n) l))))))
2248
2249 ;; /topic channel [topic_string]
2250 ;;
2251 ;; set the topic of a channel to `topic string'
2252 (defun zenirc-command-topic (proc parsedcmd)
2253   (let* ((parsedtext (zenirc-parse-firstword (cdr parsedcmd))))
2254     (if (not (string= (cdr parsedtext) ""))
2255         (process-send-string proc (concat "TOPIC " (car parsedtext)
2256                                           " :" (cdr parsedtext) "\n"))
2257       (process-send-string proc (concat "TOPIC " (car parsedtext) "\n")))))
2258
2259 \f
2260 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2261 ;;; server message handling subroutines
2262 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2263
2264 ;; handle ERROR server message
2265 (defun zenirc-server-ERROR (proc parsedmsg)
2266   (zenirc-message proc 'error (aref parsedmsg 1) (aref parsedmsg 2)))
2267
2268 ;; INVITE - user invites you to channel
2269 (defun zenirc-server-INVITE (proc parsedmsg)
2270   (zenirc-message proc 'invite
2271                   (zenirc-run-hook 'zenirc-format-nickuserhost-hook
2272                                    (aref parsedmsg 1))
2273                   (aref parsedmsg 3)))
2274
2275 ;; NICK change server message
2276 (defun zenirc-server-NICK (proc parsedmsg)
2277   (let ((from (aref parsedmsg 1))
2278         (to (aref parsedmsg 2)))
2279     (and (zenirc-names-equal-p (zenirc-extract-nick from) zenirc-nick)
2280          (progn
2281            (setq zenirc-nick to)
2282            (force-mode-line-update)))
2283     (zenirc-message proc 'nick
2284                     (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
2285                     to)))
2286
2287 ;; NOTICE server message
2288 (defun zenirc-server-NOTICE (proc parsedmsg)
2289   (zenirc-privmsg-or-notice proc parsedmsg))
2290
2291 ;; JOIN server message
2292 ;; zenirc-current-victim is the current channel your msgs will go to.
2293 (defun zenirc-server-JOIN (proc parsedmsg)
2294   (let ((who (aref parsedmsg 1))
2295         (channel (aref parsedmsg 2))
2296         (mode nil))
2297     (if (zenirc-names-equal-p (zenirc-extract-nick who) zenirc-nick)
2298         (progn
2299           (setq zenirc-current-victim (aref parsedmsg 2))
2300           (setq zenirc-channel-list (cons (zenirc-downcase-name 
2301                                            (aref parsedmsg 2))
2302                                           zenirc-channel-list))
2303           (zenirc-update-modeline)
2304           (zenirc-message proc 'join_you zenirc-current-victim))
2305       
2306       (if (string-match "\a" channel) ; <dl> are people stupid or what?
2307           (setq channel (substring (aref parsedmsg 2) 0 (- (match-end 0) 1))
2308                 mode (substring (aref parsedmsg 2) (match-end 0)
2309                                 (length (aref parsedmsg 2)))))
2310       (if mode
2311           (zenirc-message proc 'join_mode
2312                           (zenirc-run-hook 'zenirc-format-nickuserhost-hook
2313                                            who) channel mode)
2314         (zenirc-message proc 'join
2315                         (zenirc-run-hook 'zenirc-format-nickuserhost-hook who)
2316                         channel)))))
2317
2318 ;; KICK - you have been removed from a channel
2319 ;; (KICK kicker #chan kickee [reason])
2320 (defun zenirc-server-KICK (proc parsedmsg)
2321   (if (not (zenirc-names-equal-p (aref parsedmsg 3) zenirc-nick))
2322       ;; someone else got kicked
2323       (zenirc-message proc 'kick
2324                       (aref parsedmsg 3)
2325                       (aref parsedmsg 2)
2326                       (format "%s - %s"
2327                               (zenirc-run-hook 'zenirc-format-nickuserhost-hook
2328                                                (aref parsedmsg 1))
2329                               (aref parsedmsg 4)))
2330     ;; you got kicked
2331     (zenirc-message proc 'kick_you
2332                     (aref parsedmsg 2)
2333                     (format "%s - %s"
2334                             (zenirc-extract-nick (aref parsedmsg 1))
2335                             (aref parsedmsg 4)))
2336     (if (zenirc-names-equal-p (aref parsedmsg 2) zenirc-current-victim)
2337         (setq zenirc-current-victim nil))))
2338
2339 ;; KILL - you have been killed
2340 (defun zenirc-server-KILL (proc parsedmsg)
2341   (zenirc-message proc 'kill (aref parsedmsg 3)))
2342
2343 ;; MODE - channel or user mode change
2344 ;;
2345 ;; MODE from <channel> {[+|-]|o|p|s|i|t|n|b|v} [<limit>] [<user>] [<ban mask>]
2346 ;; MODE from <nickname> {[+|-]|i|w|s|o}
2347 ;;
2348 ;; Sum of channel `b' and `o' mode changes <= 3, so at most 5 args appear
2349 ;; after the the channel mode flags (three `b' or `o's, a `k', and an `l').
2350 ;; Current actual server implementation seems to limit this to 4 args.
2351 (defun zenirc-server-MODE (proc parsedmsg)
2352   (zenirc-message proc 'mode
2353                   (zenirc-run-hook 'zenirc-format-nickuserhost-hook
2354                                    (aref parsedmsg 1))
2355                   (aref parsedmsg 2)
2356                   (format "%s %s %s %s %s %s"
2357                           (or (aref parsedmsg 3) "")
2358                           (or (aref parsedmsg 4) "")
2359                           (or (aref parsedmsg 5) "")
2360                           (or (aref parsedmsg 6) "")
2361                           (or (aref parsedmsg 7) "")
2362                           (or (aref parsedmsg 8) ""))))
2363
2364 ;; PART - channel leave message
2365 (defun zenirc-server-PART (proc parsedmsg)
2366   (let ((channel (aref parsedmsg 2))
2367         (who (aref parsedmsg 1))
2368         ; As of ircd 2.9.1, you can send comments in your PART
2369         ; message just like with QUIT. Thanks to this you can
2370         ; always manage to get the last word in a serious
2371         ; discussion.
2372         ;
2373         ; :Omnion!~pp@sno.pp.se PART #twilight_zone :grow up, piker
2374         (reason (or (aref parsedmsg 3)
2375                     ; on a 2.8 PART message, use nickname as comment
2376                     (zenirc-extract-nick (aref parsedmsg 1)))))
2377     (if (zenirc-names-equal-p (zenirc-extract-nick who) zenirc-nick)
2378         (progn
2379           (zenirc-message proc 'part_you channel reason)
2380           (setq zenirc-channel-list (delete (zenirc-downcase-name channel)
2381                                             zenirc-channel-list))
2382           (and zenirc-current-victim
2383               (zenirc-names-equal-p channel zenirc-current-victim)
2384               (setq zenirc-current-victim (car zenirc-channel-list))))
2385       (zenirc-message proc 'part
2386                       (zenirc-run-hook 'zenirc-format-nickuserhost-hook who)
2387                       channel reason))))
2388
2389 ;; PONG - server "is alive" message
2390 (defun zenirc-server-PONG (proc parsedmsg)
2391   (zenirc-message proc 'pong (aref parsedmsg 1)))
2392
2393 ;; PING - server "are you alive" message
2394 (defun zenirc-server-PING (proc parsedmsg)
2395   (process-send-string proc (concat "PONG " (aref parsedmsg 2) "\n")))
2396
2397 ;; PRIVMSG server message
2398 (defun zenirc-server-PRIVMSG (proc parsedmsg)
2399   (zenirc-privmsg-or-notice proc parsedmsg))
2400
2401 ;; QUIT - someone (thankfully) left irc.
2402 (defun zenirc-server-QUIT (proc parsedmsg)
2403   (zenirc-message proc 'quit
2404                   (zenirc-run-hook 'zenirc-format-nickuserhost-hook
2405                                    (aref parsedmsg 1))
2406                   (aref parsedmsg 2)))
2407
2408 ;; TOPIC - someone set the topic on a channel
2409 (defun zenirc-server-TOPIC (proc parsedmsg)
2410   (zenirc-message proc 'topic
2411                   (zenirc-run-hook 'zenirc-format-nickuserhost-hook
2412                                    (aref parsedmsg 1))
2413                   (aref parsedmsg 2)
2414                   (aref parsedmsg 3)))
2415
2416 ;; WALLOPS - notice to operators
2417 (defun zenirc-server-WALLOPS (proc parsedmsg)
2418   (zenirc-message proc 'wallops (aref parsedmsg 1) (aref parsedmsg 2)))
2419
2420 ;; 001 - welcome to irc
2421 (defun zenirc-server-001 (proc parsedmsg)
2422   (setq zenirc-nick (aref parsedmsg 2))
2423   (zenirc-message proc 's001))
2424
2425 ;; 002 - who is your server
2426 ;; hostname regexp [-a-zA-Z.0-9]
2427 (defun zenirc-server-002 (proc parsedmsg)
2428   (let ((str (aref parsedmsg 3)))
2429     (if (string-match
2430          "Your host is \\([-a-zA-Z.0-9]+\\), running version \\(.*\\)"
2431          str)
2432         (zenirc-message proc 's002
2433                         (zenirc-match-string 1 str)
2434                         (zenirc-match-string 2 str))
2435       (zenirc-message proc 'protocol_violation
2436                       (aref parsedmsg 1)
2437                       (aref parsedmsg 3)))))
2438
2439 ;; 003 - when this server was built
2440 (defun zenirc-server-003 (proc parsedmsg)
2441   (let ((str (aref parsedmsg 3)))
2442     (if (string-match "This server was created \\(.*\\)" str)
2443         (zenirc-message proc 's003 (zenirc-match-string 1 str))
2444       (zenirc-message proc 'protocol_violation
2445                       (aref parsedmsg 1)
2446                       (aref parsedmsg 3)))))
2447
2448 ;; 004 - version and allowed modes information
2449 (defun zenirc-server-004 (proc parsedmsg)
2450   (setq zenirc-current-server-name (aref parsedmsg 3))
2451   (setq zenirc-server-version (aref parsedmsg 4))
2452   (setq zenirc-user-modes (aref parsedmsg 5))
2453   (setq zenirc-server-modes (aref parsedmsg 6)))
2454
2455 ;; 200 RPL_TRACELINK - {<server>} Link -> Version: <version>
2456 ;; 200 RPL_TRACELINK - {<server>} (version) Link to: -> <server>
2457 (defun zenirc-server-200 (proc parsedmsg)
2458   (zenirc-message proc 's200
2459                   (aref parsedmsg 1)
2460                   (aref parsedmsg 4)
2461                   (aref parsedmsg 6)))
2462
2463 ;; 201 RPL_TRACECONNECTING
2464 (defun zenirc-server-201 (proc parsedmsg)
2465   (zenirc-message proc 's201 (aref parsedmsg 1) (aref parsedmsg 5)))
2466
2467 ;; 202 RPL_TRACEHANDSHAKE
2468 (defun zenirc-server-202 (proc parsedmsg)
2469   (zenirc-message proc 's202 (aref parsedmsg 1) (aref parsedmsg 5)))
2470
2471 ;; 203 RPL_TRACEUNKNOWN - {<server>} Unknown -> IP address : <ip#>
2472 (defun zenirc-server-203 (proc parsedmsg)
2473   (zenirc-message proc 's203 (aref parsedmsg 1) (aref parsedmsg 5)))
2474
2475 ;; 204 RPL_TRACEOPERATOR {<server>} Oper -> <nick[host]>
2476 (defun zenirc-server-204 (proc parsedmsg)
2477   (zenirc-message proc 's204 (aref parsedmsg 1) (aref parsedmsg 5)))
2478
2479 ;; 205 RPL_TRACEUSER {<server>} Luser -> <nick[host]>
2480 (defun zenirc-server-205 (proc parsedmsg)
2481   (zenirc-message proc 's205 (aref parsedmsg 1) (aref parsedmsg 5)))
2482
2483 ;; 206 RPL_TRACESERVER {<server>} Server -> <server> Class: <#> S: <#> C: <#>
2484 (defun zenirc-server-206 (proc parsedmsg)
2485   (zenirc-message proc 's206
2486                   (aref parsedmsg 1)
2487                   (aref parsedmsg 4)
2488                   (aref parsedmsg 5)
2489                   (aref parsedmsg 6)
2490                   (aref parsedmsg 7)))
2491
2492 ;; 208 RPL_TRACENEWTYPE
2493 (defun zenirc-server-208 (proc parsedmsg)
2494   (zenirc-message proc 's208
2495                   (aref parsedmsg 1)
2496                   (aref parsedmsg 3)
2497                   (aref parsedmsg 5)))
2498
2499 ;; 209 RPL_TRACECLASS {<server}> Class -> type = blah
2500 (defun zenirc-server-209 (proc parsedmsg)
2501   (zenirc-message proc 's209
2502                   (aref parsedmsg 1)
2503                   (aref parsedmsg 4)
2504                   (aref parsedmsg 5)))
2505
2506 ;; 211 RPL_STATLINKINFO
2507 (defun zenirc-server-211 (proc parsedmsg)
2508   (zenirc-message proc 's211
2509                   (aref parsedmsg 3)
2510                   (aref parsedmsg 9)
2511                   (aref parsedmsg 5)
2512                   (aref parsedmsg 6)
2513                   (aref parsedmsg 7)
2514                   (aref parsedmsg 8)
2515                   (aref parsedmsg 4)))
2516
2517 ;; 212 RPL_STATSCOMMANDS
2518 (defun zenirc-server-212 (proc parsedmsg)
2519   (zenirc-message proc 's212
2520                   (aref parsedmsg 3)
2521                   (aref parsedmsg 4)
2522                   (aref parsedmsg 5)))
2523
2524 ;; 213 RPL_STATSCLINE
2525 (defun zenirc-server-213 (proc parsedmsg)
2526   (zenirc-message proc 's213
2527                   (aref parsedmsg 4)
2528                   (aref parsedmsg 6)
2529                   (aref parsedmsg 7)
2530                   (aref parsedmsg 8)))
2531
2532 ;; 214 RPL_STATSNLINE
2533 (defun zenirc-server-214 (proc parsedmsg)
2534   (zenirc-message proc 's214
2535                   (aref parsedmsg 4)
2536                   (aref parsedmsg 6)
2537                   (aref parsedmsg 7)
2538                   (aref parsedmsg 8)))
2539
2540 ;; 215 RPL_STATSILINE
2541 (defun zenirc-server-215 (proc parsedmsg)
2542   (zenirc-message proc 's215
2543                   (aref parsedmsg 3)
2544                   (aref parsedmsg 4)
2545                   (aref parsedmsg 6)
2546                   (aref parsedmsg 8)))
2547
2548 ;; 216 RPL_STATSKLINE
2549 (defun zenirc-server-216 (proc parsedmsg)
2550   (zenirc-message proc 's216 (aref parsedmsg 4) (aref parsedmsg 6)))
2551
2552 ;; 217 RPL_STATSQLINE
2553 (defun zenirc-server-217 (proc parsedmsg)
2554   (zenirc-message proc 's217
2555                   (aref parsedmsg 4)
2556                   (aref parsedmsg 5)
2557                   (aref parsedmsg 6)
2558                   (aref parsedmsg 7)
2559                   (aref parsedmsg 8)))
2560
2561 ;; 218 RPL_STATSYLINE
2562 (defun zenirc-server-218 (proc parsedmsg)
2563   (zenirc-message proc 's218
2564                   (aref parsedmsg 4)
2565                   (aref parsedmsg 5)
2566                   (aref parsedmsg 6)
2567                   (aref parsedmsg 7)
2568                   (aref parsedmsg 8)))
2569
2570 ;; 219 RPL_ENDOFSTATS
2571 (defun zenirc-server-219 (proc parsedmsg)
2572   (zenirc-message proc 's219))
2573
2574 ;; 221 RPL_UMODEIS
2575 (defun zenirc-server-221 (proc parsedmsg)
2576   (zenirc-message proc 's221 (aref parsedmsg 3)))
2577
2578 ;; 241 RPL_STATSLLINE
2579 (defun zenirc-server-241 (proc parsedmsg)
2580   (zenirc-message proc 's241 (aref parsedmsg 4) (aref parsedmsg 6)))
2581
2582 ;; 242 RPL_STATSUPTIME
2583 (defun zenirc-server-242 (proc parsedmsg)
2584   (zenirc-message proc 's242 (aref parsedmsg 3)))
2585
2586 ;; 243 RPL_STATSOLINE
2587 (defun zenirc-server-243 (proc parsedmsg)
2588   (zenirc-message proc 's243
2589                   (aref parsedmsg 3)
2590                   (aref parsedmsg 6)
2591                   (aref parsedmsg 4)))
2592
2593 ;; 244 RPL_STATSHLINE
2594 (defun zenirc-server-244 (proc parsedmsg)
2595   (zenirc-message proc 's244 (aref parsedmsg 4) (aref parsedmsg 6)))
2596
2597 ;; 249 RPL_STATSZLINE
2598 (defun zenirc-server-249 (proc parsedmsg)
2599   (zenirc-message proc 's249 (aref parsedmsg 1) (aref parsedmsg 3)))
2600
2601 ;; 251 - :server 251 ZenIRC :There are x users and y invisible on z servers
2602 ;;       :server 251 ZenIRC :There are x users and y services on z servers
2603 (defun zenirc-server-251 (proc parsedmsg)
2604   (let ((str (aref parsedmsg 3)))
2605     (if (string-match "There are \\([0-9]+\\) users and \\([0-9]+\\) invisible on \\([0-9]+\\) servers" str)
2606         (zenirc-message proc 's251
2607                         (zenirc-match-string 1 str)
2608                         (zenirc-match-string 2 str)
2609                         (zenirc-match-string 3 str))
2610       (if (string-match "There are \\([0-9]+\\) users and \\([0-9]+\\) services on \\([0-9]+\\) servers" str)
2611           (zenirc-message proc 's251-29
2612                           (zenirc-match-string 1 str)
2613                           (zenirc-match-string 2 str)
2614                           (zenirc-match-string 3 str))
2615         (zenirc-message proc 'protocol_violation
2616                         (aref parsedmsg 1) (aref parsedmsg 3))))))
2617
2618 ;; 252 - number of irc operators online
2619 (defun zenirc-server-252 (proc parsedmsg)
2620   (zenirc-message proc 's252 (aref parsedmsg 3)))
2621
2622 ;; 253 - number of "unknown" connections
2623 (defun zenirc-server-253 (proc parsedmsg)
2624   (zenirc-message proc 's253 (aref parsedmsg 3)))
2625
2626 ;; 254 - number of channels
2627 (defun zenirc-server-254 (proc parsedmsg)
2628   (zenirc-message proc 's254 (aref parsedmsg 3)))
2629
2630 ;; 255 - :server 255 ZenIRC :I have x clients and y servers
2631 ;;       :server 255 ZenIRC :I have x clients, y services and z servers
2632 (defun zenirc-server-255 (proc parsedmsg)
2633   (let ((str (aref parsedmsg 3)))
2634     (if (string-match "I have \\([0-9]+\\) clients and \\([0-9]+\\) servers" str)
2635         (zenirc-message proc 's255
2636                         (substring str (match-beginning 1) (match-end 1))
2637                         (substring str (match-beginning 2) (match-end 2)))
2638       (if (string-match "I have \\([0-9]+\\) clients, \\([0-9]+\\) services and \\([0-9]+\\) servers" str)
2639           (zenirc-message proc 's255-29
2640                           (substring str (match-beginning 1) (match-end 1))
2641                           (substring str (match-beginning 2) (match-end 2))
2642                           (substring str (match-beginning 3) (match-end 3)))
2643         (zenirc-message proc 'protocol_violation
2644                         (aref parsedmsg 1) (aref parsedmsg 3))))))
2645
2646 ;; 256 - line 1 of /admin information
2647 (defun zenirc-server-256 (proc parsedmsg)
2648   (zenirc-message proc 's256 (aref parsedmsg 1)))
2649
2650 ;; 257 - line 2 of /admin information
2651 (defun zenirc-server-257 (proc parsedmsg)
2652   (zenirc-message proc 's257 (aref parsedmsg 3)))
2653
2654 ;; 258 - line 2 of /admin information
2655 (defun zenirc-server-258 (proc parsedmsg)
2656   (zenirc-message proc 's258 (aref parsedmsg 3)))
2657
2658 ;; 259 - line 4 of /admin information
2659 (defun zenirc-server-259 (proc parsedmsg)
2660   (zenirc-message proc 's259 (aref parsedmsg 3)))
2661
2662 ;; 261 RPL_TRACELOG
2663 (defun zenirc-server-261 (proc parsedmsg)
2664   (zenirc-message proc 's261
2665                   (aref parsedmsg 1)
2666                   (aref parsedmsg 4)
2667                   (aref parsedmsg 5)))
2668
2669 ;; 262 - RPL_TRACEEND
2670 (defun zenirc-server-262 (proc parsedmsg)
2671   (zenirc-message proc 's262
2672                   (aref parsedmsg 1)
2673                   (aref parsedmsg 4)))
2674
2675 ;; 301 - someone is /away
2676 (defun zenirc-server-301 (proc parsedmsg)
2677   (zenirc-message proc 's301 (aref parsedmsg 3) (aref parsedmsg 4)))
2678
2679 ;; 302 - Userhost reply - RPL_USERHOST  ":[<reply>{<space><reply>}]"
2680 (defun zenirc-server-302 (proc parsedmsg)
2681   (zenirc-message proc 's302 (aref parsedmsg 3)))
2682
2683 ;; 303 - Ison reply - RPL_ISON ":[<nick> {<space><nick>}]"
2684 (defun zenirc-server-303 (proc parsedmsg)
2685   (zenirc-message proc 's303 (aref parsedmsg 3)))
2686
2687 ;; 305 - you are not /away
2688 (defun zenirc-server-305 (proc parsedmsg)
2689   (zenirc-message proc 's305))
2690
2691 ;; 306 - you are /away
2692 (defun zenirc-server-306 (proc parsedmsg)
2693   (zenirc-message proc 's306))
2694
2695 ;; 311 - userinfo for /whois list
2696 (defun zenirc-server-311 (proc parsedmsg)
2697   (zenirc-message proc 's311
2698                   (aref parsedmsg 3)
2699                   (aref parsedmsg 4)
2700                   (aref parsedmsg 5)
2701                   (aref parsedmsg 7)))
2702
2703 ;; 312 - server part of /whois list
2704 (defun zenirc-server-312 (proc parsedmsg)
2705   (zenirc-message proc 's312
2706                   (aref parsedmsg 3)
2707                   (aref parsedmsg 4)
2708                   (aref parsedmsg 5)))
2709
2710 ;; 313 - /whois list reply indicating irc operator
2711 (defun zenirc-server-313 (proc parsedmsg)
2712   (zenirc-message proc 's313 (aref parsedmsg 3)))
2713
2714 ;; 314 - /whowas reply
2715 (defun zenirc-server-314 (proc parsedmsg)
2716   (zenirc-message proc 's314
2717                   (aref parsedmsg 3)
2718                   (aref parsedmsg 4)
2719                   (aref parsedmsg 5)
2720                   (aref parsedmsg 7)))
2721
2722 ;; 315 - end of /who list
2723 (defun zenirc-server-315 (proc parsedmsg)
2724   (zenirc-message proc 's315))
2725
2726 ;; 317 - /whois list idle time reply
2727 (defun zenirc-server-317 (proc parsedmsg)
2728   (let ((hours (/ (string-to-int (aref parsedmsg 4)) 3600)))
2729     (let ((minutes (- (/ (string-to-int (aref parsedmsg 4)) 60)
2730                       (* hours 60))))
2731       (let ((seconds (- (string-to-int (aref parsedmsg 4))
2732                         (* hours 3600)
2733                         (* minutes 60))))
2734         (let ((hours (int-to-string hours))
2735               (minutes (int-to-string minutes))
2736               (seconds (int-to-string seconds)))
2737           (if (= (length minutes) 1)
2738               (setq minutes (concat "0" minutes)))
2739           (if (= (length seconds) 1)
2740               (setq seconds (concat "0" seconds)))
2741           (let ((idle-string (concat
2742                               hours ":" minutes ":" seconds)))
2743             (zenirc-message proc 's317
2744                             (aref parsedmsg 3)
2745                             idle-string)))))))
2746
2747 ;; 318 - end of /whois list
2748 (defun zenirc-server-318 (proc parsedmsg)
2749   (zenirc-message proc 's318))
2750
2751 ;; 319 - what channels part of /whois list
2752 (defun zenirc-server-319 (proc parsedmsg)
2753   (zenirc-message proc 's319 (aref parsedmsg 3) (aref parsedmsg 4)))
2754
2755 ;; 321 - header for /list command
2756 ;; This reply was removed as of ircd 2.9.1.
2757 (defun zenirc-server-321 (proc parsedmsg)
2758   (zenirc-message proc 's321))
2759
2760 ;; 322 - element returned by /list
2761 (defun zenirc-server-322 (proc parsedmsg)
2762   (zenirc-message proc 's322
2763                   (aref parsedmsg 3)
2764                   (aref parsedmsg 4)
2765                   (aref parsedmsg 5)))
2766
2767 ;; 323 - trailer for /list command
2768 (defun zenirc-server-323 (proc parsedmsg)
2769   (zenirc-message proc 's323))
2770
2771 ;; 324 - RPL_CHANNELMODEIS "<channel> <mode> <mode params>"
2772 (defun zenirc-server-324 (proc parsedmsg)
2773   (zenirc-message proc 's324
2774                   (aref parsedmsg 3)
2775                   (aref parsedmsg 4)
2776                   (or (aref parsedmsg 5) "")))
2777
2778 ;; 331 - RPL_NOTOPIC "<channel> :No topic is set"
2779 (defun zenirc-server-331 (proc parsedmsg)
2780   (zenirc-message proc 's331 (aref parsedmsg 3)))
2781
2782 ;; 332 - channel topic on join, etc.
2783 (defun zenirc-server-332 (proc parsedmsg)
2784   (zenirc-message proc 's332 (aref parsedmsg 3) (aref parsedmsg 4)))
2785
2786 ;; 333 - user who set topic and when it was set
2787 ;;       :server 333 to channel who-set-topic time-when-set
2788 (defun zenirc-server-333 (proc parsedmsg)
2789   (zenirc-message proc 's333
2790                   (aref parsedmsg 3)
2791                   (aref parsedmsg 4)
2792                   (current-time-string (zenirc-epoch-seconds-to-time
2793                                         (aref parsedmsg 5)))))
2794
2795 ;; 341 - invite reply
2796 (defun zenirc-server-341 (proc parsedmsg)
2797   (zenirc-message proc 's341 (aref parsedmsg 3) (aref parsedmsg 4)))
2798
2799 ;; 342 - RPL_SUMMONING "<user> :Summoning user to IRC"
2800 (defun zenirc-server-342 (proc parsedmsg)
2801   (zenirc-message proc 's342 (aref parsedmsg 3)))
2802
2803 ;; 351 - RPL_VERSION "<version>.<debuglevel> <server> :<comments>"
2804 (defun zenirc-server-351 (proc parsedmsg)
2805   (zenirc-message proc 's351
2806                   (aref parsedmsg 3)
2807                   (aref parsedmsg 4)
2808                   (aref parsedmsg 5)))
2809
2810 ;; 352 - WHO reply
2811 (defun zenirc-server-352 (proc parsedmsg)
2812   (if (string= (aref parsedmsg 3) "Channel")
2813       ;; this is the header
2814       (zenirc-message proc 's352_header)
2815     ;; this is a reply
2816     (zenirc-message proc 's352
2817                     (aref parsedmsg 7)
2818                     (aref parsedmsg 8)
2819                     (aref parsedmsg 3)
2820                     (aref parsedmsg 4)
2821                     (aref parsedmsg 5)
2822                     (aref parsedmsg 9))))
2823
2824 ;; 353 - name list after channel join or NAMES command
2825 (defun zenirc-server-353 (proc parsedmsg)
2826   (zenirc-message proc 's353 (aref parsedmsg 4) (aref parsedmsg 5)))
2827
2828 ;; 364 - RPL_LINKS "<mask> <server> :<hopcount> <server info>"
2829 (defun zenirc-server-364 (proc parsedmsg)
2830   (zenirc-message proc 's364
2831                   (aref parsedmsg 3)
2832                   (aref parsedmsg 4)
2833                   (aref parsedmsg 5)))
2834
2835 ;; 365 - RPL_ENDOFLINKS "<mask> :End of /LINKS list"
2836 (defun zenirc-server-365 (proc parsedmsg)
2837   (zenirc-message proc 's365 (aref parsedmsg 3)))
2838
2839 ;; 366 - after all ppl on channel displayed
2840 (defun zenirc-server-366 (proc parsedmsg) ())
2841
2842 ;; 367 - RPL_BANLIST "<channel> <banid>"
2843 (defun zenirc-server-367 (proc parsedmsg)
2844   (zenirc-message proc 's367 (aref parsedmsg 3) (aref parsedmsg 4)))
2845
2846 ;; 368 - RPL_RPL_ENDOFBANLIST
2847 (defun zenirc-server-368 (proc parsedmsg)
2848   (zenirc-message proc 's368))
2849
2850 ;; 369 - end of whowas
2851 (defun zenirc-server-369 (proc parsedmsg) ())
2852
2853 ;; 371 - RPL_INFO ":<string>"
2854 (defun zenirc-server-371 (proc parsedmsg)
2855   (zenirc-message proc 's371 (aref parsedmsg 3)))
2856
2857 ;; 372 - motd line
2858 (defun zenirc-server-372 (proc parsedmsg)
2859   (zenirc-message proc 's372 (aref parsedmsg 3)))
2860
2861 ;; 374 - RPL_ENDOFINFO ":End of /INFO list"
2862 (defun zenirc-server-374 (proc parsedmsg) ())
2863
2864 ;; 375 - start of /MOTD
2865 (defun zenirc-server-375 (proc parsedmsg)
2866   (zenirc-message proc 's375))
2867
2868 ;; 376 - end of /MOTD
2869 (defun zenirc-server-376 (proc parsedmsg)
2870   (zenirc-message proc 's376))
2871
2872 ;; 381 - RPL_YOUREOPER ":You are now an IRC operator"
2873 (defun zenirc-server-381 (proc parsedmsg)
2874   (zenirc-message proc 's381))
2875
2876 ;; 382 - RPL_REHASHING "<config file> :Rehashing"
2877 (defun zenirc-server-382 (proc parsedmsg)
2878   (zenirc-message proc 's382 (aref parsedmsg 3)))
2879
2880 ;; 391 - RPL_TIME "<server> :<string showing server's local time>"
2881 (defun zenirc-server-391 (proc parsedmsg)
2882   (zenirc-message proc 's391 (aref parsedmsg 3) (aref parsedmsg 4)))
2883
2884 ;; 392 - RPL_USERSSTART ":UserID   Terminal  Host"
2885 (defun zenirc-server-392 (proc parsedmsg)
2886   (zenirc-message proc 's392))
2887
2888 ;; 393 - RPL_USERS ":%-8s %-9s %-8s"
2889 (defun zenirc-server-393 (proc parsedmsg)
2890   (zenirc-message proc 's393 (aref parsedmsg 3)))
2891
2892 ;; 394 - RPL_ENDOFUSERS ":End of users"
2893 (defun zenirc-server-394 (proc parsedmsg) ())
2894
2895 ;; 395 - RPL_NOUSERS ":Nobody logged in"
2896 (defun zenirc-server-395 (proc parsedmsg)
2897   (zenirc-message proc 's395))
2898
2899 ;; 401 - no such nick/channel
2900 (defun zenirc-server-401 (proc parsedmsg)
2901   (zenirc-message proc 's401 (aref parsedmsg 3))
2902   (if zenirc-whowas-on-401
2903       (process-send-string proc (concat "WHOWAS " (aref parsedmsg 3) "\n"))))
2904
2905 ;; 402 - no such server
2906 (defun zenirc-server-402 (proc parsedmsg)
2907   (zenirc-message proc 's402 (aref parsedmsg 3)))
2908
2909 ;; 403 - ERRNOSUCHCHANNEL "<channel> :No such channel"
2910 (defun zenirc-server-403 (proc parsedmsg)
2911   (zenirc-message proc 's403 (aref parsedmsg 3)))
2912
2913 ;; 404 - ERR_CANNOTSENDTOCHAN "<channel> :Cannot send to channel"
2914 (defun zenirc-server-404 (proc parsedmsg)
2915   (zenirc-message proc 's404 (aref parsedmsg 3)))
2916
2917 ;; 405 - ERR_TOOMANYCHANNELS  "<channel_name> :You have joined too many channels"
2918 (defun zenirc-server-405 (proc parsedmsg)
2919   (zenirc-message proc 's405 (aref parsedmsg 3)))
2920
2921 ;; 406 - ERR_WASNOSUCHNICK  "<channel_name> :There was no such nickname"
2922 (defun zenirc-server-406 (proc parsedmsg)
2923   (zenirc-message proc 's406 (aref parsedmsg 3)))
2924
2925 ;; 407 - ERR_TOOMANYTARGETS "<target> :Duplicate recipients. No message delivered"
2926 (defun zenirc-server-407 (proc parsedmsg)
2927   (zenirc-message proc 's407 (aref parsedmsg 3)))
2928
2929 ;; 409 - ERR_NOORIGIN ":No origin specified"
2930 (defun zenirc-server-409 (proc parsedmsg)
2931   (zenirc-message proc 's409))
2932
2933 ;; 411 - ERR_NORECIPIENT ":No recipient given (<command>)"
2934 (defun zenirc-server-411 (proc parsedmsg)
2935   (zenirc-message proc 's411))
2936
2937 ;; 412 - ERR_NOTEXTTOSEND ":No text to send"
2938 ;; you sent a message w/o any text
2939 (defun zenirc-server-412 (proc parsedmsg)
2940   (zenirc-message proc 's412))
2941
2942 ;; 413 - ERR_NOTOPLEVEL "<mask> :No toplevel domain specified"
2943 (defun zenirc-server-413 (proc parsedmsg)
2944   (zenirc-message proc 's413 (aref parsedmsg 3)))
2945
2946 ;; 414 - ERR_WILDTOPLEVEL "<mask> :Wildcard in toplevel domain"
2947 (defun zenirc-server-414 (proc parsedmsg)
2948   (zenirc-message proc 's414 (aref parsedmsg 3)))
2949
2950 ;; 415 - ERR_BADMASK "<server/host> :Bad Server/host mask"
2951 (defun zenirc-server-415 (proc parsedmsg)
2952   (zenirc-message proc 's415 (aref parsedmsg 3)))
2953
2954 ;; 421 - server detected error in what you sent
2955 (defun zenirc-server-421 (proc parsedmsg)
2956   (zenirc-message proc 's421 (aref parsedmsg 3)))
2957
2958 ;; 422 - ERR_NOMOTD ":MOTD File is missing"
2959 (defun zenirc-server-422 (proc parsedmsg)
2960   (zenirc-message proc 's422))
2961
2962 ;; 423 - ERR_NOADMININFO "<server> :No administrative info available"
2963 (defun zenirc-server-423 (proc parsedmsg)
2964   (zenirc-message proc 's423 (aref parsedmsg 3)))
2965
2966 ;; 424 ERR_FILEERROR ":File error doing <file op> on <file>"
2967 (defun zenirc-server-424 (proc parsedmsg)
2968   (zenirc-message proc (aref parsedmsg 3)))
2969
2970 ;; 431     ERR_NONICKNAMEGIVEN ":No nickname given"
2971 (defun zenirc-server-431 (proc parsedmsg)
2972   (zenirc-message proc 's431))
2973
2974 ;; 432 -  ERR_ERRONEUSNICKNAME "<nick> :Erroneus nickname"
2975 (defun zenirc-server-432 (proc parsedmsg)
2976   (zenirc-message proc 's432 (aref parsedmsg 3)))
2977
2978 ;; 433 - ERR_NICKNAMEINUSE "<nick> :Nickname is already in use"
2979 (defun zenirc-server-433 (proc parsedmsg)
2980   (zenirc-message proc 's433 (aref parsedmsg 3)))
2981
2982 ;; 436 - ERR_NICKCOLLISION "<nick> :Nickname collision KILL"
2983 (defun zenirc-server-436 (proc parsedmsg)
2984   (zenirc-message proc 's436 (aref parsedmsg 3)))
2985
2986 ;; 437 - ERR_UNAVAILRESOURCE "<nick>/<channel> :Nick/channel is temporarily
2987 ;;                                            unavailable"
2988 (defun zenirc-server-437 (proc parsedmsg)
2989   (zenirc-message proc 's437 (aref parsedmsg 3)))
2990
2991 ;; 441 - ERR_USERNOTINCHANNEL "<nick> <channel> :They aren't on that channel"
2992 (defun zenirc-server-441 (proc parsedmsg)
2993   (zenirc-message proc 's441 (aref parsedmsg 3) (aref parsedmsg 4)))
2994
2995 ;; 442 - You are not on that channel
2996 (defun zenirc-server-442 (proc parsedmsg)
2997   (zenirc-message proc 's442 (aref parsedmsg 3)))
2998
2999 ;; 443 - already on channel invite error
3000 (defun zenirc-server-443 (proc parsedmsg)
3001   (zenirc-message proc 's443 (aref parsedmsg 3) (aref parsedmsg 4)))
3002
3003 ;; 444 - ERR_NOLOGIN "<user> :User not logged in"
3004 (defun zenirc-server-444 (proc parsedmsg)
3005   (zenirc-message proc 's444 (aref parsedmsg 3)))
3006
3007 ;; 445 - ERR_SUMMONDISABLED ":SUMMON has been disabled"
3008 (defun zenirc-server-445 (proc parsedmsg)
3009   (zenirc-message proc 's445))
3010
3011 ;; 446 - ERR_USERSDISABLED ":USERS has been disabled"
3012 (defun zenirc-server-446 (proc parsedmsg)
3013   (zenirc-message proc 's446))
3014
3015 ;; 451 - ERR_NOTREGISTERED ":You have not registered"
3016 (defun zenirc-server-451 (proc parsedmsg)
3017   (zenirc-message proc 's451))
3018
3019 ;; 461 - server detected error - not enough parameters
3020 (defun zenirc-server-461 (proc parsedmsg)
3021   (zenirc-message proc 's461 (aref parsedmsg 3)))
3022
3023 ;; 462 - ERR_ALREADYREGISTRED  ":You may not reregister"
3024 (defun zenirc-server-462 (proc parsedmsg)
3025   (zenirc-message proc 's462))
3026
3027 ;; 463 - ERR_NOPERMFORHOST ":Your host isn't among the privileged"
3028 (defun zenirc-server-463 (proc parsedmsg)
3029   (zenirc-message proc 's463))
3030
3031 ;; 464 - ERR_PASSWDMISMATCH ":Password incorrect"
3032 (defun zenirc-server-464 (proc parsedmsg)
3033   (zenirc-message proc 's464))
3034
3035 ;; 465 - ERR_YOUREBANNEDCREEP ":You are banned from this server"
3036 (defun zenirc-server-465 (proc parsedmsg)
3037   (zenirc-message proc 's465))
3038
3039 ;; 467 - ERR_KEYSET "<channel> :Channel key already set"
3040 (defun zenirc-server-467 (proc parsedmsg)
3041   (zenirc-message proc 's467 (aref parsedmsg 3)))
3042
3043 ;; 471 - ERR_CHANNELISFULL "<channel> :Cannot join channel (+l)"
3044 (defun zenirc-server-471 (proc parsedmsg)
3045   (zenirc-message proc 's471 (aref parsedmsg 3)))
3046
3047 ;; 472 - ERR_UNKNOWNMODE "<char> :is unknown mode char to me"
3048 (defun zenirc-server-472 (proc parsedmsg)
3049   (zenirc-message proc 's472 (aref parsedmsg 3)))
3050
3051 ;; 473 - ERR_INVITEONLYCHAN "<channel> :Cannot join channel (+i)"
3052 (defun zenirc-server-473 (proc parsedmsg)
3053   (zenirc-message proc 's473 (aref parsedmsg 3)))
3054
3055 ;; 474 - ERR_BANNEDFROMCHAN "<channel> :Cannot join channel (+b)"
3056 (defun zenirc-server-474 (proc parsedmsg)
3057   (zenirc-message proc 's474 (aref parsedmsg 3)))
3058
3059 ;; 475 - ERR_BADCHANNELKEY "<channel> :Cannot join channel (+k)"
3060 (defun zenirc-server-475 (proc parsedmsg)
3061   (zenirc-message proc 's475 (aref parsedmsg 3)))
3062
3063 ;; 477 - ERR_NOCHANMODES "<channel> :Channel doesn't support modes"
3064 (defun zenirc-server-477 (proc parsedmsg)
3065   (zenirc-message proc 's477 (aref parsedmsg 3)))
3066
3067 ;; 481 - ERR_NOPRIVILEGES ":Permission Denied- You're not an IRC operator"
3068 (defun zenirc-server-481 (proc parsedmsg)
3069   (zenirc-message proc 's481))
3070
3071 ;; 482 - ERR_CHANOPRIVSNEEDED "<channel> :You're not channel operator"
3072 (defun zenirc-server-482 (proc parsedmsg)
3073   (zenirc-message proc 's482 (aref parsedmsg 3)))
3074
3075 ;; 483 - ERR_CANTKILLSERVER ":You cant kill a server!"
3076 (defun zenirc-server-483 (proc parsedmsg)
3077   (zenirc-message proc 's483))
3078
3079 ;; 491 - ERR_NOOPERHOST ":No O-lines for your host"
3080 (defun zenirc-server-491 (proc parsedmsg)
3081   (zenirc-message proc 's491))
3082
3083 ;; 501 - ERR_UMODEUNKNOWNFLAG ":Unknown MODE flag"
3084 (defun zenirc-server-501 (proc parsedmsg)
3085   (zenirc-message proc 's501))
3086
3087 ;; 502 - ERR_USERSDONTMATCH ":Cant change mode for other users"
3088 (defun zenirc-server-502 (proc parsedmsg)
3089   (zenirc-message proc 's502))
3090
3091 \f
3092 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3093 ;;; PRIVMSG/NOTICE and CTCP handling
3094 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3095 (defun zenirc-privmsg-or-notice (proc parsedmsg)
3096   (let ((from (aref parsedmsg 1))       ; who the message is from
3097         (to (aref parsedmsg 2))         ; who the message is to
3098         (text (aref parsedmsg 3))       ; the text of the message
3099         (type (aref parsedmsg 0)))      ; privmsg or notice
3100     ;; see if privmsg or notice contains ctcp
3101     (if (not (string-match "\C-a" text))
3102         (zenirc-format-privmsg-or-notice type from to text proc)
3103       ;; message contains ctcp. break it up into ctcp and non-ctcp parts
3104       ;; and handle each.
3105       (let ((index 0) (ctcp nil) (str "") (len (length text)))
3106         (while (< index len)
3107           (if (char-equal (aref text index) ?\C-a)
3108               ;; we hit a control-a - deal with it.
3109               (progn
3110                 (if (not (string= str ""))
3111                     ;; we have a string
3112                     (if ctcp
3113                         ;; we are in a ctcp message
3114                         (progn
3115                           (zenirc-handle-ctcp type from to str proc)
3116                           (setq str ""))
3117                       ;; we are in a regular message
3118                       (zenirc-format-privmsg-or-notice type from to str proc)
3119                       (setq str ""))
3120                   ;; we do not have a string
3121                   (if (and (not (= index 0)) ctcp)
3122                       ;; some leper sent a zero length message
3123                       (zenirc-handle-ctcp type from to str proc)))
3124                 (setq ctcp (not ctcp))) ; toggle ctcp state
3125             ;; we have a regular character
3126             (setq str (concat str (char-to-string (aref text index)))))
3127           (setq index (1+ index))
3128           (if (and (= index len) ctcp)
3129               ;; someone sent us an ill-formed ctcp message
3130               (zenirc-unbalanced-ctcp type from to str proc)))))))
3131
3132 ;; handle a ctcp message
3133 (defun zenirc-handle-ctcp (type from to str proc)
3134   (let* ((parsedctcp (zenirc-parse-firstword str))
3135          (fmt (if (string= type "PRIVMSG") 'query 'reply))
3136          (hook-name (format "zenirc-ctcp-%s-%s-hook" fmt (car parsedctcp)))
3137          (hook (intern-soft hook-name))
3138          (sender (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)))
3139     (and zenirc-debug-ctcp
3140          (zenirc-message proc 'debug hook-name))
3141     (cond ((and hook
3142                 (boundp hook))
3143            (zenirc-run-hook hook proc parsedctcp from to))
3144           ;; Don't ever reply to notices, just privmsgs
3145           (t
3146            (and (string= type "PRIVMSG")
3147                 zenirc-send-ctcp-errmsg-on-unknown
3148                 (zenirc-ctcp-errmsg
3149                  type sender to str
3150                  (zenirc-lang-retrieve-catalog-entry 'query_unknown)
3151                  proc))
3152            (zenirc-message proc fmt sender to str)))))
3153
3154 ;; spew a ctcp error
3155 (defun zenirc-ctcp-errmsg (type from to str whine proc)
3156   (let ((nick (zenirc-extract-nick from))
3157         (fmt "NOTICE %s :\C-aERRMSG %s :%s\C-a\n"))
3158     (process-send-string proc (format fmt nick str whine))))
3159
3160 ;; handle an unbalanced ctcp message
3161 (defun zenirc-unbalanced-ctcp (type from to str proc)
3162   (let ((sender (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)))
3163     (cond
3164      ((string= type "PRIVMSG")
3165       (and zenirc-send-ctcp-errmsg-on-unbalanced
3166            (zenirc-ctcp-errmsg type from to str
3167             (zenirc-lang-retrieve-catalog-entry 'query_unbalanced_reply)
3168             proc))
3169       (zenirc-message proc 'query_unbalanced sender to str))
3170      (t
3171       (zenirc-message proc 'reply_unbalanced sender to str)))))
3172
3173 ;; format a PRIVMSG or NOTICE and insert it in the zenirc process buffer
3174 (defun zenirc-format-privmsg-or-notice (type origfrom to text proc)
3175   (let ((timestr (zenirc-timestamp-string))
3176         (from (zenirc-run-hook 'zenirc-format-nickuserhost-hook origfrom))
3177         msgtype)
3178     (setq zenirc-privmsg-last-seen origfrom)
3179     (cond
3180      ((not 
3181        (zenirc-channel-p to))
3182       
3183       (or (and zenirc-current-server-name
3184                (zenirc-names-equal-p from zenirc-current-server-name t))
3185           (setq zenirc-privmsg-last-rec (zenirc-extract-nick from)))
3186
3187       (if (string= type "PRIVMSG")
3188           (setq msgtype 'privmsg_you)
3189         (setq msgtype 'notice_you))
3190       (zenirc-message proc msgtype 
3191                       (if zenirc-timestamp
3192                           (concat from zenirc-timestamp-prefix 
3193                               timestr zenirc-timestamp-suffix) 
3194                         from)
3195                       text))
3196      ((and
3197        (zenirc-names-equal-p to zenirc-current-victim t)
3198        (not zenirc-always-show-channelname))
3199       
3200       (if (string= type "PRIVMSG")
3201           (setq msgtype 'privmsg_nochannel)
3202         (setq msgtype 'notice_nochannel))
3203
3204       (zenirc-message proc msgtype 
3205                       (if zenirc-timestamp
3206                           (concat from zenirc-timestamp-prefix
3207                                   timestr zenirc-timestamp-suffix)
3208                         from)
3209                         text))
3210      (t
3211       (if (string= type "PRIVMSG")
3212           (setq msgtype 'privmsg)
3213         (setq msgtype 'notice))
3214       (zenirc-message proc msgtype from 
3215                       (if zenirc-timestamp
3216                           (concat to zenirc-timestamp-prefix
3217                                   timestr zenirc-timestamp-suffix)
3218                         to)
3219                       text)))))
3220
3221 (defun zenirc-timestamp-string ()
3222   (substring (current-time-string) 11 16))
3223
3224 \f
3225 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3226 ;;;
3227 ;;; ctcp handlers
3228 ;;;
3229 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3230
3231 ;;; query handlers
3232
3233 ;; handler for a ctcp ACTION query
3234 ;;
3235 ;; Order of args is recipient, sender, message.
3236 ;; E.g. [ACTION->#oink_worship] noah splodes
3237 (defun zenirc-ctcp-query-ACTION (proc parsedctcp from to)
3238   (if (and (not zenirc-always-show-channelname)
3239            (zenirc-names-equal-p to zenirc-current-victim t))
3240       (zenirc-message proc 'ctcp_action_nochannel
3241                       (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
3242                       (cdr parsedctcp))
3243     (zenirc-message proc 'ctcp_action
3244                     to
3245                     (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
3246                     (cdr parsedctcp))))
3247
3248 ;; handler for a ctcp PING query
3249 (defun zenirc-ctcp-query-PING (proc parsedctcp from to)
3250   (process-send-string
3251    proc (concat "NOTICE "
3252                 (zenirc-extract-nick from)
3253                 " :\C-aPING " (cdr parsedctcp) "\C-a\n"))
3254   (if zenirc-verbose-ctcp
3255       (zenirc-message proc 'ctcp_ping
3256                       (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
3257                       to)))
3258
3259 ;; handler for a ctcp VERSION query
3260 (defun zenirc-ctcp-query-VERSION (proc parsedctcp from to)
3261   (process-send-string
3262    proc (format "NOTICE %s :\C-aVERSION ZenIRC : %s : in %s %s\C-a\n"
3263                 (zenirc-extract-nick from)
3264                 zenirc-version
3265                 (zenirc-emacs-variant)
3266                 emacs-version))
3267   (and zenirc-verbose-ctcp
3268        (zenirc-message proc 'ctcp_version
3269                        (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
3270                        to)))
3271
3272 ;; handler for a ctcp USERINFO query
3273 (defun zenirc-ctcp-query-USERINFO (proc parsedctcp from to)
3274   (process-send-string
3275    proc (concat "NOTICE "
3276                 (zenirc-extract-nick from)
3277                 " :\C-aUSERINFO :" zenirc-userinfo "\C-a\n"))
3278   (if zenirc-verbose-ctcp
3279       (zenirc-message proc 'ctcp_userinfo
3280                       (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
3281                       to)))
3282
3283 ;; handler for a ctcp SOURCE query
3284 (defun zenirc-ctcp-query-SOURCE (proc parsedctcp from to)
3285   (let ((src zenirc-source-list)
3286         (fromnick (zenirc-extract-nick from)))
3287     (while src
3288       (process-send-string proc
3289                            (concat "NOTICE "
3290                                    fromnick
3291                                    " :\C-aSOURCE " (car src) "\C-a\n"))
3292       (setq src (cdr src)))
3293     (process-send-string proc (concat "NOTICE " fromnick " :\C-aSOURCE\C-a\n"))
3294   (if zenirc-verbose-ctcp
3295       (zenirc-message proc 'ctcp_source
3296                       (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
3297                       to))))
3298
3299 ;; handler for a ctcp CLIENTINFO query
3300 (defun zenirc-ctcp-query-CLIENTINFO (proc parsedctcp from to)
3301   (let ((replyto (zenirc-extract-nick from))
3302         (sender (zenirc-run-hook 'zenirc-format-nickuserhost-hook from))
3303         help)
3304     (if (string= (cdr parsedctcp) "")
3305         (process-send-string proc (format "NOTICE %s :\C-aCLIENTINFO %s\C-a\n"
3306                                           replyto zenirc-clientinfo-string))
3307       (setq help (cdr (assq (intern-soft (cdr parsedctcp))
3308                             zenirc-clientinfo-list)))
3309       (if help
3310           (process-send-string
3311            proc (format "NOTICE %s :\C-aCLIENTINFO %s\C-a\n" replyto help))
3312         (zenirc-ctcp-errmsg "PRIVMSG" from to "CLIENTINFO"
3313                             (concat (cdr parsedctcp)
3314                                     " is not a valid function")
3315                             proc)))
3316     (and zenirc-verbose-ctcp
3317          (zenirc-message proc 'ctcp_clientinfo sender to))))
3318
3319 ;; handler for a ctcp ECHO query
3320 (defun zenirc-ctcp-query-ECHO (proc parsedctcp from to)
3321   (process-send-string
3322    proc (concat "NOTICE "
3323                 (zenirc-extract-nick from)
3324                 " :\C-aECHO"
3325                 (if (string= "" (cdr parsedctcp))
3326                     ""
3327                   (concat " " (cdr parsedctcp)))
3328                 "\C-a\n"))
3329   (if zenirc-verbose-ctcp
3330       (zenirc-message proc 'ctcp_echo
3331                       (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
3332                       to (cdr parsedctcp))))
3333   
3334
3335 ;; handler for a ctcp ERRMSG query
3336 (defun zenirc-ctcp-query-ERRMSG (proc parsedctcp from to)
3337   (process-send-string
3338    proc (concat "NOTICE "
3339                 (zenirc-extract-nick from)
3340                 " :\C-aERRMSG"
3341                 (if (string= "" (cdr parsedctcp))
3342                     ""
3343                   (concat " " (cdr parsedctcp) " :No error"))
3344                 "\C-a\n"))
3345   (if zenirc-verbose-ctcp
3346       (zenirc-message proc 'ctcp_errmsg
3347                       (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
3348                       to)))
3349
3350 ;; handler for a ctcp FINGER query
3351 (defun zenirc-ctcp-query-FINGER (proc parsedctcp from to)
3352   (process-send-string
3353    proc (concat "NOTICE "
3354                 (zenirc-extract-nick from)
3355                 " :\C-aFINGER :" zenirc-fingerdata "\C-a\n"))
3356   (if zenirc-verbose-ctcp
3357       (zenirc-message proc 'ctcp_finger
3358                       (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
3359                       to)))
3360
3361 ;; handler for a ctcp TIME query
3362 (defun zenirc-ctcp-query-TIME (proc parsedctcp from to)
3363   (process-send-string
3364    proc (concat "NOTICE "
3365                 (zenirc-extract-nick from)
3366                 " :\C-aTIME :" (current-time-string) "\C-a\n"))
3367   (if zenirc-verbose-ctcp
3368       (zenirc-message proc 'ctcp_time
3369                       (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
3370                       to)))
3371
3372 ;;; reply handlers
3373
3374 ;; handler for a ctcp PING reply
3375 (defun zenirc-ctcp-reply-PING (proc parsedctcp from to)
3376   (let ((current (car (cdr (zenirc-time-to-int (current-time-string))))))
3377     (if (< current
3378            (string-to-int (cdr parsedctcp)))
3379         (setq current (+ 65536 current)))
3380     (zenirc-message proc 'ctcp_ping_reply
3381                     (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
3382                     (- current (string-to-int (cdr parsedctcp))))))
3383
3384 \f
3385 (defun zenirc-bug ()
3386   "Send a bug report to the ZenIRC maintainers."
3387   (interactive)
3388   (require 'sendmail)
3389   (mail nil zenirc-bug-address
3390         (format "Found bug in zenirc %s" zenirc-version))
3391   (goto-char (point-max))
3392   (insert
3393    (emacs-version) "\n\n"
3394    "Describe the bug you encountered as well as you can.\n"
3395    (substitute-command-keys
3396     "When you're done press \\[mail-send-and-exit] to send the message.\n\n")))
3397
3398 \f
3399 (provide 'zenirc)
3400
3401 (zenirc-lang-define-english-catalog)
3402
3403 ;;; zenirc.el ends here