Mercurial > emacs
changeset 26890:4cd9407a4683
(set-nested-alist): Set BRANCHES (if
non-nil) at the tail of ALIST.
(compose-region, decompose-region, decompse-string,
reference-point-alist, compose-chars): Moved to composite.el.
(compose-chars-component, compose-chars-rule,
decompose-composite-char): Deleted.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Wed, 15 Dec 1999 00:42:14 +0000 |
parents | 8ce2101d81c0 |
children | 651d521c8f52 |
files | lisp/international/mule-util.el |
diffstat | 1 files changed, 2 insertions(+), 215 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/international/mule-util.el Wed Dec 15 00:41:44 1999 +0000 +++ b/lisp/international/mule-util.el Wed Dec 15 00:42:14 1999 +0000 @@ -172,9 +172,7 @@ (setq i (1+ i))) (setcar alist entry) (if branches - (if (cdr alist) - (error "Can't set branches for keyseq %s" keyseq) - (setcdr alist branches))))) + (setcdr (last alist) branches)))) ;;;###autoload (defun lookup-nested-alist (keyseq alist &optional len start nil-for-too-long) @@ -290,216 +288,5 @@ (detect-coding-region from to)))) -;;; Composite character manipulations. - -;;;###autoload -(defun compose-region (start end) - "Compose all characters in the current region into one composite character. -When called from a program, expects two arguments, -positions (integers or markers) specifying the region." - (interactive "r") - (save-excursion - (let ((str (buffer-substring start end))) - (goto-char start) - (insert (compose-string str)) - (delete-char (- end start))))) - -;;;###autoload -(defun decompose-region (start end) - "Decompose all composite characters in the current region. -Composite characters are broken up into individual components. -When called from a program, expects two arguments, -positions (integers or markers) specifying the region." - (interactive "r") - (let ((buf (current-buffer)) - (cmpchar-head (char-to-string leading-code-composition))) - (with-temp-buffer - (insert-buffer-substring buf start end) - (set-buffer-multibyte nil) - (goto-char (point-min)) - (while (search-forward cmpchar-head nil t) - (if (looking-at "[\240-\377][\240-\377][\240-\377][\240-\377]+") - (let* ((from (1- (point))) - (to (match-end 0)) - (str (string-as-multibyte (buffer-substring from to)))) - (if (cmpcharp (string-to-char str)) - (progn - (delete-region from to) - (insert (string-as-unibyte (decompose-string str)))) - (goto-char to))))) - (set-buffer-multibyte t) - (let ((tempbuf (current-buffer))) - (save-excursion - (set-buffer buf) - (goto-char start) - (delete-region start end) - (insert-buffer-substring tempbuf)))))) - -;;;###autoload -(defun decompose-string (string) - "Decompose all composite characters in STRING." - (let ((len (length string)) - (idx 0) - (i 0) - (str-list nil) - ch) - (while (< idx len) - (setq ch (aref string idx)) - (if (>= ch min-composite-char) - (progn - (if (> idx i) - (setq str-list (cons (substring string i idx) str-list))) - (setq str-list (cons (decompose-composite-char ch) str-list)) - (setq i (1+ idx)))) - (setq idx (1+ idx))) - (if (not str-list) - (copy-sequence string) - (if (> idx i) - (setq str-list (cons (substring string i idx) str-list))) - (apply 'concat (nreverse str-list))))) - -;;;###autoload -(defconst reference-point-alist - '((tl . 0) (tc . 1) (tr . 2) - (ml . 3) (mc . 4) (mr . 5) - (bl . 6) (bc . 7) (br . 8) - (top-left . 0) (top-center . 1) (top-right . 2) - (mid-left . 3) (mid-center . 4) (mid-right . 5) - (bottom-left . 6) (bottom-center . 7) (bottom-right . 8) - (0 . 0) (1 . 1) (2 . 2) - (3 . 3) (4 . 4) (5 . 5) - (6 . 6) (7 . 7) (8 . 8)) - "Alist of reference point symbols vs reference point codes. -A reference point symbol is to be used to specify a composition rule -while making a composite character by the function `compose-chars' -(which see). - -Meanings of reference point codes are as follows: - - 0----1----2 <-- ascent 0:tl or top-left - | | 1:tc or top-center - | | 2:tr or top-right - | | 3:ml or mid-left - | 4 <--+---- center 4:mc or mid-center - | | 5:mr or mid-right ---- 3 5 <-- baseline 6:bl or bottom-left - | | 7:bc or bottom-center - 6----7----8 <-- descent 8:br or bottom-right - -Reference point symbols are to be used to specify composition rule of -the form \(GLOBAL-REF-POINT . NEW-REF-POINT), where GLOBAL-REF-POINT -is a reference point in the overall glyphs already composed, and -NEW-REF-POINT is a reference point in the new glyph to be added. - -For instance, if GLOBAL-REF-POINT is 8 and NEW-REF-POINT is 1, the -overall glyph is updated as follows: +;;; mule-util.el ends here - +-------+--+ <--- new ascent - | | | - | global| | - | glyph | | ---- | | | <--- baseline (doesn't change) - +----+--+--+ - | | new | - | |glyph| - +----+-----+ <--- new descent -") - -;; Return a string for char CH to be embedded in multibyte form of -;; composite character. -;;;###autoload -(defun compose-chars-component (ch) - (if (< ch 128) - (format "\240%c" (+ ch 128)) - (let ((str (string-as-unibyte (char-to-string ch)))) - (if (cmpcharp ch) - (if (= (aref str 1) ?\xFF) - (error "Can't compose a rule-based composition character") - (substring str (if (= (aref str 1) ?\xFF) 2 1))) - (aset str 0 (+ (aref str 0) ?\x20)) - str)))) - -;; Return a string for composition rule RULE to be embedded in -;; multibyte form of composite character. -(defsubst compose-chars-rule (rule) - (char-to-string (+ ?\xA0 - (* (cdr (assq (car rule) reference-point-alist)) 9) - (cdr (assq (cdr rule) reference-point-alist))))) - -;;;###autoload -(defun compose-chars (first-component &rest args) - "Return one char string composed from the arguments. -For relative composition, each argument should be a non-composition character -or a relative-composition character. -For rule-based composition, Nth (where N is odd) argument should be -a non-composition character or a rule-based-composition character, -and Mth (where M is even) argument should be a composition rule. -A composition rule has the form \(GLOBAL-REF-POINT . NEW-REF-POINT). -See the documentation of `reference-point-alist' for more detail." - (if (= (length args) 0) - (char-to-string first-component) - (let* ((with-rule (consp (car args))) - (str (if (cmpcharp first-component) - (string-as-unibyte (char-to-string first-component)) - (if with-rule - (concat (vector leading-code-composition ?\xFF) - (compose-chars-component first-component)) - (concat (char-to-string leading-code-composition) - (compose-chars-component first-component)))))) - (if (and (cmpcharp first-component) - (eq with-rule (/= (aref str 1) ?\xFF))) - (error "%s-compostion-character is not allowed in %s composition: %c" - (if with-rule "relative" "rule-based") - (if with-rule "rule-based" "relative") - first-component)) - (while args - (if with-rule - (setq str (concat str (compose-chars-rule (car args))) - args (cdr args))) - (if (cmpcharp (car args)) - (let ((cmp-str (string-as-unibyte (char-to-string (car args))))) - (if (eq with-rule (/= (aref cmp-str 1) ?\xFF)) - (error "%s-compostion-character is not allowed in %s composition: %c" - (if with-rule "relative" "rule-based") - (if with-rule "rule-based" "relative") - (car args))) - (setq str (concat str (substring cmp-str - (if with-rule 2 1))))) - (setq str (concat str (compose-chars-component (car args))))) - (setq args (cdr args))) - (string-as-multibyte str)))) - -;;;###autoload -(defun decompose-composite-char (char &optional type with-composition-rule) - "Convert composite character CHAR to a sequence of the components. -Optional 1st arg TYPE specifies the type of sequence returned. -It should be `string' (default), `list', or `vector'. -Optional 2nd arg WITH-COMPOSITION-RULE non-nil means the returned -sequence contains embedded composition rules if any. In this case, the -order of elements in the sequence is the same as arguments for -`compose-chars' to create CHAR. -If TYPE is omitted or is `string', composition rules are omitted -even if WITH-COMPOSITION-RULE is t." - (or type - (setq type 'string)) - (let* ((len (composite-char-component-count char)) - (i (1- len)) - l) - (setq with-composition-rule (and with-composition-rule - (not (eq type 'string)) - (composite-char-composition-rule-p char))) - (while (> i 0) - (setq l (cons (composite-char-component char i) l)) - (if with-composition-rule - (let ((rule (- (composite-char-composition-rule char i) ?\xA0))) - (setq l (cons (cons (/ rule 9) (% rule 9)) l)))) - (setq i (1- i))) - (setq l (cons (composite-char-component char 0) l)) - (cond ((eq type 'string) - (apply 'string l)) - ((eq type 'list) - l) - (t ; i.e. TYPE is vector - (vconcat l))))) - -;;; mule-util.el ends here