tm 7.48.1.
[elisp/apel.git] / emu-mule.el
1 ;;;
2 ;;; emu-mule.el --- Mule 2.* emulation module for Mule
3 ;;;
4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
5 ;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
6 ;;;
7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
8 ;;; Version:
9 ;;;     $Id: emu-mule.el,v 7.0 1996/03/14 16:27:21 morioka Exp $
10 ;;; Keywords: emulation, compatibility, Mule
11 ;;;
12 ;;; This file is part of tl (Tiny Library).
13 ;;;
14 ;;; This program is free software; you can redistribute it and/or
15 ;;; modify it under the terms of the GNU General Public License as
16 ;;; published by the Free Software Foundation; either version 2, or
17 ;;; (at your option) any later version.
18 ;;;
19 ;;; This program is distributed in the hope that it will be useful,
20 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
22 ;;; General Public License for more details.
23 ;;;
24 ;;; You should have received a copy of the GNU General Public License
25 ;;; along with This program.  If not, write to the Free Software
26 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
27 ;;;
28 ;;; Code:
29
30 (defun some-element (pred seq)
31   "Return the first element of sequence SEQ
32 whose return value applied function PRED is not nil.
33 [emu-mule; tl-list function]"
34  (let ((i 0)(len (length seq)) element)
35    (catch 'tag
36      (while (< i len)
37        (if (funcall pred (setq element (elt seq i)))
38            (throw 'tag element)
39          )
40        (setq i (+ i 1))
41        ))
42    ))
43
44 (if (not (boundp 'emacs-major-version))
45     (defconst emacs-major-version (string-to-int emacs-version))
46   )
47
48
49 ;;; @ leading-character
50 ;;;
51
52 (defun get-lc (chr)
53   "Return leading character of CHAR or LEADING-CHARACTER."
54   (if (< chr 128)
55       lc-ascii
56     chr))
57
58
59 ;;; @ version specific features
60 ;;;
61
62 (cond ((>= emacs-major-version 19)
63        (require 'emu-19)
64        (defun fontset-pixel-size (fontset)
65          (elt
66           (get-font-info
67            (some-element
68             (function
69              (lambda (n)
70                (not (= n -1))
71                ))
72             (cdr (get-fontset-info fontset))
73             )) 5))
74        )
75       (t
76        (require 'emu-18)
77        (defun tl:make-overlay (beg end &optional buffer type))
78        (defun tl:overlay-put (overlay prop value))
79        (defun tl:add-text-properties (start end properties &optional object))
80        ))
81
82
83 ;;; @@ truncate-string
84 ;;;
85
86 (or (fboundp 'truncate-string)
87 ;;; Imported from Mule-2.3
88 (defun truncate-string (str width &optional start-column)
89   "Truncate STR to fit in WIDTH columns.
90 Optional non-nil arg START-COLUMN specifies the starting column.
91 \[emu-mule.el; Mule 2.3 emulating function]"
92   (or start-column
93       (setq start-column 0))
94   (let ((max-width (string-width str))
95         (len (length str))
96         (from 0)
97         (column 0)
98         to-prev to ch)
99     (if (>= width max-width)
100         (setq width max-width))
101     (if (>= start-column width)
102         ""
103       (while (< column start-column)
104         (setq ch (aref str from)
105               column (+ column (char-width ch))
106               from (+ from (char-bytes ch))))
107       (if (< width max-width)
108           (progn
109             (setq to from)
110             (while (<= column width)
111               (setq ch (aref str to)
112                     column (+ column (char-width ch))
113                     to-prev to
114                     to (+ to (char-bytes ch))))
115             (setq to to-prev)))
116       (substring str from to))))
117 ;;;
118   )
119
120
121 ;;; @ end
122 ;;;
123
124 (provide 'emu-mule)
125
126 ;;; emu-mule.el ends here