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 (condition-case nil
137 (run-hook-with-args-until-success hook from chnl data)
139 (return-from liece-ctcp-message rest))
141 (liece-handler-find-function
142 message '(from chnl data) "ctcp-message")))
144 (funcall func from chnl data)
145 (liece-ctcp-messages message from chnl data))
146 (ignore-errors (run-hook-with-args after-hook from chnl data)))
149 (defun liece-ctcp-messages (message from chnl rest)
150 (liece-send "NOTICE %s :\001ERRMSG %s :%s\001"
151 from (upcase message)
152 (format liece-ctcp-error-message
154 (setq chnl (liece-channel-virtual chnl))
155 (liece-ctcp-insert (upcase message) from chnl rest))
157 (defun liece-ctcp-action-message (from chnl rest)
158 "CTCP ACTION handler."
159 (let ((liece-message-target (liece-channel-virtual chnl))
160 (liece-message-speaker from)
161 (liece-message-type 'action))
162 (liece-display-message rest)))
164 (defun liece-ctcp-insert (message from &optional chnl rest)
166 (liece-nick-equal chnl liece-real-nickname))
167 (liece-message "%s query from %s." message from)
168 (liece-message "%s query from %s (%s)." message from chnl)
170 (liece-pick-buffer chnl)
171 (format "%s query from %s%s\n"
172 message from (if rest (concat ":" rest) "")))))
174 (defun liece-ctcp-version-message (from chnl rest)
175 "CTCP VERSION handler."
176 (liece-send "NOTICE %s :\001VERSION %s :\001"
177 from (liece-version))
178 (setq chnl (liece-channel-virtual chnl))
179 (liece-ctcp-insert "VERSION" from chnl rest))
181 (defun liece-ctcp-userinfo-message (from chnl rest)
182 "CTCP USERINFO handler."
183 (liece-send "NOTICE %s :\001USERINFO %s\001"
184 from liece-ctcp-userinfo)
185 (setq chnl (liece-channel-virtual chnl))
186 (liece-ctcp-insert "USERINFO" from chnl))
188 (defun liece-ctcp-clientinfo-message (from chnl rest)
189 "CTCP CLIENTINFO handler."
190 (liece-send "NOTICE %s :\001CLIENTINFO %s\001"
194 (lambda (symbol) (upcase (symbol-name symbol)))
195 liece-ctcp-supported-symbols " ")))
196 (setq chnl (liece-channel-virtual chnl))
197 (liece-ctcp-insert "CLIENTINFO" from chnl))
199 (defvar liece-ctcp-help-message
200 "This is a help message for CTCP requests.
201 \"VERSION\" gives version of this client.
202 \"USERINFO\" gives user supplied information if any.
203 \"CLIENTINFO\" gives commands this client knows.
204 \"PING\" returns the arguments it receives.
205 \"TIME\" tells you the time on the user's host.
206 \"FILE\" send a small file via IRC messages.
207 \"X-FACE\" gives you user supplied X-Face.
208 \"COMMENT\" returns string sent by other person.
209 \"HELP\" gives this help message"
210 "Help message for CTCP requests.")
212 (defun liece-ctcp-help-message (from chnl rest)
215 "NOTICE %s :\001HELP %s\001"
216 from (liece-quote-encode-string liece-ctcp-help-message))
217 (setq chnl (liece-channel-virtual chnl))
218 (liece-ctcp-insert "HELP" from chnl))
220 (defun liece-ctcp-comment-message (from chnl rest)
221 "CTCP COMMENT handler."
222 (setq chnl (liece-channel-virtual chnl))
223 (liece-ctcp-insert "COMMENT" from chnl))
225 (defun liece-ctcp-ping-message (from chnl rest)
227 (liece-send "NOTICE %s :\001PING %s\001" from rest)
228 (setq chnl (liece-channel-virtual chnl))
229 (liece-ctcp-insert "PING" from chnl))
231 (defun liece-ctcp-time-message (from chnl rest)
233 (liece-send "NOTICE %s :\001TIME %s\001"
234 from (funcall liece-format-time-function
236 (setq chnl (liece-channel-virtual chnl))
237 (liece-ctcp-insert "TIME" from chnl))
239 (defun liece-ctcp-x-face-message (from chnl rest)
240 "CTCP X-FACE handler."
241 (liece-send "NOTICE %s :\001X-FACE %s\001"
242 from liece-ctcp-x-face)
243 (setq chnl (liece-channel-virtual chnl))
244 (liece-ctcp-insert "X-FACE" from chnl))
246 (liece-handler-define-backend "ctcp-notice")
248 (defmacro liece-register-ctcp-notice-handler (name)
249 `(liece-handler-define-function
250 ,name '(prefix rest "ctcp-notice")
251 ',(intern (format "liece-ctcp-%s-notice" name))))
253 (liece-register-ctcp-notice-handler "version")
254 (liece-register-ctcp-notice-handler "userinfo")
255 (liece-register-ctcp-notice-handler "clientinfo")
256 (liece-register-ctcp-notice-handler "ping")
257 (liece-register-ctcp-notice-handler "time")
258 (liece-register-ctcp-notice-handler "file")
259 (liece-register-ctcp-notice-handler "x-face")
260 (liece-register-ctcp-notice-handler "comment")
261 (liece-register-ctcp-notice-handler "help")
262 (liece-register-ctcp-notice-handler "dcc")
263 (liece-register-ctcp-notice-handler "errmsg")
265 (defun* liece-ctcp-notice (prefix rest)
266 (or (string-match "^\\([^\001]*\\)\001\\([^\001]*\\)\001" rest)
267 (return-from liece-ctcp-notice))
268 (let (hook after-hook data message)
269 (setq data (match-string 2 rest)
271 (match-string 1 rest)
272 (substring rest (match-end 0))))
273 (if (string-match "^\\([^ ]*\\) *:?" data)
274 (setq message (downcase (match-string 1 data))
275 data (substring data (match-end 0)))
276 (setq message "errmsg"
277 data (_ "Couldn't figure out what was said.")))
280 (concat "liece-ctcp-" message "-notice-hook"))
283 (concat "liece-after-ctcp-" message "-notice-hook")))
284 (if (condition-case nil
285 (run-hook-with-args-until-success hook prefix data)
287 (return-from liece-ctcp-notice rest))
289 (liece-handler-find-function
290 message '(prefix data) "ctcp-notice")))
292 (funcall func prefix data)
293 (liece-ctcp-notices message prefix data)))
294 (ignore-errors (run-hook-with-args after-hook prefix data))
297 (defun liece-ctcp-notices (message prefix rest)
299 (_ "Unknown ctcp notice \":%s %s %s\"")
300 prefix (upcase message) rest))
302 (liece-handler-define-backend "ctcp-file")
304 (defmacro liece-register-file-handler (name)
305 `(liece-handler-define-function
306 ,name '(prefix name data "ctcp-file")
307 ',(intern (format "liece-file-%s" name))))
309 (liece-register-file-handler "start")
310 (liece-register-file-handler "cont")
311 (liece-register-file-handler "end")
313 (defun* liece-ctcp-file-notice (prefix rest)
314 (when liece-file-accept
315 (multiple-value-bind (message name data)
316 (liece-split-line rest)
317 (setq message (downcase message))
320 (concat "liece-file-" message "-hook")))
323 (concat "liece-after-file-" message "-hook")))
325 (if (condition-case nil
326 (run-hook-with-args-until-success hook prefix name)
328 (return-from liece-ctcp-file-notice))
329 (setq func (liece-handler-find-function
330 message '(prefix name data) 'ctcp-file))
332 (funcall func prefix name data)
333 (liece-file-notices message prefix name data))
334 (ignore-errors (run-hook-with-args after-hook prefix name))))))
336 (defun liece-file-notices (message prefix name data)
338 (_ "Unknown FILE message \":%s %s %s %s\"")
339 prefix (upcase message) name data))
341 (defun liece-file-start (prefix name data)
342 "CTCP FILE start handler."
345 (liece-get-buffer-create
346 (format " *ctcp-file:%s*" name)))
347 (buffer-disable-undo)
348 (set-buffer-multibyte nil)
352 (defun liece-file-cont (prefix name data)
353 "CTCP FILE cont handler."
356 (liece-get-buffer-create
357 (format " *ctcp-file:%s*" name)))
358 (goto-char (point-max))
361 (defun liece-file-end (prefix name data)
362 "CTCP FILE cont handler."
365 (liece-get-buffer-create
366 (format " *ctcp-file:%s*" name)))
367 (goto-char (point-max))
369 (liece-quote-decode-region (point-min)(point-max))
370 (goto-char (point-min))
371 (when (or (null liece-file-confirm-save)
372 (y-or-n-p "Save file? "))
373 (or (file-directory-p liece-ctcp-file-save-directory)
374 (make-directory liece-ctcp-file-save-directory))
375 (write-region-as-binary
376 (point-min)(point-max)
378 (file-name-nondirectory
379 (concat name "-" prefix))
380 liece-ctcp-file-save-directory))
381 (kill-buffer (current-buffer)))))
383 (defun liece-ctcp-version-insert (buffer prefix name
384 &optional version environment)
386 (setq buffer (list buffer)))
388 (concat (format liece-ctcp-message
393 (concat (format liece-ctcp-message
397 (concat " " environment))
400 (defun liece-ctcp-version-notice (prefix rest)
401 "CTCP VERSION reply handler."
403 (liece-message (_ "Empty CLIENT version notice from \"%s\".") prefix)
405 ((string-match "^\\([^:]*\\):\\([^:]+\\):?\\([^:]*\\)" rest)
406 (liece-ctcp-version-insert liece-ctcp-buffer
407 prefix (match-string 1 rest)
408 (match-string 2 rest)
409 (match-string 3 rest)))
410 ((string-match "^\\([^:]*\\):\\(.*\\)" rest)
411 (liece-ctcp-version-insert liece-ctcp-buffer
412 prefix (match-string 1 rest)))
414 (liece-ctcp-version-insert liece-ctcp-buffer prefix rest)))))
416 (defun liece-ctcp-clientinfo-notice (prefix rest)
417 "CTCP CLIENTINFO reply handler."
418 (liece-insert liece-ctcp-buffer
419 (format (concat liece-ctcp-message "\n")
420 "CLIENTINFO" prefix rest)))
422 (defun liece-ctcp-userinfo-notice (prefix rest)
423 "CTCP USERINFO reply handler."
424 (liece-insert liece-ctcp-buffer
425 (format (concat liece-ctcp-message "\n")
426 "USERINFO" prefix rest)))
428 (defun liece-ctcp-help-notice (prefix rest)
429 "CTCP HELP reply handler."
430 (liece-insert liece-ctcp-buffer
431 (format (concat liece-ctcp-message "\n")
432 "HELP" prefix rest)))
434 (defun liece-ctcp-x-face-notice (prefix rest)
435 "CTCP X-FACE reply handler."
436 (let ((buffer liece-ctcp-buffer))
438 (format liece-ctcp-message
440 (if (and liece-use-x-face
441 (string-match "[^ \t]" rest))
443 buffer (replace-in-string rest "[ \t\r\n]+" "") prefix)
444 (liece-insert buffer rest))
445 (let (liece-display-time)
446 (liece-insert buffer "\n"))))
448 (defun liece-ctcp-errmsg-notice (prefix rest)
449 "CTCP ERRMSG reply handler."
450 (liece-insert liece-ctcp-buffer
451 (format (concat liece-ctcp-message "\n")
452 "ERRMSG" prefix rest)))
454 (defun liece-ctcp-comment-notice (from rest)
455 "CTCP COMMENT reply handler."
456 (liece-insert liece-ctcp-buffer
457 (format (concat liece-ctcp-message "\n")
458 "COMMENT" from rest))
459 (liece-message "COMMENT query from %s." from))
461 (defmacro liece-ctcp-prepare-ping-seconds (timenow)
462 `(format (_ "%d sec")
463 (+ (* 65536 (- (car ,timenow) (car liece-ctcp-ping-time)))
464 (- (cadr ,timenow) (cadr liece-ctcp-ping-time)))))
466 (defun liece-ctcp-ping-notice (from rest)
467 "CTCP PING reply handler."
468 (let ((timenow (current-time)))
469 (liece-insert liece-ctcp-buffer
470 (format (concat liece-ctcp-message "\n")
472 (liece-ctcp-prepare-ping-seconds timenow)))))
474 (defun liece-ctcp-time-notice (from rest)
475 "CTCP TIME reply handler."
476 (liece-insert liece-ctcp-buffer
477 (format (concat liece-ctcp-message "\n")
480 (defmacro liece-complete-client ()
481 '(let ((completion-ignore-case t) (nick liece-ctcp-last-nick))
482 (liece-minibuffer-completing-default-read
483 (_ "Whose client: ") liece-nick-alist nil nil
484 (if nick (liece-channel-virtual nick)))))
486 (defun liece-minibuffer-complete-client-query ()
491 (lambda (symbol) (downcase (symbol-name symbol)))
492 liece-ctcp-supported-symbols))))
493 (candidate (liece-minibuffer-prepare-candidate))
494 (completion (try-completion candidate alist))
495 (all (all-completions candidate alist)))
496 (liece-minibuffer-finalize-completion completion candidate all)))
498 (defmacro liece-complete-query ()
499 '(let ((completion-ignore-case t)
500 (liece-minibuffer-complete-function
501 (function liece-minibuffer-complete-client-query)))
502 (read-from-minibuffer
503 (_ "Which query: ") liece-ctcp-last-command
504 liece-minibuffer-map)))
506 (defun liece-ctcp-make-command-wrapper (symbol)
507 (fset (intern (format "liece-command-ctcp-%s" symbol))
509 (interactive (list (liece-complete-client)))
510 (setq client (liece-channel-real client)
511 liece-ctcp-last-nick client
512 ,@(if (eq symbol 'ping)
513 '(liece-ctcp-ping-time
515 (liece-send "PRIVMSG %s :\001%s\001"
516 client (upcase (symbol-name ,symbol))))))
518 (dolist (symbol liece-ctcp-supported-symbols)
519 (liece-ctcp-make-command-wrapper symbol))
521 (defun liece-command-ctcp-action (&optional arg)
524 (if current-prefix-arg
525 (list current-prefix-arg)))
526 (let ((completion-ignore-case t)
527 (liece-message-type 'action)
530 (setq liece-privmsg-partner
531 (liece-channel-virtual
532 (liece-minibuffer-completing-default-read
534 (append liece-nick-alist liece-channel-alist)
535 nil nil liece-privmsg-partner))))
537 (setq message (buffer-substring (point)(progn (end-of-line)(point))))
538 (if (string= message "")
539 (setq message (read-string "Action: "))
541 (liece-send "PRIVMSG %s :\001ACTION %s\001"
543 liece-privmsg-partner
544 (liece-channel-real liece-current-channel))
547 (liece-own-private-message message)
548 (liece-own-channel-message message))))
550 (define-obsolete-function-alias 'liece-command-send-action
551 'liece-command-ctcp-action)
554 (defun liece-command-ctcp-generic (nick command)
555 "Ask about someones client clientinfo."
556 (interactive (list (liece-complete-client) (liece-complete-query)))
557 (setq nick (liece-channel-real nick)
558 liece-ctcp-last-nick nick
559 liece-ctcp-last-command command)
560 (if (string-equal-ignore-case liece-ctcp-last-command "ping")
561 (setq liece-ctcp-ping-time (current-time)))
562 (liece-send "PRIVMSG %s :\001%s\001%s" nick command))
565 (defun liece-command-ctcp-userinfo-from-minibuffer (info)
566 "Ask about someones client clientinfo."
568 (list (read-from-minibuffer "New userinfo: " liece-ctcp-userinfo)))
569 (setq liece-ctcp-userinfo info))
572 (defun liece-command-ctcp-x-face-from-xbm-file (file)
573 (interactive "fXBM File: ")
575 (and (file-exists-p file) (file-readable-p file)
576 (setq data (liece-x-face-encode file))
577 (setq liece-ctcp-x-face
578 (replace-in-string (cadr (nth 3 data)) "[ \t\n]" "")))))
581 (defun liece-command-send-file (file to)
582 "Send a file to given user."
583 (interactive "fFile name: \nsTo whom: ")
585 (set-buffer (liece-get-buffer-create (format " *ctcp-file:%s*" file)))
586 (buffer-disable-undo)
587 (set-buffer-multibyte nil)
589 (insert-file-contents-as-binary file)
590 (liece-quote-encode-region (point-min)(point-max))
591 (goto-char (point-min))
592 (let ((bound (min (point-max) (+ 80 (point))))
593 (liece-mime-charset-for-write 'binary))
595 "NOTICE %s :\001FILE START %s :%s\001"
596 to file (buffer-substring (point) bound))
599 (if (= 1 (mod (point) 800))
601 (setq bound (min (point-max) (+ 80 (point))))
602 (liece-send "NOTICE %s :\001FILE CONT %s :%s\001"
603 to file (buffer-substring (point) bound))
605 (liece-send "NOTICE %s :\001FILE END %s : \001" to file)
606 (kill-buffer (current-buffer))))
608 (provide 'liece-ctcp)
610 ;;; liece-ctcp.el ends here