;;; lookup-defs.el --- definitions for several environments
;; Copyright (C) 1997,1998 NISHIDA Keisuke <knishida@ring.aist.go.jp>

;; Author: NISHIDA Keisuke <knishida@ring.aist.go.jp>
;; Version: $Id: lookup-defs.el,v 1.4 1998/12/03 21:42:10 kei Exp $

;; This file is part of Lookup.

;; Lookup is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.

;; Lookup is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with Lookup; if not, write to the Free Software Foundation,
;; Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

;;; Code:

(require 'evi)
(require 'lookup-utils)
(require 'lookup-vars)
(require 'lookup-types)

(when (featurep 'xemacs)
  (defun lookup-glyph-compose (xbm)
    (let (width height data)
      (with-temp-buffer
	(insert xbm)
	(goto-char (point-min))
	(if (re-search-forward "width[ \t]+\\([0-9]+\\)")
	    (setq width (string-to-int (match-string 1))))
	(if (re-search-forward "height[ \t]+\\([0-9]+\\)")
	    (setq height (string-to-int (match-string 1))))
	(while (re-search-forward "0x\\(..\\)" nil t)
	  (setq data (cons (string-to-int (match-string 1) 16) data)))
	(setq data (concat (nreverse data))))
      (make-glyph (vector 'xbm :data (list width height data)))))

  (defun lookup-glyph-insert (glyph)
    (let (extent)
      (if (and (setq extent (extent-at (point)))
	       (extent-property extent 'invisible))
	  (goto-char (extent-end-position extent)))
      ;; extent は文字幅を持たないので、fill のとき少しでもコラムを
      ;; 揃えられるよう、余計な文字を挿入しておく。
      (insert "_")
      (setq extent (make-extent (1- (point)) (point)))
      ;; invisible を設定すると、begin-glyph は利用出来なくなる。
      (set-extent-end-glyph extent glyph)
      (set-extent-property extent 'invisible t)
      (set-extent-property extent 'duplicable t)
      (set-extent-property extent 'end-closed t)))
  )

(when (and (featurep 'mule) (not (featurep 'xemacs)))
  (autoload 'bitmap-decode-xbm "bitmap")
  (defun lookup-bitmap-compose (xbm)
    (with-temp-buffer
      (insert xbm)
      (let ((cmp (bitmap-decode-xbm
		   (bitmap-read-xbm-buffer (current-buffer)))))
	(bitmap-compose (aref cmp 0)))))
  )

(provide 'lookup-defs)

;;; lookup-defs.el ends here
