comparison lisp/international/mule-util.el @ 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.

26889:8ce2101d81c0

	    (setcdr alist (cons slot (cdr alist)))))
      (setq alist (cdr slot))
      (setq i (1+ i)))
    (setcar alist entry)
    (if branches
	(if (cdr alist)
	    (error "Can't set branches for keyseq %s" keyseq)
	  (setcdr alist branches)))))

;;;###autoload
(defun lookup-nested-alist (keyseq alist &optional len start nil-for-too-long)
  "Look up key sequence KEYSEQ in nested alist ALIST.  Return the definition.
Optional 1st argument LEN specifies the length of KEYSEQ.

			     (cons (coding-system-get x 'coding-category) x)))
		 coding-priority))
      (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:

    +-------+--+ <--- 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

26890:4cd9407a4683

	    (setcdr alist (cons slot (cdr alist)))))
      (setq alist (cdr slot))
      (setq i (1+ i)))
    (setcar alist entry)
    (if branches
	(setcdr (last alist) branches))))

;;;###autoload
(defun lookup-nested-alist (keyseq alist &optional len start nil-for-too-long)
  "Look up key sequence KEYSEQ in nested alist ALIST.  Return the definition.
Optional 1st argument LEN specifies the length of KEYSEQ.

			     (cons (coding-system-get x 'coding-category) x)))
		 coding-priority))
      (detect-coding-region from to))))


;;; mule-util.el ends here