Function: make-translation-table

make-translation-table is a byte-compiled function defined in mule.el.gz.

Signature

(make-translation-table &rest ARGS)

Documentation

Make a translation table from arguments.

A translation table is a char table intended for character translation in CCL programs.

Each argument is a list of elements of the form (FROM . TO), where FROM is a character to be translated to TO.

The arguments and forms in each argument are processed in the given order, and if a previous form already translates TO to some other character, say TO-ALT, FROM is also translated to TO-ALT.

View in manual

Source Code

;; Defined in /usr/src/emacs/lisp/international/mule.el.gz
(defun make-translation-table (&rest args)
  "Make a translation table from arguments.
A translation table is a char table intended for character
translation in CCL programs.

Each argument is a list of elements of the form (FROM . TO), where FROM
is a character to be translated to TO.

The arguments and forms in each argument are processed in the given
order, and if a previous form already translates TO to some other
character, say TO-ALT, FROM is also translated to TO-ALT."
  (let ((table (make-char-table 'translation-table))
	revlist)
    (dolist (elts args)
      (dolist (elt elts)
	(let ((from (car elt))
	      (to (cdr elt))
	      to-alt rev-from rev-to)
	  ;; If we have already translated TO to TO-ALT, FROM should
	  ;; also be translated to TO-ALT.
	  (if (setq to-alt (aref table to))
	      (setq to to-alt))
	  (aset table from to)
	  ;; If we have already translated some chars to FROM, they
	  ;; should also be translated to TO.
	  (when (setq rev-from (assq from revlist))
	    (dolist (elt (cdr rev-from))
	      (aset table elt to))
	    (setq revlist (delq rev-from revlist)
		  rev-from (cdr rev-from)))
	  ;; Now update REVLIST.
	  (setq rev-to (assq to revlist))
	  (if rev-to
	      (setcdr rev-to (cons from (cdr rev-to)))
	    (setq rev-to (list to from)
		  revlist (cons rev-to revlist)))
	  (if rev-from
	      (setcdr rev-to (append rev-from (cdr rev-to)))))))
    ;; Return TABLE just created.
    (set-char-table-extra-slot table 1 1)
    table))