cgit.sxemacs.org Git - packages/blob - mule-packages/lookup/lisp/lookup-defs.el

   1 ;;; lookup-defs.el --- definitions for several environments
   2 ;; Copyright (C) 1997,1998 NISHIDA Keisuke <knishida@ring.aist.go.jp>
   3
   4 ;; Author: NISHIDA Keisuke <knishida@ring.aist.go.jp>
   5 ;; Version: $Id: lookup-defs.el,v 1.4 1998/12/03 21:42:10 kei Exp $
   6
   7 ;; This file is part of Lookup.
   8
   9 ;; Lookup is free software; you can redistribute it and/or modify it
  10 ;; under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation; either version 2 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; Lookup is distributed in the hope that it will be useful, but
  15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with Lookup; if not, write to the Free Software Foundation,
  21 ;; Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  22
  23 ;;; Code:
  24
  25 (require 'evi)
  26 (require 'lookup-utils)
  27 (require 'lookup-vars)
  28 (require 'lookup-types)
  29
  30 (when (featurep 'xemacs)
  31   (defun lookup-glyph-compose (xbm)
  32     (let (width height data)
  33       (with-temp-buffer
  34         (insert xbm)
  35         (goto-char (point-min))
  36         (if (re-search-forward "width[ \t]+\\([0-9]+\\)")
  37             (setq width (string-to-int (match-string 1))))
  38         (if (re-search-forward "height[ \t]+\\([0-9]+\\)")
  39             (setq height (string-to-int (match-string 1))))
  40         (while (re-search-forward "0x\\(..\\)" nil t)
  41           (setq data (cons (string-to-int (match-string 1) 16) data)))
  42         (setq data (concat (nreverse data))))
  43       (make-glyph (vector 'xbm :data (list width height data)))))
  44
  45   (defun lookup-glyph-insert (glyph)
  46     (let (extent)
  47       (if (and (setq extent (extent-at (point)))
  48                (extent-property extent 'invisible))
  49           (goto-char (extent-end-position extent)))
  50       ;; extent \e$B$OJ8;zI}$r;}$?$J$$$N$G!"\e(Bfill \e$B$N$H$->/$7$G$b%3%i%`$r\e(B
  51       ;; \e$BB7$($i$l$k$h$&!"M>7W$JJ8;z$rA^F~$7$F$*$/!#\e(B
  52       (insert "_")
  53       (setq extent (make-extent (1- (point)) (point)))
  54       ;; invisible \e$B$r@_Dj$9$k$H!"\e(Bbegin-glyph \e$B$OMxMQ=PMh$J$/$J$k!#\e(B
  55       (set-extent-end-glyph extent glyph)
  56       (set-extent-property extent 'invisible t)
  57       (set-extent-property extent 'duplicable t)
  58       (set-extent-property extent 'end-closed t)))
  59   )
  60
  61 (when (and (featurep 'mule) (not (featurep 'xemacs)))
  62   (autoload 'bitmap-decode-xbm "bitmap")
  63   (defun lookup-bitmap-compose (xbm)
  64     (with-temp-buffer
  65       (insert xbm)
  66       (let ((cmp (bitmap-decode-xbm
  67                    (bitmap-read-xbm-buffer (current-buffer)))))
  68         (bitmap-compose (aref cmp 0)))))
  69   )
  70
  71 (provide 'lookup-defs)
  72
  73 ;;; lookup-defs.el ends here