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 (require 'liece-q-el)
  42
  43 (require 'liece-x-face)
  44
  45 (autoload 'liece-ctcp-dcc-message "liece-dcc")
  46
  47 (eval-and-compile
  48   (defconst liece-ctcp-supported-symbols
  49     '(version userinfo clientinfo ping time x-face comment help)))
  50
  51 (defun liece-ctcp-make-menu-command-wrapper (symbol)
  52   (fset (intern (format "liece-menu-callback-ctcp-%s" symbol))
  53         `(lambda ()
  54            (interactive)
  55            (dolist (nick liece-nick-region-nicks)
  56              (funcall (symbol-function
  57                        (intern (format "liece-command-ctcp-%s" ',symbol)))
  58                       nick)))))
  59
  60 (dolist (symbol liece-ctcp-supported-symbols)
  61   (liece-ctcp-make-menu-command-wrapper symbol))
  62
  63 (defvar liece-ctcp-message
  64   (eval-when-compile
  65     (concat liece-client-prefix "%s(%s) = %s"))
  66   "Message in which info of other clients is displayed.")
  67
  68 (defvar liece-ctcp-buffer (append liece-D-buffer liece-O-buffer))
  69
  70 (defvar liece-ctcp-ping-time '(0 0 0))
  71
  72 (defvar liece-ctcp-last-command nil
  73   "The last command executed.")
  74
  75 (defvar liece-ctcp-last-nick nil
  76   "The last nick being queried.")
  77
  78 (defconst liece-ctcp-error-message "Unrecognized command: '%s'"
  79   "Error message given to anyone asking wrong CLIENT data.")
  80
  81 (defun liece-ctcp-last-nick-maybe-change (prefix rest)
  82   (if (equal prefix liece-ctcp-last-nick)
  83       (setq liece-ctcp-last-nick rest))
  84   nil)
  85
  86 (defun liece-ctcp-last-nick-maybe-reset (prefix rest)
  87   (if (equal prefix liece-ctcp-last-nick)
  88       (setq liece-ctcp-last-nick nil)))
  89
  90 (add-hook 'liece-nick-hook 'liece-ctcp-last-nick-maybe-change t)
  91 (add-hook 'liece-quit-hook 'liece-ctcp-last-nick-maybe-reset)
  92
  93 (defcustom liece-ctcp-file-save-directory liece-directory
  94   "Directory to save received files."
  95   :type 'directory
  96   :group 'liece-ctcp)
  97
  98 (liece-handler-define-backend "ctcp-message")
  99
 100 (defmacro liece-register-ctcp-message-handler (name)
 101   `(liece-handler-define-function
 102     ,name '(from chnl data "ctcp-message")
 103     ',(intern (format "liece-ctcp-%s-message" name))))
 104
 105 (liece-register-ctcp-message-handler "version")
 106 (liece-register-ctcp-message-handler "userinfo")
 107 (liece-register-ctcp-message-handler "clientinfo")
 108 (liece-register-ctcp-message-handler "ping")
 109 (liece-register-ctcp-message-handler "time")
 110 (liece-register-ctcp-message-handler "file")
 111 (liece-register-ctcp-message-handler "x-face")
 112 (liece-register-ctcp-message-handler "comment")
 113 (liece-register-ctcp-message-handler "help")
 114 (liece-register-ctcp-message-handler "action")
 115 (liece-register-ctcp-message-handler "dcc")
 116 (liece-register-ctcp-message-handler "errmsg")
 117
 118 (defun* liece-ctcp-message (from chnl rest)
 119   (or (string-match "^\\([^\001]*\\)\001\\([^\001]*\\)\001" rest)
 120       (return-from liece-ctcp-message))
 121   (let (hook after-hook data message)
 122     (setq data (match-string 2 rest)
 123           rest (concat
 124                 (match-string 1 rest)
 125                 (substring rest (match-end 0))))
 126     (if (string-match "^\\([^ ]*\\) *:?" data)
 127         (setq message (downcase (match-string 1 data))
 128               data (substring data (match-end 0)))
 129       (setq message "errmsg"
 130             data (_ "Couldn't figure out what was said.")))
 131     (setq hook
 132           (intern-soft
 133            (concat "liece-ctcp-" message "-hook"))
 134           after-hook
 135           (intern-soft
 136            (concat "liece-after-ctcp-" message "-hook")))
 137     (if (run-hook-with-args-until-success hook from chnl data)
 138         (return-from liece-ctcp-message rest))
 139     (let ((func
 140            (liece-handler-find-function
 141             message '(from chnl data) "ctcp-message")))
 142       (if func
 143           (funcall func from chnl data)
 144         (liece-ctcp-messages message from chnl data))
 145       (run-hook-with-args after-hook from chnl data))
 146     rest))
 147
 148 (defun liece-ctcp-messages (message from chnl rest)
 149   (liece-send "NOTICE %s :\001ERRMSG %s :%s\001"
 150                from (upcase message)
 151                (format liece-ctcp-error-message
 152                        (upcase message)))
 153   (setq chnl (liece-channel-virtual chnl))
 154   (liece-ctcp-insert (upcase message) from chnl rest))
 155
 156 (defun liece-ctcp-action-message (from chnl rest)
 157   "CTCP ACTION handler."
 158   (let ((liece-message-target (liece-channel-virtual chnl))
 159         (liece-message-speaker from)
 160         (liece-message-type 'action))
 161     (liece-display-message rest)))
 162
 163 (defun liece-ctcp-insert (message from &optional chnl rest)
 164   (if (or (null chnl)
 165           (liece-nick-equal chnl liece-real-nickname))
 166       (liece-message "%s query from %s." message from)
 167     (liece-message "%s query from %s (%s)." message from chnl)
 168     (liece-insert-client
 169      (liece-pick-buffer chnl)
 170      (format "%s query from %s%s\n"
 171              message from (if rest (concat ":" rest) "")))))
 172
 173 (defun liece-ctcp-version-message (from chnl rest)
 174   "CTCP VERSION handler."
 175   (liece-send "NOTICE %s :\001VERSION %s :\001"
 176               from (liece-version))
 177   (setq chnl (liece-channel-virtual chnl))
 178   (liece-ctcp-insert "VERSION" from chnl rest))
 179
 180 (defun liece-ctcp-userinfo-message (from chnl rest)
 181   "CTCP USERINFO handler."
 182   (liece-send "NOTICE %s :\001USERINFO %s\001"
 183               from liece-ctcp-userinfo)
 184   (setq chnl (liece-channel-virtual chnl))
 185   (liece-ctcp-insert "USERINFO" from chnl))
 186
 187 (defun liece-ctcp-clientinfo-message (from chnl rest)
 188   "CTCP CLIENTINFO handler."
 189   (liece-send "NOTICE %s :\001CLIENTINFO %s\001"
 190               from
 191               (eval-when-compile
 192                 (mapconcat
 193                  (lambda (symbol) (upcase (symbol-name symbol)))
 194                  liece-ctcp-supported-symbols " ")))
 195   (setq chnl (liece-channel-virtual chnl))
 196   (liece-ctcp-insert "CLIENTINFO" from chnl))
 197
 198 (defvar liece-ctcp-help-message
 199   "This is a help message for CTCP requests.
 200 \"VERSION\" gives version of this client.
 201 \"USERINFO\" gives user supplied information if any.
 202 \"CLIENTINFO\" gives commands this client knows.
 203 \"PING\" returns the arguments it receives.
 204 \"TIME\" tells you the time on the user's host.
 205 \"FILE\" send a small file via IRC messages.
 206 \"X-FACE\" gives you user supplied X-Face.
 207 \"COMMENT\" returns string sent by other person.
 208 \"HELP\" gives this help message"
 209   "Help message for CTCP requests.")
 210
 211 (defun liece-ctcp-help-message (from chnl rest)
 212   "CTCP HELP handler."
 213   (liece-send
 214    "NOTICE %s :\001HELP %s\001"
 215    from (liece-quote-encode-string liece-ctcp-help-message))
 216   (setq chnl (liece-channel-virtual chnl))
 217   (liece-ctcp-insert "HELP" from chnl))
 218
 219 (defun liece-ctcp-comment-message (from chnl rest)
 220   "CTCP COMMENT handler."
 221   (setq chnl (liece-channel-virtual chnl))
 222   (liece-ctcp-insert "COMMENT" from chnl))
 223
 224 (defun liece-ctcp-ping-message (from chnl rest)
 225   "CTCP PING handler."
 226   (liece-send "NOTICE %s :\001PING %s\001" from rest)
 227   (setq chnl (liece-channel-virtual chnl))
 228   (liece-ctcp-insert "PING" from chnl))
 229
 230 (defun liece-ctcp-time-message (from chnl rest)
 231   "CTCP TIME handler."
 232   (liece-send "NOTICE %s :\001TIME %s\001"
 233               from (funcall liece-format-time-function
 234                             (current-time)))
 235   (setq chnl (liece-channel-virtual chnl))
 236   (liece-ctcp-insert "TIME" from chnl))
 237
 238 (defun liece-ctcp-x-face-message (from chnl rest)
 239   "CTCP X-FACE handler."
 240   (liece-send "NOTICE %s :\001X-FACE %s\001"
 241               from liece-ctcp-x-face)
 242   (setq chnl (liece-channel-virtual chnl))
 243   (liece-ctcp-insert "X-FACE" from chnl))
 244
 245 (liece-handler-define-backend "ctcp-notice")
 246
 247 (defmacro liece-register-ctcp-notice-handler (name)
 248   `(liece-handler-define-function
 249     ,name '(prefix rest "ctcp-notice")
 250     ',(intern (format "liece-ctcp-%s-notice" name))))
 251
 252 (liece-register-ctcp-notice-handler "version")
 253 (liece-register-ctcp-notice-handler "userinfo")
 254 (liece-register-ctcp-notice-handler "clientinfo")
 255 (liece-register-ctcp-notice-handler "ping")
 256 (liece-register-ctcp-notice-handler "time")
 257 (liece-register-ctcp-notice-handler "file")
 258 (liece-register-ctcp-notice-handler "x-face")
 259 (liece-register-ctcp-notice-handler "comment")
 260 (liece-register-ctcp-notice-handler "help")
 261 (liece-register-ctcp-notice-handler "dcc")
 262 (liece-register-ctcp-notice-handler "errmsg")
 263
 264 (defun* liece-ctcp-notice (prefix rest)
 265   (or (string-match "^\\([^\001]*\\)\001\\([^\001]*\\)\001" rest)
 266       (return-from liece-ctcp-notice))
 267   (let (hook after-hook data message)
 268     (setq data (match-string 2 rest)
 269           rest (concat
 270                 (match-string 1 rest)
 271                 (substring rest (match-end 0))))
 272     (if (string-match "^\\([^ ]*\\) *:?" data)
 273         (setq message (downcase (match-string 1 data))
 274               data (substring data (match-end 0)))
 275       (setq message "errmsg"
 276             data (_ "Couldn't figure out what was said.")))
 277     (setq hook
 278           (intern-soft
 279            (concat "liece-ctcp-" message "-notice-hook"))
 280           after-hook
 281           (intern-soft
 282            (concat "liece-after-ctcp-" message "-notice-hook")))
 283     (if (run-hook-with-args-until-success hook prefix data)
 284         (return-from liece-ctcp-notice rest))
 285     (let ((func
 286            (liece-handler-find-function
 287             message '(prefix data) "ctcp-notice")))
 288       (if func
 289           (funcall func prefix data)
 290         (liece-ctcp-notices message prefix data)))
 291     (run-hook-with-args after-hook prefix data)
 292     rest))
 293
 294 (defun liece-ctcp-notices (message prefix rest)
 295   (liece-message
 296    (_ "Unknown ctcp notice \":%s %s %s\"")
 297    prefix (upcase message) rest))
 298
 299 (liece-handler-define-backend "ctcp-file")
 300
 301 (defmacro liece-register-file-handler (name)
 302   `(liece-handler-define-function
 303     ,name '(prefix name data "ctcp-file")
 304     ',(intern (format "liece-file-%s" name))))
 305
 306 (liece-register-file-handler "start")
 307 (liece-register-file-handler "cont")
 308 (liece-register-file-handler "end")
 309
 310 (defun* liece-ctcp-file-notice (prefix rest)
 311   (when liece-file-accept
 312     (multiple-value-bind (message name data)
 313         (liece-split-line rest)
 314       (setq message (downcase message))
 315       (let ((hook
 316              (intern-soft
 317               (concat "liece-file-" message "-hook")))
 318             (after-hook
 319              (intern-soft
 320               (concat "liece-after-file-" message "-hook")))
 321             func)
 322         (if (run-hook-with-args-until-success hook prefix name)
 323             (return-from liece-ctcp-file-notice))
 324         (setq func (liece-handler-find-function
 325                     message '(prefix name data) 'ctcp-file))
 326         (if func
 327             (funcall func prefix name data)
 328           (liece-file-notices message prefix name data))
 329         (run-hook-with-args after-hook prefix name)))))
 330
 331 (defun liece-file-notices (message prefix name data)
 332   (liece-message
 333    (_ "Unknown FILE message \":%s %s %s %s\"")
 334    prefix (upcase message) name data))
 335
 336 (defun liece-file-start (prefix name data)
 337   "CTCP FILE start handler."
 338   (save-excursion
 339     (set-buffer
 340      (liece-get-buffer-create
 341       (format " *ctcp-file:%s*" name)))
 342     (buffer-disable-undo)
 343     (set-buffer-multibyte nil)
 344     (erase-buffer)
 345     (insert data)))
 346
 347 (defun liece-file-cont (prefix name data)
 348   "CTCP FILE cont handler."
 349   (save-excursion
 350     (set-buffer
 351      (liece-get-buffer-create
 352       (format " *ctcp-file:%s*" name)))
 353     (goto-char (point-max))
 354     (insert data)))
 355
 356 (defun liece-file-end (prefix name data)
 357   "CTCP FILE cont handler."
 358   (save-excursion
 359     (set-buffer
 360      (liece-get-buffer-create
 361       (format " *ctcp-file:%s*" name)))
 362     (goto-char (point-max))
 363     (insert data)
 364     (liece-quote-decode-region (point-min)(point-max))
 365     (goto-char (point-min))
 366     (when (or (null liece-file-confirm-save)
 367               (y-or-n-p "Save file? "))
 368       (or (file-directory-p liece-ctcp-file-save-directory)
 369           (make-directory liece-ctcp-file-save-directory))
 370       (write-region-as-binary
 371        (point-min)(point-max)
 372        (expand-file-name
 373         (file-name-nondirectory
 374          (concat name "-" prefix))
 375         liece-ctcp-file-save-directory))
 376       (kill-buffer (current-buffer)))))
 377
 378 (defun liece-ctcp-version-insert (buffer prefix name
 379                                          &optional version environment)
 380   (or (listp buffer)
 381       (setq buffer (list buffer)))
 382   (liece-insert buffer
 383                 (concat (format liece-ctcp-message
 384                                 "VERSION" prefix "")
 385                         name "\n"))
 386   (when version
 387     (liece-insert buffer
 388                   (concat (format liece-ctcp-message
 389                                   "VERSION" prefix "")
 390                           "\t" version
 391                           (if environment
 392                               (concat " " environment))
 393                           "\n"))))
 394
 395 (defun liece-ctcp-version-notice (prefix rest)
 396   "CTCP VERSION reply handler."
 397   (if (null rest)
 398       (liece-message (_ "Empty CLIENT version notice from \"%s\".") prefix)
 399     (cond
 400      ((string-match "^\\([^:]*\\):\\([^:]+\\):?\\([^:]*\\)" rest)
 401       (liece-ctcp-version-insert liece-ctcp-buffer
 402                                  prefix (match-string 1 rest)
 403                                  (match-string 2 rest)
 404                                  (match-string 3 rest)))
 405      ((string-match "^\\([^:]*\\):\\(.*\\)" rest)
 406       (liece-ctcp-version-insert liece-ctcp-buffer
 407                                  prefix (match-string 1 rest)))
 408      (t
 409       (liece-ctcp-version-insert liece-ctcp-buffer prefix rest)))))
 410
 411 (defun liece-ctcp-clientinfo-notice (prefix rest)
 412   "CTCP CLIENTINFO reply handler."
 413   (liece-insert liece-ctcp-buffer
 414                  (format (concat liece-ctcp-message "\n")
 415                          "CLIENTINFO" prefix rest)))
 416
 417 (defun liece-ctcp-userinfo-notice (prefix rest)
 418   "CTCP USERINFO reply handler."
 419   (liece-insert liece-ctcp-buffer
 420                  (format (concat liece-ctcp-message "\n")
 421                          "USERINFO" prefix rest)))
 422
 423 (defun liece-ctcp-help-notice (prefix rest)
 424   "CTCP HELP reply handler."
 425   (liece-insert liece-ctcp-buffer
 426                  (format (concat liece-ctcp-message "\n")
 427                          "HELP" prefix rest)))
 428
 429 (defun liece-ctcp-x-face-notice (prefix rest)
 430   "CTCP X-FACE reply handler."
 431   (let ((buffer liece-ctcp-buffer))
 432     (liece-insert buffer
 433                    (format liece-ctcp-message
 434                            "X-FACE" prefix ""))
 435     (if (and liece-use-x-face
 436              (string-match "[^ \t]" rest))
 437         (liece-x-face-insert
 438          buffer (replace-in-string rest "[ \t\r\n]+" "") prefix)
 439       (liece-insert buffer rest))
 440     (let (liece-display-time)
 441       (liece-insert buffer "\n"))))
 442
 443 (defun liece-ctcp-errmsg-notice (prefix rest)
 444   "CTCP ERRMSG reply handler."
 445   (liece-insert liece-ctcp-buffer
 446                  (format (concat liece-ctcp-message "\n")
 447                          "ERRMSG" prefix rest)))
 448
 449 (defun liece-ctcp-comment-notice (from rest)
 450   "CTCP COMMENT reply handler."
 451   (liece-insert liece-ctcp-buffer
 452                  (format (concat liece-ctcp-message "\n")
 453                          "COMMENT" from rest))
 454   (liece-message "COMMENT query from %s." from))
 455
 456 (defmacro liece-ctcp-prepare-ping-seconds (timenow)
 457   `(format (_ "%d sec")
 458            (+ (* 65536 (- (car ,timenow) (car liece-ctcp-ping-time)))
 459               (- (cadr ,timenow) (cadr liece-ctcp-ping-time)))))
 460
 461 (defun liece-ctcp-ping-notice (from rest)
 462   "CTCP PING reply handler."
 463   (let ((timenow (current-time)))
 464     (liece-insert liece-ctcp-buffer
 465                    (format (concat liece-ctcp-message "\n")
 466                            "PING" from
 467                            (liece-ctcp-prepare-ping-seconds timenow)))))
 468
 469 (defun liece-ctcp-time-notice (from rest)
 470   "CTCP TIME reply handler."
 471   (liece-insert liece-ctcp-buffer
 472                 (format (concat liece-ctcp-message "\n")
 473                         "TIME" from rest)))
 474
 475 (defmacro liece-complete-client ()
 476   '(let ((completion-ignore-case t) (nick liece-ctcp-last-nick))
 477      (liece-minibuffer-completing-read
 478       (_ "Whose client: ") liece-nick-alist nil nil nil nil
 479       (if nick (liece-channel-virtual nick)))))
 480
 481 (defun liece-minibuffer-complete-client-query ()
 482   (let* ((alist
 483           (eval-when-compile
 484             (list-to-alist
 485              (mapcar
 486               (lambda (symbol) (downcase (symbol-name symbol)))
 487               liece-ctcp-supported-symbols))))
 488          (candidate (liece-minibuffer-prepare-candidate))
 489          (completion (try-completion candidate alist))
 490          (all (all-completions candidate alist)))
 491     (liece-minibuffer-finalize-completion completion candidate all)))
 492
 493 (defmacro liece-complete-query ()
 494   '(let ((completion-ignore-case t)
 495          (liece-minibuffer-complete-function
 496           (function liece-minibuffer-complete-client-query)))
 497      (read-from-minibuffer
 498       (_ "Which query: ") liece-ctcp-last-command
 499       liece-minibuffer-map)))
 500
 501 (defun liece-ctcp-make-command-wrapper (symbol)
 502   (fset (intern (format "liece-command-ctcp-%s" symbol))
 503         `(lambda (client)
 504            (interactive (list (liece-complete-client)))
 505            (setq client (liece-channel-real client)
 506                  liece-ctcp-last-nick client
 507                  ,@(if (eq symbol 'ping)
 508                        '(liece-ctcp-ping-time
 509                          (current-time))))
 510            (liece-send "PRIVMSG %s :\001%s\001"
 511                        client (upcase (symbol-name ',symbol))))))
 512
 513 (dolist (symbol liece-ctcp-supported-symbols)
 514   (liece-ctcp-make-command-wrapper symbol))
 515
 516 (defun liece-command-ctcp-action (&optional arg)
 517   "Send CTCP action."
 518   (interactive
 519    (if current-prefix-arg
 520        (list current-prefix-arg)))
 521   (let ((completion-ignore-case t)
 522         (liece-message-type 'action)
 523         message)
 524     (if arg
 525         (setq liece-privmsg-partner
 526               (liece-channel-virtual
 527                (liece-minibuffer-completing-read
 528                 (_ "To whom: ")
 529                 (append liece-nick-alist liece-channel-alist)
 530                 nil nil nil nil liece-privmsg-partner))))
 531     (beginning-of-line)
 532     (setq message (buffer-substring (point)(progn (end-of-line)(point))))
 533     (if (string= message "")
 534         (setq message (read-string "Action: "))
 535       (liece-next-line 1))
 536     (liece-send "PRIVMSG %s :\001ACTION %s\001"
 537                  (if arg
 538                      liece-privmsg-partner
 539                    (liece-channel-real liece-current-channel))
 540                  message)
 541     (if arg
 542         (liece-own-private-message message)
 543       (liece-own-channel-message message))))
 544
 545 (define-obsolete-function-alias 'liece-command-send-action
 546   'liece-command-ctcp-action)
 547
 548 (defun liece-command-ctcp-generic (nick command)
 549   "Ask about someones client clientinfo."
 550   (interactive (list (liece-complete-client) (liece-complete-query)))
 551   (setq nick (liece-channel-real nick)
 552         liece-ctcp-last-nick nick
 553         liece-ctcp-last-command command)
 554   (if (string-equal-ignore-case liece-ctcp-last-command "ping")
 555       (setq liece-ctcp-ping-time (current-time)))
 556   (liece-send "PRIVMSG %s :\001%s\001" nick command))
 557
 558 (defun liece-command-ctcp-userinfo-from-minibuffer (info)
 559   "Ask about someones client clientinfo."
 560   (interactive
 561    (list (read-from-minibuffer "New userinfo: " liece-ctcp-userinfo)))
 562   (setq liece-ctcp-userinfo info))
 563
 564 (defun liece-command-ctcp-x-face-from-xbm-file (file)
 565   (interactive "fXBM File: ")
 566   (let (data)
 567     (and (file-exists-p file) (file-readable-p file)
 568          (setq data (liece-x-face-encode file))
 569          (setq liece-ctcp-x-face
 570                (replace-in-string (cadr (nth 3 data)) "[ \t\n]" "")))))
 571
 572 (defun liece-command-send-file (file to)
 573   "Send a file to given  user."
 574   (interactive "fFile name: \nsTo whom: ")
 575   (save-excursion
 576     (set-buffer (liece-get-buffer-create (format " *ctcp-file:%s*" file)))
 577     (buffer-disable-undo)
 578     (set-buffer-multibyte nil)
 579     (erase-buffer)
 580     (insert-file-contents-as-binary file)
 581     (liece-quote-encode-region (point-min)(point-max))
 582     (goto-char (point-min))
 583     (let ((bound (min (point-max) (+ 80 (point))))
 584           (liece-mime-charset-for-write 'binary))
 585       (liece-send
 586        "NOTICE %s :\001FILE START %s :%s\001"
 587        to file (buffer-substring (point) bound))
 588       (goto-char bound)
 589       (while (not (eobp))
 590         (if (= 1 (mod (point) 800))
 591             (sit-for 1))
 592         (setq bound (min (point-max) (+ 80 (point))))
 593         (liece-send "NOTICE %s :\001FILE CONT %s :%s\001"
 594                     to file (buffer-substring (point) bound))
 595         (goto-char bound)))
 596     (liece-send "NOTICE %s :\001FILE END %s : \001" to file)
 597     (kill-buffer (current-buffer))))
 598
 599 (provide 'liece-ctcp)
 600
 601 ;;; liece-ctcp.el ends here