tm 7.59.
[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.11 1996/05/09 16:38:20 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 ;;; @ character set
31 ;;;
32
33 (defalias 'char-charset 'char-leading-char)
34
35
36 ;;; @ coding system
37 ;;;
38
39 (defun character-encode-string (str coding-system)
40   "Encode the string STR which is encoded in CODING-SYSTEM.
41 \[emu-mule.el]"
42   (code-convert-string str *internal* coding-system)
43   )
44
45 (defun character-decode-string (str coding-system)
46   "Decode the string STR which is encoded in CODING-SYSTEM.
47 \[emu-mule.el]"
48   (code-convert-string str coding-system *internal*)
49   )
50
51 (defun character-encode-region (start end coding-system)
52   "Encode the text between START and END which is
53 encoded in CODING-SYSTEM. [emu-mule.el]"
54   (code-convert start end *internal* coding-system)
55   )
56
57 (defun character-decode-region (start end coding-system)
58   "Decode the text between START and END which is
59 encoded in CODING-SYSTEM. [emu-mule.el]"
60   (code-convert start end coding-system *internal*)
61   )
62
63
64 ;;; @ version specific features
65 ;;;
66
67 (cond (running-emacs-19
68        (require 'emu-19)
69        
70        ;; Suggested by SASAKI Osamu <osamu@shuugr.bekkoame.or.jp>
71        ;; (cf. [os2-emacs-ja:78])
72        (defun fontset-pixel-size (fontset)
73          (let* ((font (get-font-info
74                        (aref (cdr (get-fontset-info fontset)) 0)))
75                 (open (aref font 4)))
76            (if (= open 1)
77                (aref font 5)
78              (if (= open 0)
79                  (let ((pat (aref font 1)))
80                    (if (string-match "-[0-9]+-" pat)
81                        (string-to-number
82                         (substring
83                          pat (1+ (match-beginning 0)) (1- (match-end 0))))
84                      0)))
85              )))
86        )
87       (running-emacs-18
88        (require 'emu-18)
89        (defun tl:make-overlay (beg end &optional buffer type))
90        (defun tl:overlay-put (overlay prop value))
91        ))
92
93
94 ;;; @@ truncate-string
95 ;;;
96
97 (or (fboundp 'truncate-string)
98 ;;; Imported from Mule-2.3
99 (defun truncate-string (str width &optional start-column)
100   "Truncate STR to fit in WIDTH columns.
101 Optional non-nil arg START-COLUMN specifies the starting column.
102 \[emu-mule.el; Mule 2.3 emulating function]"
103   (or start-column
104       (setq start-column 0))
105   (let ((max-width (string-width str))
106         (len (length str))
107         (from 0)
108         (column 0)
109         to-prev to ch)
110     (if (>= width max-width)
111         (setq width max-width))
112     (if (>= start-column width)
113         ""
114       (while (< column start-column)
115         (setq ch (aref str from)
116               column (+ column (char-width ch))
117               from (+ from (char-bytes ch))))
118       (if (< width max-width)
119           (progn
120             (setq to from)
121             (while (<= column width)
122               (setq ch (aref str to)
123                     column (+ column (char-width ch))
124                     to-prev to
125                     to (+ to (char-bytes ch))))
126             (setq to to-prev)))
127       (substring str from to))))
128 ;;;
129   )
130
131
132 ;;; @ end
133 ;;;
134
135 (provide 'emu-mule)
136
137 ;;; emu-mule.el ends here