1 ;;; trans-util.el --- useful functions for translating characters.
3 ;; Copyright (C) 1997-2000 Miyashita Hisashi
5 ;; Keywords: CCL, mule, multilingual, character set,
6 ;; coding-system, ISO10646, Unicode
8 ;; This file is part of Mule-UCS
10 ;; Mule-UCS is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; Mule-UCS is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
25 ;;; String to number translation functions
27 ;; This file is not compilable on a non-Mule emacs.
28 (eval-when-compile (require 'ccl))
30 (defun string-to-number-with-radix (string radix)
36 (setq c (aref string i))
44 (error "Invalid char:%c" c)))
45 (setq result (+ (* result radix) c)
49 (defun hex-string-to-number (string)
50 (string-to-number-with-radix string 16))
52 (defun octal-string-to-number (string)
53 (string-to-number-with-radix string 8))
55 (if (fboundp 'ccl-execute)
57 ccl-c-notated-string-to-number
62 (if (r0 == ?0) ((read r1)
65 ((r6 = 8) (r0 = r1)))))
67 (if (r0 < ?0) ((r2 = -1) (break)))
68 (r5 = (r0 > ?7)) (r5 &= (r6 == 8))
69 (if r5 ((r2 = -1) (break)))
74 (if r5 ((r2 = -1) (break)))
78 (if r5 ((r2 = -1) (break)))
80 ((r0 -= ,(- ?A 10)))))
88 (defun c-notated-string-to-number (string)
89 (if (fboundp 'ccl-execute)
90 (let ((vector [0 0 0 0 0 0 0 0 nil]))
91 (ccl-execute-on-string
92 'ccl-c-notated-string-to-number
95 (cond ((string-match "0x\\(\\d+\\)" string)
96 (string-to-number-with-radix
97 (match-string 1 string) 16))
98 ((string-match "0\\(\\d+\\)" string)
99 (string-to-number-with-radix
100 (match-string 1 string) 8))
102 (string-to-number string)))))
104 ;; For embedding number literal.
105 (defmacro cn (string)
106 (c-notated-string-to-number string))
108 ;; For transformating list structure
111 (defmacro transformate-list-structure (spec lstr)
112 (let (func1 func2 result)
115 (cond ((functionp se)
119 (funcall func2 le se))
121 (error "Invalid spec or element" se le))))
125 (if (and (not (listp (cdr l)))
126 (not (listp (cdr s))))
127 (cons (funcall func1 (car l) (car s))
128 (funcall func1 (cdr l) (cdr s)))
129 (while (and (setq le (car l))
133 (funcall func1 le se)
137 (nreverse result)))))
139 (setq result (cons (funcall func2 (car lstr) spec)
142 (list 'quote (nreverse result))))
144 ;;; character maker/translator.
146 (defconst make-char-internal-usable-p
147 (and (fboundp (function make-char-internal))
148 (eq (condition-case err
156 (defconst charset-id-table [])
158 (defun update-charset-id-table ()
160 (vec (make-vector len nil))
163 (while (setq cs (car csl))
164 (setq id (charset-id cs)
167 (setq vec (vconcat vec
168 (make-vector (- id len -1)
171 (aset vec (charset-id cs) cs))
172 (setq charset-id-table vec)))
174 (defsubst make-char-from-charset-id (id c1 &optional c2)
175 (if make-char-internal-usable-p
176 (make-char-internal id c1 c2)
177 (if (or (>= id (length charset-id-table))
178 (aref charset-id-table id))
179 (update-charset-id-table))
181 (or (aref charset-id-table id)
182 (error "ID:%d is not valid charset-id." id))
185 (defsubst char-codepoint (char)
186 "Return a codepoint of char."
187 (let ((info (split-char char)))
188 (if (= (length info) 3)
189 (+ (* (nth 1 info) 96)
193 (defsubst make-char-from-charset-codepoint (charset codepoint)
194 "Return a character of CODEPOINT in CHARSET"
195 (if (> codepoint 255)
197 (setq codepoint (- codepoint 32))
200 (+ (% codepoint 96) 32)))
201 (make-char charset codepoint)))
203 (defsubst make-char-from-charset-id-codepoint (charset codepoint)
204 "Return a character of CODEPOINT in CHARSET"
205 (if (> codepoint 255)
207 (setq codepoint (- codepoint 32))
208 (make-char-from-charset-id charset
210 (+ (% codepoint 96) 32)))
211 (make-char-from-charset-id charset codepoint)))
213 ;;; character representations.
215 (defalias 'trans-util-charp
216 (cond ((fboundp (function char-valid-p))
217 (function char-valid-p))
218 ((fboundp (function characterp))
219 (function characterp))
221 (error "Cannot find out any equivalents to characterp."))))
223 (defun char-1-elisp-representation (x)
224 (make-char-from-charset-id-codepoint
226 (logand x (cn "0xFFFF"))))
228 (defun char-1-ccl-representation (x)
229 (if (trans-util-charp x)
230 (logior (lsh (charset-id (char-charset x)) 16)
234 (provide 'trans-util)
236 ;;; trans-util.el ends here.