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 (run-hook-with-args-until-success hook from chnl data)
 137         (return-from liece-ctcp-message rest))
 138     (let ((func
 139            (liece-handler-find-function
 140             message '(from chnl data) "ctcp-message")))
 141       (if func
 142           (funcall func from chnl data)
 143         (liece-ctcp-messages message from chnl data))
 144       (run-hook-with-args after-hook from chnl data))
 145     rest))
 146
 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
 151                        (upcase message)))
 152   (setq chnl (liece-channel-virtual chnl))
 153   (liece-ctcp-insert (upcase message) from chnl rest))
 154
 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)))
 161
 162 (defun liece-ctcp-insert (message from &optional chnl rest)
 163   (if (or (null chnl)
 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)
 167     (liece-insert-client
 168      (liece-pick-buffer chnl)
 169      (format "%s query from %s%s\n"
 170              message from (if rest (concat ":" rest) "")))))
 171
 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))
 178
 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))
 185
 186 (defun liece-ctcp-clientinfo-message (from chnl rest)
 187   "CTCP CLIENTINFO handler."
 188   (liece-send "NOTICE %s :\001CLIENTINFO %s\001"
 189               from
 190               (eval-when-compile
 191                 (mapconcat
 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))
 196
 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.")
 209
 210 (defun liece-ctcp-help-message (from chnl rest)
 211   "CTCP HELP handler."
 212   (liece-send
 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))
 217
 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))
 222
 223 (defun liece-ctcp-ping-message (from chnl rest)
 224   "CTCP PING handler."
 225   (liece-send "NOTICE %s :\001PING %s\001" from rest)
 226   (setq chnl (liece-channel-virtual chnl))
 227   (liece-ctcp-insert "PING" from chnl))
 228
 229 (defun liece-ctcp-time-message (from chnl rest)
 230   "CTCP TIME handler."
 231   (liece-send "NOTICE %s :\001TIME %s\001"
 232               from (funcall liece-format-time-function
 233                             (current-time)))
 234   (setq chnl (liece-channel-virtual chnl))
 235   (liece-ctcp-insert "TIME" from chnl))
 236
 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))
 243
 244 (liece-handler-define-backend "ctcp-notice")
 245
 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))))
 250
 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")
 262
 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)
 268           rest (concat
 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.")))
 276     (setq hook
 277           (intern-soft
 278            (concat "liece-ctcp-" message "-notice-hook"))
 279           after-hook
 280           (intern-soft
 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))
 284     (let ((func
 285            (liece-handler-find-function
 286             message '(prefix data) "ctcp-notice")))
 287       (if func
 288           (funcall func prefix data)
 289         (liece-ctcp-notices message prefix data)))
 290     (run-hook-with-args after-hook prefix data)
 291     rest))
 292
 293 (defun liece-ctcp-notices (message prefix rest)
 294   (liece-message
 295    (_ "Unknown ctcp notice \":%s %s %s\"")
 296    prefix (upcase message) rest))
 297
 298 (liece-handler-define-backend "ctcp-file")
 299
 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))))
 304
 305 (liece-register-file-handler "start")
 306 (liece-register-file-handler "cont")
 307 (liece-register-file-handler "end")
 308
 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))
 314       (let ((hook
 315              (intern-soft
 316               (concat "liece-file-" message "-hook")))
 317             (after-hook
 318              (intern-soft
 319               (concat "liece-after-file-" message "-hook")))
 320             func)
 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))
 325         (if func
 326             (funcall func prefix name data)
 327           (liece-file-notices message prefix name data))
 328         (run-hook-with-args after-hook prefix name)))))
 329
 330 (defun liece-file-notices (message prefix name data)
 331   (liece-message
 332    (_ "Unknown FILE message \":%s %s %s %s\"")
 333    prefix (upcase message) name data))
 334
 335 (defun liece-file-start (prefix name data)
 336   "CTCP FILE start handler."
 337   (save-excursion
 338     (set-buffer
 339      (liece-get-buffer-create
 340       (format " *ctcp-file:%s*" name)))
 341     (buffer-disable-undo)
 342     (set-buffer-multibyte nil)
 343     (erase-buffer)
 344     (insert data)))
 345
 346 (defun liece-file-cont (prefix name data)
 347   "CTCP FILE cont handler."
 348   (save-excursion
 349     (set-buffer
 350      (liece-get-buffer-create
 351       (format " *ctcp-file:%s*" name)))
 352     (goto-char (point-max))
 353     (insert data)))
 354
 355 (defun liece-file-end (prefix name data)
 356   "CTCP FILE cont handler."
 357   (save-excursion
 358     (set-buffer
 359      (liece-get-buffer-create
 360       (format " *ctcp-file:%s*" name)))
 361     (goto-char (point-max))
 362     (insert data)
 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)
 371        (expand-file-name
 372         (file-name-nondirectory
 373          (concat name "-" prefix))
 374         liece-ctcp-file-save-directory))
 375       (kill-buffer (current-buffer)))))
 376
 377 (defun liece-ctcp-version-insert (buffer prefix name
 378                                          &optional version environment)
 379   (or (listp buffer)
 380       (setq buffer (list buffer)))
 381   (liece-insert buffer
 382                 (concat (format liece-ctcp-message
 383                                 "VERSION" prefix "")
 384                         name "\n"))
 385   (when version
 386     (liece-insert buffer
 387                   (concat (format liece-ctcp-message
 388                                   "VERSION" prefix "")
 389                           "\t" version
 390                           (if environment
 391                               (concat " " environment))
 392                           "\n"))))
 393
 394 (defun liece-ctcp-version-notice (prefix rest)
 395   "CTCP VERSION reply handler."
 396   (if (null rest)
 397       (liece-message (_ "Empty CLIENT version notice from \"%s\".") prefix)
 398     (cond
 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)))
 407      (t
 408       (liece-ctcp-version-insert liece-ctcp-buffer prefix rest)))))
 409
 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)))
 415
 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)))
 421
 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)))
 427
 428 (defun liece-ctcp-x-face-notice (prefix rest)
 429   "CTCP X-FACE reply handler."
 430   (let ((buffer liece-ctcp-buffer))
 431     (liece-insert buffer
 432                    (format liece-ctcp-message
 433                            "X-FACE" prefix ""))
 434     (if (and liece-use-x-face
 435              (string-match "[^ \t]" rest))
 436         (liece-x-face-insert
 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"))))
 441
 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)))
 447
 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))
 454
 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)))))
 459
 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")
 465                            "PING" from
 466                            (liece-ctcp-prepare-ping-seconds timenow)))))
 467
 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")
 472                         "TIME" from rest)))
 473
 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)))))
 479
 480 (defun liece-minibuffer-complete-client-query ()
 481   (let* ((alist
 482           (eval-when-compile
 483             (list-to-alist
 484              (mapcar
 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)))
 491
 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)))
 499
 500 (defun liece-ctcp-make-command-wrapper (symbol)
 501   (fset (intern (format "liece-command-ctcp-%s" symbol))
 502         `(lambda (client)
 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
 508                          (current-time))))
 509            (liece-send "PRIVMSG %s :\001%s\001"
 510                        client (upcase (symbol-name ',symbol))))))
 511
 512 (dolist (symbol liece-ctcp-supported-symbols)
 513   (liece-ctcp-make-command-wrapper symbol))
 514
 515 (defun liece-command-ctcp-action (&optional arg)
 516   "Send CTCP action."
 517   (interactive
 518    (if current-prefix-arg
 519        (list current-prefix-arg)))
 520   (let ((completion-ignore-case t)
 521         (liece-message-type 'action)
 522         message)
 523     (if arg
 524         (setq liece-privmsg-partner
 525               (liece-channel-virtual
 526                (liece-minibuffer-completing-read
 527                 (_ "To whom: ")
 528                 (append liece-nick-alist liece-channel-alist)
 529                 nil nil nil nil liece-privmsg-partner))))
 530     (beginning-of-line)
 531     (setq message (buffer-substring (point)(progn (end-of-line)(point))))
 532     (if (string= message "")
 533         (setq message (read-string "Action: "))
 534       (liece-next-line 1))
 535     (liece-send "PRIVMSG %s :\001ACTION %s\001"
 536                  (if arg
 537                      liece-privmsg-partner
 538                    (liece-channel-real liece-current-channel))
 539                  message)
 540     (if arg
 541         (liece-own-private-message message)
 542       (liece-own-channel-message message))))
 543
 544 (define-obsolete-function-alias 'liece-command-send-action
 545   'liece-command-ctcp-action)
 546
 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))
 556
 557 (defun liece-command-ctcp-userinfo-from-minibuffer (info)
 558   "Ask about someones client clientinfo."
 559   (interactive
 560    (list (read-from-minibuffer "New userinfo: " liece-ctcp-userinfo)))
 561   (setq liece-ctcp-userinfo info))
 562
 563 (defun liece-command-ctcp-x-face-from-xbm-file (file)
 564   (interactive "fXBM File: ")
 565   (let (data)
 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]" "")))))
 570
 571 (defun liece-command-send-file (file to)
 572   "Send a file to given  user."
 573   (interactive "fFile name: \nsTo whom: ")
 574   (save-excursion
 575     (set-buffer (liece-get-buffer-create (format " *ctcp-file:%s*" file)))
 576     (buffer-disable-undo)
 577     (set-buffer-multibyte nil)
 578     (erase-buffer)
 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))
 584       (liece-send
 585        "NOTICE %s :\001FILE START %s :%s\001"
 586        to file (buffer-substring (point) bound))
 587       (goto-char bound)
 588       (while (not (eobp))
 589         (if (= 1 (mod (point) 800))
 590             (sit-for 1))
 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))
 594         (goto-char bound)))
 595     (liece-send "NOTICE %s :\001FILE END %s : \001" to file)
 596     (kill-buffer (current-buffer))))
 597
 598 (provide 'liece-ctcp)
 599
 600 ;;; liece-ctcp.el ends here