1 ;;; liece-ctcp.el --- CTCP handlers and commands.
2 ;; Copyright (C) 1998-2000 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; Keywords: IRC, liece, CTCP
9 ;; This file is part of Liece.
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
32 (eval-when-compile (require 'liece-inlines))
34 (require 'liece-handler)
40 (require 'liece-q-ccl))
42 (require 'liece-x-face)
44 (autoload 'liece-ctcp-dcc-message "liece-dcc")
47 (defconst liece-ctcp-supported-symbols
48 '(version userinfo clientinfo ping time x-face comment help)))
50 (defun liece-ctcp-make-menu-command-wrapper (symbol)
51 (fset (intern (format "liece-menu-callback-ctcp-%s" symbol))
54 (dolist (nick liece-nick-region-nicks)
55 (funcall (symbol-function
56 (intern (format "liece-command-ctcp-%s" ',symbol)))
59 (dolist (symbol liece-ctcp-supported-symbols)
60 (liece-ctcp-make-menu-command-wrapper symbol))
62 (defvar liece-ctcp-message
64 (concat liece-client-prefix "%s(%s) = %s"))
65 "Message in which info of other clients is displayed.")
67 (defvar liece-ctcp-buffer (append liece-D-buffer liece-O-buffer))
69 (defvar liece-ctcp-ping-time '(0 0 0))
71 (defvar liece-ctcp-last-command nil
72 "The last command executed.")
74 (defvar liece-ctcp-last-nick nil
75 "The last nick being queried.")
77 (defconst liece-ctcp-error-message "Unrecognized command: '%s'"
78 "Error message given to anyone asking wrong CLIENT data.")
80 (defun liece-ctcp-last-nick-maybe-change (prefix rest)
81 (if (equal prefix liece-ctcp-last-nick)
82 (setq liece-ctcp-last-nick rest))
85 (defun liece-ctcp-last-nick-maybe-reset (prefix rest)
86 (if (equal prefix liece-ctcp-last-nick)
87 (setq liece-ctcp-last-nick nil)))
89 (add-hook 'liece-nick-hook 'liece-ctcp-last-nick-maybe-change t)
90 (add-hook 'liece-quit-hook 'liece-ctcp-last-nick-maybe-reset)
92 (defcustom liece-ctcp-file-save-directory liece-directory
93 "Directory to save received files."
97 (liece-handler-define-backend "ctcp-message")
99 (defmacro liece-register-ctcp-message-handler (name)
100 `(liece-handler-define-function
101 ,name '(from chnl data "ctcp-message")
102 ',(intern (format "liece-ctcp-%s-message" name))))
104 (liece-register-ctcp-message-handler "version")
105 (liece-register-ctcp-message-handler "userinfo")
106 (liece-register-ctcp-message-handler "clientinfo")
107 (liece-register-ctcp-message-handler "ping")
108 (liece-register-ctcp-message-handler "time")
109 (liece-register-ctcp-message-handler "file")
110 (liece-register-ctcp-message-handler "x-face")
111 (liece-register-ctcp-message-handler "comment")
112 (liece-register-ctcp-message-handler "help")
113 (liece-register-ctcp-message-handler "action")
114 (liece-register-ctcp-message-handler "dcc")
115 (liece-register-ctcp-message-handler "errmsg")
117 (defun* liece-ctcp-message (from chnl rest)
118 (or (string-match "^\\([^\001]*\\)\001\\([^\001]*\\)\001" rest)
119 (return-from liece-ctcp-message))
120 (let (hook after-hook data message)
121 (setq data (match-string 2 rest)
123 (match-string 1 rest)
124 (substring rest (match-end 0))))
125 (if (string-match "^\\([^ ]*\\) *:?" data)
126 (setq message (downcase (match-string 1 data))
127 data (substring data (match-end 0)))
128 (setq message "errmsg"
129 data (_ "Couldn't figure out what was said.")))
132 (concat "liece-ctcp-" message "-hook"))
135 (concat "liece-after-ctcp-" message "-hook")))
136 (if (run-hook-with-args-until-success hook from chnl data)
137 (return-from liece-ctcp-message rest))
139 (liece-handler-find-function
140 message '(from chnl data) "ctcp-message")))
142 (funcall func from chnl data)
143 (liece-ctcp-messages message from chnl data))
144 (run-hook-with-args after-hook from chnl data))
147 (defun liece-ctcp-messages (message from chnl rest)
148 (liece-send "NOTICE %s :\001ERRMSG %s :%s\001"
149 from (upcase message)
150 (format liece-ctcp-error-message
152 (setq chnl (liece-channel-virtual chnl))
153 (liece-ctcp-insert (upcase message) from chnl rest))
155 (defun liece-ctcp-action-message (from chnl rest)
156 "CTCP ACTION handler."
157 (let ((liece-message-target (liece-channel-virtual chnl))
158 (liece-message-speaker from)
159 (liece-message-type 'action))
160 (liece-display-message rest)))
162 (defun liece-ctcp-insert (message from &optional chnl rest)
164 (liece-nick-equal chnl liece-real-nickname))
165 (liece-message "%s query from %s." message from)
166 (liece-message "%s query from %s (%s)." message from chnl)
168 (liece-pick-buffer chnl)
169 (format "%s query from %s%s\n"
170 message from (if rest (concat ":" rest) "")))))
172 (defun liece-ctcp-version-message (from chnl rest)
173 "CTCP VERSION handler."
174 (liece-send "NOTICE %s :\001VERSION %s :\001"
175 from (liece-version))
176 (setq chnl (liece-channel-virtual chnl))
177 (liece-ctcp-insert "VERSION" from chnl rest))
179 (defun liece-ctcp-userinfo-message (from chnl rest)
180 "CTCP USERINFO handler."
181 (liece-send "NOTICE %s :\001USERINFO %s\001"
182 from liece-ctcp-userinfo)
183 (setq chnl (liece-channel-virtual chnl))
184 (liece-ctcp-insert "USERINFO" from chnl))
186 (defun liece-ctcp-clientinfo-message (from chnl rest)
187 "CTCP CLIENTINFO handler."
188 (liece-send "NOTICE %s :\001CLIENTINFO %s\001"
192 (lambda (symbol) (upcase (symbol-name symbol)))
193 liece-ctcp-supported-symbols " ")))
194 (setq chnl (liece-channel-virtual chnl))
195 (liece-ctcp-insert "CLIENTINFO" from chnl))
197 (defvar liece-ctcp-help-message
198 "This is a help message for CTCP requests.
199 \"VERSION\" gives version of this client.
200 \"USERINFO\" gives user supplied information if any.
201 \"CLIENTINFO\" gives commands this client knows.
202 \"PING\" returns the arguments it receives.
203 \"TIME\" tells you the time on the user's host.
204 \"FILE\" send a small file via IRC messages.
205 \"X-FACE\" gives you user supplied X-Face.
206 \"COMMENT\" returns string sent by other person.
207 \"HELP\" gives this help message"
208 "Help message for CTCP requests.")
210 (defun liece-ctcp-help-message (from chnl rest)
213 "NOTICE %s :\001HELP %s\001"
214 from (liece-quote-encode-string liece-ctcp-help-message))
215 (setq chnl (liece-channel-virtual chnl))
216 (liece-ctcp-insert "HELP" from chnl))
218 (defun liece-ctcp-comment-message (from chnl rest)
219 "CTCP COMMENT handler."
220 (setq chnl (liece-channel-virtual chnl))
221 (liece-ctcp-insert "COMMENT" from chnl))
223 (defun liece-ctcp-ping-message (from chnl rest)
225 (liece-send "NOTICE %s :\001PING %s\001" from rest)
226 (setq chnl (liece-channel-virtual chnl))
227 (liece-ctcp-insert "PING" from chnl))
229 (defun liece-ctcp-time-message (from chnl rest)
231 (liece-send "NOTICE %s :\001TIME %s\001"
232 from (funcall liece-format-time-function
234 (setq chnl (liece-channel-virtual chnl))
235 (liece-ctcp-insert "TIME" from chnl))
237 (defun liece-ctcp-x-face-message (from chnl rest)
238 "CTCP X-FACE handler."
239 (liece-send "NOTICE %s :\001X-FACE %s\001"
240 from liece-ctcp-x-face)
241 (setq chnl (liece-channel-virtual chnl))
242 (liece-ctcp-insert "X-FACE" from chnl))
244 (liece-handler-define-backend "ctcp-notice")
246 (defmacro liece-register-ctcp-notice-handler (name)
247 `(liece-handler-define-function
248 ,name '(prefix rest "ctcp-notice")
249 ',(intern (format "liece-ctcp-%s-notice" name))))
251 (liece-register-ctcp-notice-handler "version")
252 (liece-register-ctcp-notice-handler "userinfo")
253 (liece-register-ctcp-notice-handler "clientinfo")
254 (liece-register-ctcp-notice-handler "ping")
255 (liece-register-ctcp-notice-handler "time")
256 (liece-register-ctcp-notice-handler "file")
257 (liece-register-ctcp-notice-handler "x-face")
258 (liece-register-ctcp-notice-handler "comment")
259 (liece-register-ctcp-notice-handler "help")
260 (liece-register-ctcp-notice-handler "dcc")
261 (liece-register-ctcp-notice-handler "errmsg")
263 (defun* liece-ctcp-notice (prefix rest)
264 (or (string-match "^\\([^\001]*\\)\001\\([^\001]*\\)\001" rest)
265 (return-from liece-ctcp-notice))
266 (let (hook after-hook data message)
267 (setq data (match-string 2 rest)
269 (match-string 1 rest)
270 (substring rest (match-end 0))))
271 (if (string-match "^\\([^ ]*\\) *:?" data)
272 (setq message (downcase (match-string 1 data))
273 data (substring data (match-end 0)))
274 (setq message "errmsg"
275 data (_ "Couldn't figure out what was said.")))
278 (concat "liece-ctcp-" message "-notice-hook"))
281 (concat "liece-after-ctcp-" message "-notice-hook")))
282 (if (run-hook-with-args-until-success hook prefix data)
283 (return-from liece-ctcp-notice rest))
285 (liece-handler-find-function
286 message '(prefix data) "ctcp-notice")))
288 (funcall func prefix data)
289 (liece-ctcp-notices message prefix data)))
290 (run-hook-with-args after-hook prefix data)
293 (defun liece-ctcp-notices (message prefix rest)
295 (_ "Unknown ctcp notice \":%s %s %s\"")
296 prefix (upcase message) rest))
298 (liece-handler-define-backend "ctcp-file")
300 (defmacro liece-register-file-handler (name)
301 `(liece-handler-define-function
302 ,name '(prefix name data "ctcp-file")
303 ',(intern (format "liece-file-%s" name))))
305 (liece-register-file-handler "start")
306 (liece-register-file-handler "cont")
307 (liece-register-file-handler "end")
309 (defun* liece-ctcp-file-notice (prefix rest)
310 (when liece-file-accept
311 (multiple-value-bind (message name data)
312 (liece-split-line rest)
313 (setq message (downcase message))
316 (concat "liece-file-" message "-hook")))
319 (concat "liece-after-file-" message "-hook")))
321 (if (run-hook-with-args-until-success hook prefix name)
322 (return-from liece-ctcp-file-notice))
323 (setq func (liece-handler-find-function
324 message '(prefix name data) 'ctcp-file))
326 (funcall func prefix name data)
327 (liece-file-notices message prefix name data))
328 (run-hook-with-args after-hook prefix name)))))
330 (defun liece-file-notices (message prefix name data)
332 (_ "Unknown FILE message \":%s %s %s %s\"")
333 prefix (upcase message) name data))
335 (defun liece-file-start (prefix name data)
336 "CTCP FILE start handler."
339 (liece-get-buffer-create
340 (format " *ctcp-file:%s*" name)))
341 (buffer-disable-undo)
342 (set-buffer-multibyte nil)
346 (defun liece-file-cont (prefix name data)
347 "CTCP FILE cont handler."
350 (liece-get-buffer-create
351 (format " *ctcp-file:%s*" name)))
352 (goto-char (point-max))
355 (defun liece-file-end (prefix name data)
356 "CTCP FILE cont handler."
359 (liece-get-buffer-create
360 (format " *ctcp-file:%s*" name)))
361 (goto-char (point-max))
363 (liece-quote-decode-region (point-min)(point-max))
364 (goto-char (point-min))
365 (when (or (null liece-file-confirm-save)
366 (y-or-n-p "Save file? "))
367 (or (file-directory-p liece-ctcp-file-save-directory)
368 (make-directory liece-ctcp-file-save-directory))
369 (write-region-as-binary
370 (point-min)(point-max)
372 (file-name-nondirectory
373 (concat name "-" prefix))
374 liece-ctcp-file-save-directory))
375 (kill-buffer (current-buffer)))))
377 (defun liece-ctcp-version-insert (buffer prefix name
378 &optional version environment)
380 (setq buffer (list buffer)))
382 (concat (format liece-ctcp-message
387 (concat (format liece-ctcp-message
391 (concat " " environment))
394 (defun liece-ctcp-version-notice (prefix rest)
395 "CTCP VERSION reply handler."
397 (liece-message (_ "Empty CLIENT version notice from \"%s\".") prefix)
399 ((string-match "^\\([^:]*\\):\\([^:]+\\):?\\([^:]*\\)" rest)
400 (liece-ctcp-version-insert liece-ctcp-buffer
401 prefix (match-string 1 rest)
402 (match-string 2 rest)
403 (match-string 3 rest)))
404 ((string-match "^\\([^:]*\\):\\(.*\\)" rest)
405 (liece-ctcp-version-insert liece-ctcp-buffer
406 prefix (match-string 1 rest)))
408 (liece-ctcp-version-insert liece-ctcp-buffer prefix rest)))))
410 (defun liece-ctcp-clientinfo-notice (prefix rest)
411 "CTCP CLIENTINFO reply handler."
412 (liece-insert liece-ctcp-buffer
413 (format (concat liece-ctcp-message "\n")
414 "CLIENTINFO" prefix rest)))
416 (defun liece-ctcp-userinfo-notice (prefix rest)
417 "CTCP USERINFO reply handler."
418 (liece-insert liece-ctcp-buffer
419 (format (concat liece-ctcp-message "\n")
420 "USERINFO" prefix rest)))
422 (defun liece-ctcp-help-notice (prefix rest)
423 "CTCP HELP reply handler."
424 (liece-insert liece-ctcp-buffer
425 (format (concat liece-ctcp-message "\n")
426 "HELP" prefix rest)))
428 (defun liece-ctcp-x-face-notice (prefix rest)
429 "CTCP X-FACE reply handler."
430 (let ((buffer liece-ctcp-buffer))
432 (format liece-ctcp-message
434 (if (and liece-use-x-face
435 (string-match "[^ \t]" rest))
437 buffer (replace-in-string rest "[ \t\r\n]+" "") prefix)
438 (liece-insert buffer rest))
439 (let (liece-display-time)
440 (liece-insert buffer "\n"))))
442 (defun liece-ctcp-errmsg-notice (prefix rest)
443 "CTCP ERRMSG reply handler."
444 (liece-insert liece-ctcp-buffer
445 (format (concat liece-ctcp-message "\n")
446 "ERRMSG" prefix rest)))
448 (defun liece-ctcp-comment-notice (from rest)
449 "CTCP COMMENT reply handler."
450 (liece-insert liece-ctcp-buffer
451 (format (concat liece-ctcp-message "\n")
452 "COMMENT" from rest))
453 (liece-message "COMMENT query from %s." from))
455 (defmacro liece-ctcp-prepare-ping-seconds (timenow)
456 `(format (_ "%d sec")
457 (+ (* 65536 (- (car ,timenow) (car liece-ctcp-ping-time)))
458 (- (cadr ,timenow) (cadr liece-ctcp-ping-time)))))
460 (defun liece-ctcp-ping-notice (from rest)
461 "CTCP PING reply handler."
462 (let ((timenow (current-time)))
463 (liece-insert liece-ctcp-buffer
464 (format (concat liece-ctcp-message "\n")
466 (liece-ctcp-prepare-ping-seconds timenow)))))
468 (defun liece-ctcp-time-notice (from rest)
469 "CTCP TIME reply handler."
470 (liece-insert liece-ctcp-buffer
471 (format (concat liece-ctcp-message "\n")
474 (defmacro liece-complete-client ()
475 '(let ((completion-ignore-case t) (nick liece-ctcp-last-nick))
476 (liece-minibuffer-completing-read
477 (_ "Whose client: ") liece-nick-alist nil nil nil nil
478 (if nick (liece-channel-virtual nick)))))
480 (defun liece-minibuffer-complete-client-query ()
485 (lambda (symbol) (downcase (symbol-name symbol)))
486 liece-ctcp-supported-symbols))))
487 (candidate (liece-minibuffer-prepare-candidate))
488 (completion (try-completion candidate alist))
489 (all (all-completions candidate alist)))
490 (liece-minibuffer-finalize-completion completion candidate all)))
492 (defmacro liece-complete-query ()
493 '(let ((completion-ignore-case t)
494 (liece-minibuffer-complete-function
495 (function liece-minibuffer-complete-client-query)))
496 (read-from-minibuffer
497 (_ "Which query: ") liece-ctcp-last-command
498 liece-minibuffer-map)))
500 (defun liece-ctcp-make-command-wrapper (symbol)
501 (fset (intern (format "liece-command-ctcp-%s" symbol))
503 (interactive (list (liece-complete-client)))
504 (setq client (liece-channel-real client)
505 liece-ctcp-last-nick client
506 ,@(if (eq symbol 'ping)
507 '(liece-ctcp-ping-time
509 (liece-send "PRIVMSG %s :\001%s\001"
510 client (upcase (symbol-name ',symbol))))))
512 (dolist (symbol liece-ctcp-supported-symbols)
513 (liece-ctcp-make-command-wrapper symbol))
515 (defun liece-command-ctcp-action (&optional arg)
518 (if current-prefix-arg
519 (list current-prefix-arg)))
520 (let ((completion-ignore-case t)
521 (liece-message-type 'action)
524 (setq liece-privmsg-partner
525 (liece-channel-virtual
526 (liece-minibuffer-completing-read
528 (append liece-nick-alist liece-channel-alist)
529 nil nil nil nil liece-privmsg-partner))))
531 (setq message (buffer-substring (point)(progn (end-of-line)(point))))
532 (if (string= message "")
533 (setq message (read-string "Action: "))
535 (liece-send "PRIVMSG %s :\001ACTION %s\001"
537 liece-privmsg-partner
538 (liece-channel-real liece-current-channel))
541 (liece-own-private-message message)
542 (liece-own-channel-message message))))
544 (define-obsolete-function-alias 'liece-command-send-action
545 'liece-command-ctcp-action)
547 (defun liece-command-ctcp-generic (nick command)
548 "Ask about someones client clientinfo."
549 (interactive (list (liece-complete-client) (liece-complete-query)))
550 (setq nick (liece-channel-real nick)
551 liece-ctcp-last-nick nick
552 liece-ctcp-last-command command)
553 (if (string-equal-ignore-case liece-ctcp-last-command "ping")
554 (setq liece-ctcp-ping-time (current-time)))
555 (liece-send "PRIVMSG %s :\001%s\001" nick command))
557 (defun liece-command-ctcp-userinfo-from-minibuffer (info)
558 "Ask about someones client clientinfo."
560 (list (read-from-minibuffer "New userinfo: " liece-ctcp-userinfo)))
561 (setq liece-ctcp-userinfo info))
563 (defun liece-command-ctcp-x-face-from-xbm-file (file)
564 (interactive "fXBM File: ")
566 (and (file-exists-p file) (file-readable-p file)
567 (setq data (liece-x-face-encode file))
568 (setq liece-ctcp-x-face
569 (replace-in-string (cadr (nth 3 data)) "[ \t\n]" "")))))
571 (defun liece-command-send-file (file to)
572 "Send a file to given user."
573 (interactive "fFile name: \nsTo whom: ")
575 (set-buffer (liece-get-buffer-create (format " *ctcp-file:%s*" file)))
576 (buffer-disable-undo)
577 (set-buffer-multibyte nil)
579 (insert-file-contents-as-binary file)
580 (liece-quote-encode-region (point-min)(point-max))
581 (goto-char (point-min))
582 (let ((bound (min (point-max) (+ 80 (point))))
583 (liece-mime-charset-for-write 'binary))
585 "NOTICE %s :\001FILE START %s :%s\001"
586 to file (buffer-substring (point) bound))
589 (if (= 1 (mod (point) 800))
591 (setq bound (min (point-max) (+ 80 (point))))
592 (liece-send "NOTICE %s :\001FILE CONT %s :%s\001"
593 to file (buffer-substring (point) bound))
595 (liece-send "NOTICE %s :\001FILE END %s : \001" to file)
596 (kill-buffer (current-buffer))))
598 (provide 'liece-ctcp)
600 ;;; liece-ctcp.el ends here