lisp/liece-ctcp.el

   1 ;;; liece-ctcp.el --- CTCP handlers and commands.
   2 ;; Copyright (C) 1998-2000 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Revised: 1998-11-25
   7 ;; Keywords: IRC, liece, CTCP
   8
   9 ;; This file is part of Liece.
  10
  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)
  14 ;; any later version.
  15
  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.
  20
  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.
  25
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31
  32 (eval-when-compile (require 'liece-inlines))
  33
  34 (require 'liece-handler)
  35
  36 (require 'pccl)
  37
  38 (if-broken ccl-usable
  39     (require 'liece-q-el)
  40   (require 'liece-q-ccl))
  41
  42 (require 'liece-x-face)
  43
  44 (autoload 'liece-ctcp-dcc-message "liece-dcc")
  45
  46 (eval-and-compile
  47   (defconst liece-ctcp-supported-symbols
  48     '(version userinfo clientinfo ping time x-face comment help)))
  49
  50 (defun liece-ctcp-make-menu-command-wrapper (symbol)
  51   (fset (intern (format "liece-menu-callback-ctcp-%s" symbol))
  52         `(lambda ()
  53            (interactive)
  54            (dolist (nick liece-nick-region-nicks)
  55              (funcall (symbol-function
  56                        (intern (format "liece-command-ctcp-%s" ',symbol)))
  57                       nick)))))
  58
  59 (dolist (symbol liece-ctcp-supported-symbols)
  60   (liece-ctcp-make-menu-command-wrapper symbol))
  61
  62 (defvar liece-ctcp-message
  63   (eval-when-compile
  64     (concat liece-client-prefix "%s(%s) = %s"))
  65   "Message in which info of other clients is displayed.")
  66
  67 (defvar liece-ctcp-buffer (append liece-D-buffer liece-O-buffer))
  68
  69 (defvar liece-ctcp-ping-time '(0 0 0))
  70
  71 (defvar liece-ctcp-last-command nil
  72   "The last command executed.")
  73
  74 (defvar liece-ctcp-last-nick nil
  75   "The last nick being queried.")
  76
  77 (defconst liece-ctcp-error-message "Unrecognized command: '%s'"
  78   "Error message given to anyone asking wrong CLIENT data.")
  79
  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))
  83   nil)
  84
  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)))
  88
  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)
  91
  92 (defcustom liece-ctcp-file-save-directory liece-directory
  93   "Directory to save received files."
  94   :type 'directory
  95   :group 'liece-ctcp)
  96
  97 (liece-handler-define-backend "ctcp-message")
  98
  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))))
 103
 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")
 116
 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)
 122           rest (concat
 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.")))
 130     (setq hook
 131           (intern-soft
 132            (concat "liece-ctcp-" message "-hook"))
 133           after-hook
 134           (intern-soft
 135            (concat "liece-after-ctcp-" message "-hook")))
 136     (if (condition-case nil
 137             (run-hook-with-args-until-success hook from chnl data)
 138           (error nil))
 139         (return-from liece-ctcp-message rest))
 140     (let ((func
 141            (liece-handler-find-function
 142             message '(from chnl data) "ctcp-message")))
 143       (if func
 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)))
 147     rest))
 148
 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
 153                        (upcase message)))
 154   (setq chnl (liece-channel-virtual chnl))
 155   (liece-ctcp-insert (upcase message) from chnl rest))
 156
 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)))
 163
 164 (defun liece-ctcp-insert (message from &optional chnl rest)
 165   (if (or (null chnl)
 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)
 169     (liece-insert-client
 170      (liece-pick-buffer chnl)
 171      (format "%s query from %s%s\n"
 172              message from (if rest (concat ":" rest) "")))))
 173
 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))
 180
 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))
 187
 188 (defun liece-ctcp-clientinfo-message (from chnl rest)
 189   "CTCP CLIENTINFO handler."
 190   (liece-send "NOTICE %s :\001CLIENTINFO %s\001"
 191               from
 192               (eval-when-compile
 193                 (mapconcat
 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))
 198
 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.")
 211
 212 (defun liece-ctcp-help-message (from chnl rest)
 213   "CTCP HELP handler."
 214   (liece-send
 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))
 219
 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))
 224
 225 (defun liece-ctcp-ping-message (from chnl rest)
 226   "CTCP PING handler."
 227   (liece-send "NOTICE %s :\001PING %s\001" from rest)
 228   (setq chnl (liece-channel-virtual chnl))
 229   (liece-ctcp-insert "PING" from chnl))
 230
 231 (defun liece-ctcp-time-message (from chnl rest)
 232   "CTCP TIME handler."
 233   (liece-send "NOTICE %s :\001TIME %s\001"
 234               from (funcall liece-format-time-function
 235                             (current-time)))
 236   (setq chnl (liece-channel-virtual chnl))
 237   (liece-ctcp-insert "TIME" from chnl))
 238
 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))
 245
 246 (liece-handler-define-backend "ctcp-notice")
 247
 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))))
 252
 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")
 264
 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)
 270           rest (concat
 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.")))
 278     (setq hook
 279           (intern-soft
 280            (concat "liece-ctcp-" message "-notice-hook"))
 281           after-hook
 282           (intern-soft
 283            (concat "liece-after-ctcp-" message "-notice-hook")))
 284     (if (condition-case nil
 285             (run-hook-with-args-until-success hook prefix data)
 286           (error nil))
 287         (return-from liece-ctcp-notice rest))
 288     (let ((func
 289            (liece-handler-find-function
 290             message '(prefix data) "ctcp-notice")))
 291       (if func
 292           (funcall func prefix data)
 293         (liece-ctcp-notices message prefix data)))
 294     (ignore-errors (run-hook-with-args after-hook prefix data))
 295     rest))
 296
 297 (defun liece-ctcp-notices (message prefix rest)
 298   (liece-message
 299    (_ "Unknown ctcp notice \":%s %s %s\"")
 300    prefix (upcase message) rest))
 301
 302 (liece-handler-define-backend "ctcp-file")
 303
 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))))
 308
 309 (liece-register-file-handler "start")
 310 (liece-register-file-handler "cont")
 311 (liece-register-file-handler "end")
 312
 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))
 318       (let ((hook
 319              (intern-soft
 320               (concat "liece-file-" message "-hook")))
 321             (after-hook
 322              (intern-soft
 323               (concat "liece-after-file-" message "-hook")))
 324             func)
 325         (if (condition-case nil
 326                 (run-hook-with-args-until-success hook prefix name)
 327               (error nil))
 328             (return-from liece-ctcp-file-notice))
 329         (setq func (liece-handler-find-function
 330                     message '(prefix name data) 'ctcp-file))
 331         (if func
 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))))))
 335
 336 (defun liece-file-notices (message prefix name data)
 337   (liece-message
 338    (_ "Unknown FILE message \":%s %s %s %s\"")
 339    prefix (upcase message) name data))
 340
 341 (defun liece-file-start (prefix name data)
 342   "CTCP FILE start handler."
 343   (save-excursion
 344     (set-buffer
 345      (liece-get-buffer-create
 346       (format " *ctcp-file:%s*" name)))
 347     (buffer-disable-undo)
 348     (set-buffer-multibyte nil)
 349     (erase-buffer)
 350     (insert data)))
 351
 352 (defun liece-file-cont (prefix name data)
 353   "CTCP FILE cont handler."
 354   (save-excursion
 355     (set-buffer
 356      (liece-get-buffer-create
 357       (format " *ctcp-file:%s*" name)))
 358     (goto-char (point-max))
 359     (insert data)))
 360
 361 (defun liece-file-end (prefix name data)
 362   "CTCP FILE cont handler."
 363   (save-excursion
 364     (set-buffer
 365      (liece-get-buffer-create
 366       (format " *ctcp-file:%s*" name)))
 367     (goto-char (point-max))
 368     (insert data)
 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)
 377        (expand-file-name
 378         (file-name-nondirectory
 379          (concat name "-" prefix))
 380         liece-ctcp-file-save-directory))
 381       (kill-buffer (current-buffer)))))
 382
 383 (defun liece-ctcp-version-insert (buffer prefix name
 384                                          &optional version environment)
 385   (or (listp buffer)
 386       (setq buffer (list buffer)))
 387   (liece-insert buffer
 388                 (concat (format liece-ctcp-message
 389                                 "VERSION" prefix "")
 390                         name "\n"))
 391   (when version
 392     (liece-insert buffer
 393                   (concat (format liece-ctcp-message
 394                                   "VERSION" prefix "")
 395                           "\t" version
 396                           (if environment
 397                               (concat " " environment))
 398                           "\n"))))
 399
 400 (defun liece-ctcp-version-notice (prefix rest)
 401   "CTCP VERSION reply handler."
 402   (if (null rest)
 403       (liece-message (_ "Empty CLIENT version notice from \"%s\".") prefix)
 404     (cond
 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)))
 413      (t
 414       (liece-ctcp-version-insert liece-ctcp-buffer prefix rest)))))
 415
 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)))
 421
 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)))
 427
 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)))
 433
 434 (defun liece-ctcp-x-face-notice (prefix rest)
 435   "CTCP X-FACE reply handler."
 436   (let ((buffer liece-ctcp-buffer))
 437     (liece-insert buffer
 438                    (format liece-ctcp-message
 439                            "X-FACE" prefix ""))
 440     (if (and liece-use-x-face
 441              (string-match "[^ \t]" rest))
 442         (liece-x-face-insert
 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"))))
 447
 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)))
 453
 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))
 460
 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)))))
 465
 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")
 471                            "PING" from
 472                            (liece-ctcp-prepare-ping-seconds timenow)))))
 473
 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")
 478                         "TIME" from rest)))
 479
 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)))))
 485
 486 (defun liece-minibuffer-complete-client-query ()
 487   (let* ((alist
 488           (eval-when-compile
 489             (list-to-alist
 490              (mapcar
 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)))
 497
 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)))
 505
 506 (defun liece-ctcp-make-command-wrapper (symbol)
 507   (fset (intern (format "liece-command-ctcp-%s" symbol))
 508         `(lambda (client)
 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
 514                          (current-time))))
 515            (liece-send "PRIVMSG %s :\001%s\001"
 516                        client (upcase (symbol-name ',symbol))))))
 517
 518 (dolist (symbol liece-ctcp-supported-symbols)
 519   (liece-ctcp-make-command-wrapper symbol))
 520
 521 (defun liece-command-ctcp-action (&optional arg)
 522   "Send CTCP action."
 523   (interactive
 524    (if current-prefix-arg
 525        (list current-prefix-arg)))
 526   (let ((completion-ignore-case t)
 527         (liece-message-type 'action)
 528         message)
 529     (if arg
 530         (setq liece-privmsg-partner
 531               (liece-channel-virtual
 532                (liece-minibuffer-completing-default-read
 533                 (_ "To whom: ")
 534                 (append liece-nick-alist liece-channel-alist)
 535                 nil nil liece-privmsg-partner))))
 536     (beginning-of-line)
 537     (setq message (buffer-substring (point)(progn (end-of-line)(point))))
 538     (if (string= message "")
 539         (setq message (read-string "Action: "))
 540       (liece-next-line 1))
 541     (liece-send "PRIVMSG %s :\001ACTION %s\001"
 542                  (if arg
 543                      liece-privmsg-partner
 544                    (liece-channel-real liece-current-channel))
 545                  message)
 546     (if arg
 547         (liece-own-private-message message)
 548       (liece-own-channel-message message))))
 549
 550 (define-obsolete-function-alias 'liece-command-send-action
 551   'liece-command-ctcp-action)
 552
 553 ;;;###liece-autoload
 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" nick command))
 563
 564 ;;;###liece-autoload
 565 (defun liece-command-ctcp-userinfo-from-minibuffer (info)
 566   "Ask about someones client clientinfo."
 567   (interactive
 568    (list (read-from-minibuffer "New userinfo: " liece-ctcp-userinfo)))
 569   (setq liece-ctcp-userinfo info))
 570
 571 ;;;###liece-autoload
 572 (defun liece-command-ctcp-x-face-from-xbm-file (file)
 573   (interactive "fXBM File: ")
 574   (let (data)
 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]" "")))))
 579
 580 ;;;###liece-autoload
 581 (defun liece-command-send-file (file to)
 582   "Send a file to given  user."
 583   (interactive "fFile name: \nsTo whom: ")
 584   (save-excursion
 585     (set-buffer (liece-get-buffer-create (format " *ctcp-file:%s*" file)))
 586     (buffer-disable-undo)
 587     (set-buffer-multibyte nil)
 588     (erase-buffer)
 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))
 594       (liece-send
 595        "NOTICE %s :\001FILE START %s :%s\001"
 596        to file (buffer-substring (point) bound))
 597       (goto-char bound)
 598       (while (not (eobp))
 599         (if (= 1 (mod (point) 800))
 600             (sit-for 1))
 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))
 604         (goto-char bound)))
 605     (liece-send "NOTICE %s :\001FILE END %s : \001" to file)
 606     (kill-buffer (current-buffer))))
 607
 608 (provide 'liece-ctcp)
 609
 610 ;;; liece-ctcp.el ends here