cgit.sxemacs.org Git - packages/blob - xemacs-packages/liece/lisp/liece-x-face.el

   1 ;;; liece-x-face.el --- X-Face wrappers.
   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
   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-compat))
  33
  34 (require 'path-util)
  35
  36 (defvar liece-x-face-insert-function
  37   (when (and (module-installed-p 'bitmap) (module-installed-p 'x-face))
  38     (function liece-x-face-insert-with-bitmap)))
  39
  40 (eval-and-compile
  41   (autoload 'x-face-encode "x-face")
  42   (autoload 'x-face-read-existing-file-name "x-face")
  43   (autoload 'x-face-icons-to-xbm "x-face")
  44   (autoload 'x-face-x-face-encoded-string-to-icon-string "x-face")
  45   (autoload 'bitmap-insert-xbm-buffer "bitmap")
  46   (autoload 'bitmap-decode-xbm "bitmap")
  47   (autoload 'bitmap-read-xbm-buffer "bitmap")
  48   (autoload 'bitmap-compose "bitmap"))
  49
  50 (defalias 'liece-x-face-encode 'x-face-encode)
  51 (defalias 'liece-x-face-read-existing-file-name
  52   'x-face-read-existing-file-name)
  53
  54 (defun liece-x-face-insert-with-bitmap (buffer str nick)
  55   (save-excursion
  56     (set-buffer buffer)
  57     (goto-char (point-max))
  58     (let* (buffer-read-only
  59            (buf (x-face-icons-to-xbm
  60                  nick 1 1
  61                  (x-face-x-face-encoded-string-to-icon-string str)))
  62            (cmp (bitmap-decode-xbm (bitmap-read-xbm-buffer buf)))
  63            (len (length cmp)) (col (current-column))
  64            (prefix (buffer-substring
  65                     (line-beginning-position) (point))) pt)
  66       (delete-region (line-beginning-position) (point))
  67       (dotimes (i len)
  68         (insert ?\n)
  69         (if (= i (/ len 2))
  70             (insert prefix)
  71           (move-to-column col t))
  72         (setq pt (point))
  73         (insert (bitmap-compose (aref cmp i)))
  74         (overlay-put
  75          (make-overlay pt (point)) 'face 'liece-client-face)))))
  76
  77 (defun liece-x-face-insert (buffers str nick)
  78   (cond
  79    ((or (not buffers) (listp buffers))
  80     (dolist (buffer buffers)
  81       (liece-x-face-insert buffer str nick)))
  82    ((fboundp liece-x-face-insert-function)
  83     (funcall liece-x-face-insert-function buffers str nick))))
  84
  85 (provide 'liece-x-face)
  86
  87 ;;; liece-x-face.el ends here