Mercurial > hg > xemacs-beta
annotate lisp/mule/mule-composite.el @ 5406:061f4f90f874
Convert lib-src/ to GPLv3.
| author | Mike Sperber <sperber@deinprogramm.de> |
|---|---|
| date | Mon, 18 Oct 2010 14:02:19 +0200 |
| parents | 308d34e9f07d |
| children | 8861440b1aa4 |
| rev | line source |
|---|---|
| 778 | 1 ;;; mule-composite.el --- support character composition |
| 2 | |
| 3 ;; Copyright (C) 1999 Electrotechnical Laboratory, JAPAN. | |
| 4 ;; Licensed to the Free Software Foundation. | |
| 5 | |
| 6 ;; Keywords: mule, multilingual, character composition | |
| 7 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
778
diff
changeset
|
8 ;; This file is part of XEmacs. |
| 778 | 9 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
778
diff
changeset
|
10 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
778
diff
changeset
|
11 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
778
diff
changeset
|
12 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
778
diff
changeset
|
13 ;; option) any later version. |
| 778 | 14 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
778
diff
changeset
|
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
778
diff
changeset
|
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
778
diff
changeset
|
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
778
diff
changeset
|
18 ;; for more details. |
| 778 | 19 |
| 20 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
778
diff
changeset
|
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 778 | 22 |
| 23 ;;; Synched up with: Emacs 21.1 (lisp/composite.el). | |
| 24 | |
| 25 ;;; Commentary: | |
| 26 | |
| 27 ;;; Code: | |
| 28 | |
| 29 ;;;###autoload | |
| 30 (defconst reference-point-alist | |
| 31 '((tl . 0) (tc . 1) (tr . 2) | |
| 32 (Bl . 3) (Bc . 4) (Br . 5) | |
| 33 (bl . 6) (bc . 7) (br . 8) | |
| 34 (cl . 9) (cc . 10) (cr . 11) | |
| 35 (top-left . 0) (top-center . 1) (top-right . 2) | |
| 36 (base-left . 3) (base-center . 4) (base-right . 5) | |
| 37 (bottom-left . 6) (bottom-center . 7) (bottom-right . 8) | |
| 38 (center-left . 9) (center-center . 10) (center-right . 11) | |
| 39 ;; For backward compatibility... | |
| 40 (ml . 3) (mc . 10) (mr . 5) | |
| 41 (mid-left . 3) (mid-center . 10) (mid-right . 5)) | |
| 42 "UNIMPLEMENTED. | |
| 43 Alist of symbols vs integer codes of glyph reference points. | |
| 44 A glyph reference point symbol is to be used to specify a composition | |
| 45 rule in COMPONENTS argument to such functions as `compose-region' and | |
| 46 `make-composition'. | |
| 47 | |
| 48 Meanings of glyph reference point codes are as follows: | |
| 49 | |
| 50 0----1----2 <---- ascent 0:tl or top-left | |
| 51 | | 1:tc or top-center | |
| 52 | | 2:tr or top-right | |
| 53 | | 3:Bl or base-left 9:cl or center-left | |
| 54 9 10 11 <---- center 4:Bc or base-center 10:cc or center-center | |
| 55 | | 5:Br or base-right 11:cr or center-right | |
| 56 --3----4----5-- <-- baseline 6:bl or bottom-left | |
| 57 | | 7:bc or bottom-center | |
| 58 6----7----8 <---- descent 8:br or bottom-right | |
| 59 | |
| 60 Glyph reference point symbols are to be used to specify composition | |
| 61 rule of the form \(GLOBAL-REF-POINT . NEW-REF-POINT), where | |
| 62 GLOBAL-REF-POINT is a reference point in the overall glyphs already | |
| 63 composed, and NEW-REF-POINT is a reference point in the new glyph to | |
| 64 be added. | |
| 65 | |
| 66 For instance, if GLOBAL-REF-POINT is `br' (bottom-right) and | |
| 67 NEW-REF-POINT is `tc' (top-center), the overall glyph is updated as | |
| 68 follows (the point `*' corresponds to both reference points): | |
| 69 | |
| 70 +-------+--+ <--- new ascent | |
| 71 | | | | |
| 72 | global| | | |
| 73 | glyph | | | |
| 74 -- | | |-- <--- baseline \(doesn't change) | |
| 75 +----+--*--+ | |
| 76 | | new | | |
| 77 | |glyph| | |
| 78 +----+-----+ <--- new descent | |
| 79 ") | |
| 80 | |
| 81 ;; Encode composition rule RULE into an integer value. RULE is a cons | |
| 82 ;; of global and new reference point symbols. | |
| 83 ;; This must be compatible with C macro COMPOSITION_ENCODE_RULE | |
| 84 ;; defined in mule-composite.h. | |
| 85 | |
| 86 (defun encode-composition-rule (rule) | |
| 87 (if (and (integerp rule) (< rule 144)) | |
| 88 ;; Already encoded. | |
| 89 rule | |
| 90 (or (consp rule) | |
| 91 (error "Invalid composition rule: %S" rule)) | |
| 92 (let ((gref (car rule)) | |
| 93 (nref (cdr rule))) | |
| 94 (or (integerp gref) | |
| 95 (setq gref (cdr (assq gref reference-point-alist)))) | |
| 96 (or (integerp nref) | |
| 97 (setq nref (cdr (assq nref reference-point-alist)))) | |
| 98 (or (and (>= gref 0) (< gref 12) (>= nref 0) (< nref 12)) | |
| 99 (error "Invalid composition rule: %S" rule)) | |
| 100 (+ (* gref 12) nref)))) | |
| 101 | |
| 102 ;; Decode encoded composition rule RULE-CODE. The value is a cons of | |
| 103 ;; global and new reference point symbols. | |
| 104 ;; This must be compatible with C macro COMPOSITION_DECODE_RULE | |
| 105 ;; defined in mule-composite.h. | |
| 106 | |
| 107 (defun decode-composition-rule (rule-code) | |
| 108 (or (and (natnump rule-code) (< rule-code 144)) | |
| 109 (error "Invalid encoded composition rule: %S" rule-code)) | |
| 110 (let ((gref (car (rassq (/ rule-code 12) reference-point-alist))) | |
| 111 (nref (car (rassq (% rule-code 12) reference-point-alist)))) | |
| 112 (or (and gref (symbolp gref) nref (symbolp nref)) | |
| 113 (error "Invalid composition rule code: %S" rule-code)) | |
| 114 (cons gref nref))) | |
| 115 | |
| 116 ;; Encode composition rules in composition components COMPONENTS. The | |
| 117 ;; value is a copy of COMPONENTS, where composition rules (cons of | |
| 118 ;; global and new glyph reference point symbols) are replaced with | |
| 119 ;; encoded composition rules. Optional 2nd argument NOCOPY non-nil | |
| 120 ;; means don't make a copy but modify COMPONENTS directly. | |
| 121 | |
| 122 (defun encode-composition-components (components &optional nocopy) | |
| 123 (or nocopy | |
| 124 (setq components (copy-sequence components))) | |
| 125 (if (vectorp components) | |
| 126 (let ((len (length components)) | |
| 127 (i 1)) | |
| 128 (while (< i len) | |
| 129 (aset components i | |
| 130 (encode-composition-rule (aref components i))) | |
| 131 (setq i (+ i 2)))) | |
| 132 (let ((tail (cdr components))) | |
| 133 (while tail | |
| 134 (setcar tail | |
| 135 (encode-composition-rule (car tail))) | |
| 136 (setq tail (nthcdr 2 tail))))) | |
| 137 components) | |
| 138 | |
| 139 ;; Decode composition rule codes in composition components COMPONENTS. | |
| 140 ;; The value is a copy of COMPONENTS, where composition rule codes are | |
| 141 ;; replaced with composition rules (cons of global and new glyph | |
| 142 ;; reference point symbols). Optional 2nd argument NOCOPY non-nil | |
| 143 ;; means don't make a copy but modify COMPONENTS directly. | |
| 144 ;; It is assumed that COMPONENTS is a vector and is for rule-base | |
| 145 ;; composition, thus (2N+1)th elements are rule codes. | |
| 146 | |
| 147 (defun decode-composition-components (components &optional nocopy) | |
| 148 (or nocopy | |
| 149 (setq components (copy-sequence components))) | |
| 150 (let ((len (length components)) | |
| 151 (i 1)) | |
| 152 (while (< i len) | |
| 153 (aset components i | |
| 154 (decode-composition-rule (aref components i))) | |
| 155 (setq i (+ i 2)))) | |
| 156 components) | |
| 157 | |
| 158 ;;;###autoload | |
| 159 (defun compose-region (start end &optional components modification-func) | |
| 160 "UNIMPLEMENTED. | |
| 161 Compose characters in the current region. | |
| 162 | |
| 163 When called from a program, expects these four arguments. | |
| 164 | |
| 165 First two arguments START and END are positions (integers or markers) | |
| 166 specifying the region. | |
| 167 | |
| 168 Optional 3rd argument COMPONENTS, if non-nil, is a character or a | |
| 169 sequence (vector, list, or string) of integers. | |
| 170 | |
| 171 If it is a character, it is an alternate character to display instead | |
| 172 of the text in the region. | |
| 173 | |
| 174 If it is a string, the elements are alternate characters. | |
| 175 | |
| 176 If it is a vector or list, it is a sequence of alternate characters and | |
| 177 composition rules, where (2N)th elements are characters and (2N+1)th | |
| 178 elements are composition rules to specify how to compose (2N+2)th | |
| 179 elements with previously composed N glyphs. | |
| 180 | |
| 181 A composition rule is a cons of global and new glyph reference point | |
| 182 symbols. See the documentation of `reference-point-alist' for more | |
| 183 detail. | |
| 184 | |
| 185 Optional 4th argument MODIFICATION-FUNC is a function to call to | |
| 186 adjust the composition when it gets invalid because of a change of | |
| 187 text in the composition." | |
| 188 (interactive "r") | |
| 189 (let ((modified-p (buffer-modified-p)) | |
| 190 (buffer-read-only nil)) | |
| 191 (if (or (vectorp components) (listp components)) | |
| 192 (setq components (encode-composition-components components))) | |
| 193 (compose-region-internal start end components modification-func) | |
| 194 (set-buffer-modified-p modified-p))) | |
| 195 | |
| 196 ;;;###autoload | |
| 197 (defun decompose-region (start end) | |
| 198 "UNIMPLEMENTED. | |
| 199 Decompose text in the current region. | |
| 200 | |
| 201 When called from a program, expects two arguments, | |
| 202 positions (integers or markers) specifying the region." | |
| 203 (interactive "r") | |
| 204 (let ((modified-p (buffer-modified-p)) | |
| 205 (buffer-read-only nil)) | |
| 206 (remove-text-properties start end '(composition nil)) | |
| 207 (set-buffer-modified-p modified-p))) | |
| 208 | |
| 209 ;;;###autoload | |
| 210 (defun compose-string (string &optional start end components modification-func) | |
| 211 "UNIMPLEMENTED. | |
| 212 Compose characters in string STRING. | |
| 213 | |
| 214 The return value is STRING where `composition' property is put on all | |
| 215 the characters in it. | |
| 216 | |
| 217 Optional 2nd and 3rd arguments START and END specify the range of | |
| 218 STRING to be composed. They defaults to the beginning and the end of | |
| 219 STRING respectively. | |
| 220 | |
| 221 Optional 4th argument COMPONENTS, if non-nil, is a character or a | |
| 222 sequence (vector, list, or string) of integers. See the function | |
| 223 `compose-region' for more detail. | |
| 224 | |
| 225 Optional 5th argument MODIFICATION-FUNC is a function to call to | |
| 226 adjust the composition when it gets invalid because of a change of | |
| 227 text in the composition." | |
| 228 (if (or (vectorp components) (listp components)) | |
| 229 (setq components (encode-composition-components components))) | |
| 230 (or start (setq start 0)) | |
| 231 (or end (setq end (length string))) | |
| 232 (compose-string-internal string start end components modification-func) | |
| 233 string) | |
| 234 | |
| 235 ;;;###autoload | |
| 236 (defun decompose-string (string) | |
| 237 "UNIMPLEMENTED. | |
| 238 Return STRING where `composition' property is removed." | |
| 239 (remove-text-properties 0 (length string) '(composition nil) string) | |
| 240 string) | |
| 241 | |
| 242 ;;;###autoload | |
| 243 (defun compose-chars (&rest args) | |
| 244 "UNIMPLEMENTED. | |
| 245 Return a string from arguments in which all characters are composed. | |
| 246 For relative composition, arguments are characters. | |
| 247 For rule-based composition, Mth \(where M is odd) arguments are | |
| 248 characters, and Nth \(where N is even) arguments are composition rules. | |
| 249 A composition rule is a cons of glyph reference points of the form | |
| 250 \(GLOBAL-REF-POINT . NEW-REF-POINT). See the documentation of | |
| 251 `reference-point-alist' for more detail." | |
| 252 (let (str components) | |
| 253 (if (consp (car (cdr args))) | |
| 254 ;; Rule-base composition. | |
| 255 (let (;(len (length args)) | |
| 256 (tail (encode-composition-components args 'nocopy))) | |
| 257 | |
| 258 (while tail | |
| 259 (setq str (cons (car tail) str)) | |
| 260 (setq tail (nthcdr 2 tail))) | |
| 261 (setq str (concat (nreverse str)) | |
| 262 components args)) | |
| 263 ;; Relative composition. | |
| 264 (setq str (concat args))) | |
| 265 (compose-string-internal str 0 (length str) components))) | |
| 266 | |
| 267 ;;;###autoload | |
| 268 (defun find-composition (pos &optional limit string detail-p) | |
| 269 "UNIMPLEMENTED. | |
| 270 Return information about a composition at or nearest to buffer position POS. | |
| 271 | |
| 272 If the character at POS has `composition' property, the value is a list | |
| 273 of FROM, TO, and VALID-P. | |
| 274 | |
| 275 FROM and TO specify the range of text that has the same `composition' | |
| 276 property, VALID-P is non-nil if and only if this composition is valid. | |
| 277 | |
| 278 If there's no composition at POS, and the optional 2nd argument LIMIT | |
| 279 is non-nil, search for a composition toward LIMIT. | |
| 280 | |
| 281 If no composition is found, return nil. | |
| 282 | |
| 283 Optional 3rd argument STRING, if non-nil, is a string to look for a | |
| 284 composition in; nil means the current buffer. | |
| 285 | |
| 286 If a valid composition is found and the optional 4th argument DETAIL-P | |
| 287 is non-nil, the return value is a list of FROM, TO, COMPONENTS, | |
| 288 RELATIVE-P, MOD-FUNC, and WIDTH. | |
| 289 | |
| 290 COMPONENTS is a vector of integers, the meaning depends on RELATIVE-P. | |
| 291 | |
| 292 RELATIVE-P is t if the composition method is relative, else nil. | |
| 293 | |
| 294 If RELATIVE-P is t, COMPONENTS is a vector of characters to be | |
| 295 composed. If RELATIVE-P is nil, COMPONENTS is a vector of characters | |
| 296 and composition rules as described in `compose-region'. | |
| 297 | |
| 298 MOD-FUNC is a modification function of the composition. | |
| 299 | |
| 300 WIDTH is a number of columns the composition occupies on the screen." | |
| 301 (let ((result (find-composition-internal pos limit string detail-p))) | |
| 302 (if (and detail-p result (nth 2 result) (not (nth 3 result))) | |
| 303 ;; This is a valid rule-base composition. | |
| 304 (decode-composition-components (nth 2 result) 'nocopy)) | |
| 305 result)) | |
| 306 | |
| 307 | |
| 308 ;;;###autoload | |
| 309 (defun compose-chars-after (pos &optional limit object) | |
| 310 "UNIMPLEMENTED. | |
| 311 Compose characters in current buffer after position POS. | |
| 312 | |
| 313 It looks up the char-table `composition-function-table' (which see) by | |
| 314 a character after POS. If non-nil value is found, the format of the | |
| 315 value should be an alist of PATTERNs vs FUNCs, where PATTERNs are | |
| 316 regular expressions and FUNCs are functions. If the text after POS | |
| 317 matches one of PATTERNs, call the corresponding FUNC with three | |
| 318 arguments POS, TO, and PATTERN, where TO is the end position of text | |
| 319 matching PATTERN, and return what FUNC returns. Otherwise, return | |
| 320 nil. | |
| 321 | |
| 322 FUNC is responsible for composing the text properly. The return value | |
| 323 is: | |
| 324 nil -- if no characters were composed. | |
| 325 CHARS (integer) -- if CHARS characters were composed. | |
| 326 | |
| 327 Optional 2nd arg LIMIT, if non-nil, limits the matching of text. | |
| 328 | |
| 329 Optional 3rd arg OBJECT, if non-nil, is a string that contains the | |
| 330 text to compose. In that case, POS and LIMIT index to the string. | |
| 331 | |
| 332 This function is the default value of `compose-chars-after-function'." | |
| 333 (let ((tail (get-char-table (char-after pos) composition-function-table)) | |
| 334 pattern func result) | |
| 335 (when tail | |
| 336 (save-match-data | |
| 337 (save-excursion | |
| 338 (while (and tail (not func)) | |
| 339 (setq pattern (car (car tail)) | |
| 340 func (cdr (car tail))) | |
| 341 (goto-char pos) | |
| 342 (if (if limit | |
| 343 (and (re-search-forward pattern limit t) | |
| 344 (= (match-beginning 0) pos)) | |
| 345 (looking-at pattern)) | |
| 346 (setq result (funcall func pos (match-end 0) pattern nil)) | |
| 347 (setq func nil tail (cdr tail))))))) | |
| 348 result)) | |
| 349 | |
| 350 ;;;###autoload | |
| 351 (defun compose-last-chars (args) | |
| 352 "UNIMPLEMENTED. | |
| 353 Compose last characters. | |
| 354 The argument is a parameterized event of the form | |
| 355 \(compose-last-chars N COMPONENTS), | |
| 356 where N is the number of characters before point to compose, | |
| 357 COMPONENTS, if non-nil, is the same as the argument to `compose-region' | |
| 358 \(which see). If it is nil, `compose-chars-after' is called, | |
| 359 and that function find a proper rule to compose the target characters. | |
| 360 This function is intended to be used from input methods. | |
| 361 The global keymap binds special event `compose-last-chars' to this | |
| 362 function. Input method may generate an event (compose-last-chars N COMPONENTS) | |
| 363 after a sequence character events." | |
| 364 (interactive "e") | |
| 365 (let ((chars (nth 1 args))) | |
| 366 (if (and (numberp chars) | |
| 367 (>= (- (point) (point-min)) chars)) | |
| 368 (if (nth 2 args) | |
| 369 (compose-region (- (point) chars) (point) (nth 2 args)) | |
| 370 (compose-chars-after (- (point) chars) (point)))))) | |
| 371 | |
| 372 ;;;###autoload(global-set-key [compose-last-chars] 'compose-last-chars) | |
| 373 | |
| 374 | |
| 375 ;;; The following codes are only for backward compatibility with Emacs | |
| 376 ;;; 20.4 and the earlier. | |
| 377 | |
| 378 ;;;###autoload | |
| 379 (defun decompose-composite-char (char &optional type with-composition-rule) | |
| 380 "UNIMPLEMENTED. | |
| 381 Convert CHAR to string. | |
| 382 This is only for backward compatibility with Emacs 20.4 and the earlier. | |
| 383 | |
| 384 If optional 2nd arg TYPE is non-nil, it is `string', `list', or | |
| 385 `vector'. In this case, CHAR is converted string, list of CHAR, or | |
| 386 vector of CHAR respectively." | |
| 387 (cond ((or (null type) (eq type 'string)) (char-to-string char)) | |
| 388 ((eq type 'list) (list char)) | |
| 389 (t (vector char)))) | |
| 390 | |
| 391 (make-obsolete 'decompose-composite-char 'char-to-string | |
| 392 ;;"21.1" | |
| 393 ) | |
| 394 | |
| 395 | |
| 396 ;;; mule-composite.el ends here |