comparison lisp/international/ucs-tables.el @ 88155:d7ddb3e565de

sync with trunk

88154:8ce476d3ba36

;;; ucs-tables.el --- translation to, from and via Unicode  -*- coding: iso-2022-7bit -*-

;; Copyright (C) 2001, 2002  Free Software Foundation, Inc.

;; Author: Dave Love <[e-mail]>
;; Keywords: i18n

;; This file is part of GNU Emacs.

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This file provides tables mapping between Unicode numbers and
;; emacs-mule characters from the iso-8859 charsets (and others).  It

    ;; translation-table.
    (remove-hook 'minibuffer-setup-hook 'ucs-minibuffer-setup))

  (when for-encode
    ;; Make mule-utf-* encode all characters in ucs-mule-to-mule-unicode.
    (let ((coding-list '(mule-utf-8 mule-utf-16-be mule-utf-16-le)))
      (define-translation-table 'utf-translation-table-for-encode
	ucs-mule-to-mule-unicode)
      (dolist (coding coding-list)
	(set-char-table-parent (coding-system-get coding 'safe-chars)
			       ucs-mule-to-mule-unicode)
	(register-char-codings coding ucs-mule-to-mule-unicode)))

    ;; Adjust the 8859 coding systems to fragment the unified characters
    ;; on encoding.
    (dolist (n '(1 2 3 4 5 7 8 9 14 15))
      (let* ((coding-system

	     (safe (coding-system-get coding-system 'safe-chars)))
	;; Actually, the coding system's safe-chars are not normally
	;; used after they've been registered, but we might as well
	;; record them.  Setting the parent here is a convenience.
	(set-char-table-parent safe table)
	;; Update the table of what encodes to what.
	(register-char-codings coding-system table)
	(coding-system-put coding-system 'translation-table-for-encode table)))
    (add-hook 'minibuffer-setup-hook 'ucs-minibuffer-setup))
  (optimize-char-coding-system-table))

(defun ucs-fragment-8859 (for-encode for-decode)
  "Undo the unification done by `ucs-unify-8859'.
With prefix arg, undo unification on encoding only, i.e. don't undo
unification on input operations."

  (when for-encode
    ;; Disable mule-utf-* encoding for all characters in
    ;; ucs-mule-to-mule-unicode except what was originally supported
    ;; and what is translated by utf-translation-table-for-decode when
    ;; `utf-fragment-on-decoding' is non-nil.
    (let ((coding-list '(mule-utf-8 mule-utf-16-be mule-utf-16-le))
	  (safe (coding-system-get 'mule-utf-8 'safe-chars)))
      (dolist (coding coding-list)
	(set-char-table-parent (coding-system-get coding 'safe-chars) nil))
      ;; Here we assume that all mule-utf-* have the same character
      ;; repertory, thus we can use SAFE for all of them.
      (map-char-table
       (lambda (key val)
	 (if (and (>= key 128) val
		  (not (aref safe key)))
	     (aset char-coding-system-table key
		   (remq 'mule-utf-8
			 (remq 'mule-utf-16-le
			       (remq 'mule-utf-16-be
				     (aref char-coding-system-table key)))))))
       ucs-mule-to-mule-unicode)

      (if (not utf-fragment-on-decoding)
	  (define-translation-table 'utf-translation-table-for-encode)
	(define-translation-table 'utf-translation-table-for-encode
	  utf-defragmentation-table)
	(dolist (coding coding-list)
	  (register-char-codings coding utf-defragmentation-table))))

    ;; For each charset, remove the entries in
    ;; `char-coding-system-table' added to its safe-chars table (as
    ;; its parent).
    (dolist (n '(1 2 3 4 5 7 8 9 14 15))
      (let* ((coding-system
	      (coding-system-base (intern (format "iso-8859-%d" n))))
	     (table (symbol-value
		     (intern (format "ucs-8859-%d-encode-table" n))))
	     (safe (coding-system-get coding-system 'safe-chars)))
	(when (char-table-parent safe)
	  (map-char-table
	   (lambda (key val)
	     (if (and (>= key 128) val)
		 (let ((codings (aref char-coding-system-table key)))
		   (aset char-coding-system-table key
			 (remq coding-system codings)))))
	   (char-table-parent safe))
	  (set-char-table-parent safe nil))
	(coding-system-put coding-system 'translation-table-for-encode nil)))
    (optimize-char-coding-system-table)
    (remove-hook 'minibuffer-setup-hook 'ucs-minibuffer-setup))
  (optimize-char-coding-system-table))

(defun ucs-insert (arg)
  "Insert the Emacs character representation of the given Unicode.
Interactively, prompts for a hex string giving the code."
  (interactive "sUnicode (hex): ")
  (let ((c (decode-char 'ucs (if (integerp arg)
				 arg
			       (string-to-number arg 16)))))
    (if c
	(insert c)
      (error "Character can't be decoded to UCS"))))

;;; Dealing with non-8859 character sets.

;; We only set up translation on encoding to utf-8.  Also translation
;; tables ucs-CS-encode-table are constructed for some coding systems

  "Set up translation-tables for unifying ISO 8859 characters on encoding.

The ISO 8859 characters sets overlap, e.g. 8859-1 (Latin-1) and
8859-15 (Latin-9) differ only in a few characters.  Emacs normally
distinguishes equivalent characters from those ISO-8859 character sets
which are built in to Emacs.  This behaviour is essentially inherited
from the European-originated international standards.  Treating them
equivalently, by translating to and from a single representation is
called `unification'.  (The `utf-8' coding system treats the
characters of European scripts in a unified manner.)

;; Arrange to set up the translation-table for keyboard input.  This
;; is called from get-buffer-create, set-buffer-file-coding-system,
;; normal-mode and minibuffer-setup-hook.
(defun ucs-set-table-for-input (&optional buffer)
  "Set up an appropriate `translation-table-for-input' for BUFFER.
BUFFER defaults to the current buffer."
  (when (and unify-8859-on-encoding-mode
	     (char-table-p translation-table-for-input))
    (let ((cs (and buffer-file-coding-system
		   (coding-system-base buffer-file-coding-system)))
	  table)
      (if (or (null cs)

	  (setq cs
		(and default-buffer-file-coding-system
		     (coding-system-base default-buffer-file-coding-system))))
      (when cs
	(setq table (coding-system-get cs 'translation-table-for-encode))
	(unless (char-table-p table)
	  (setq table (coding-system-get cs 'translation-table-for-input)))
	(when (char-table-p table)
	  (if buffer
	      (with-current-buffer buffer
		(set (make-variable-buffer-local 'translation-table-for-input)
		     table))
	    (set (make-variable-buffer-local 'translation-table-for-input)
		 table)))))))

;; The minibuffer needs to acquire a `buffer-file-coding-system' for
;; the above to work in it.
(defun ucs-minibuffer-setup ()

	 buffer-file-coding-system))
  (ucs-set-table-for-input))

(provide 'ucs-tables)

;;; ucs-tables.el ends here

88155:d7ddb3e565de

;;; ucs-tables.el --- translation to, from and via Unicode  -*- coding: iso-2022-7bit -*-

;; Copyright (C) 2001, 2002, 2003, 2005  Free Software Foundation, Inc.
;; Copyright (C) 2002, 2003
;;   National Institute of Advanced Industrial Science and Technology (AIST)
;;   Registration Number H14PRO021

;; Author: Dave Love <[e-mail]>
;; Keywords: i18n

;; This file is part of GNU Emacs.

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; This file provides tables mapping between Unicode numbers and
;; emacs-mule characters from the iso-8859 charsets (and others).  It

    ;; translation-table.
    (remove-hook 'minibuffer-setup-hook 'ucs-minibuffer-setup))

  (when for-encode
    ;; Make mule-utf-* encode all characters in ucs-mule-to-mule-unicode.
    (let ((coding-list '(mule-utf-8 mule-utf-16be mule-utf-16le
				    mule-utf-16be-with-signature
				    mule-utf-16le-with-signature)))
      (define-translation-table 'utf-translation-table-for-encode
	ucs-mule-to-mule-unicode)
      (dolist (coding coding-list)
	(set-char-table-parent (coding-system-get coding 'safe-chars)
			       ucs-mule-to-mule-unicode)))

    ;; Adjust the 8859 coding systems to fragment the unified characters
    ;; on encoding.
    (dolist (n '(1 2 3 4 5 7 8 9 14 15))
      (let* ((coding-system

	     (safe (coding-system-get coding-system 'safe-chars)))
	;; Actually, the coding system's safe-chars are not normally
	;; used after they've been registered, but we might as well
	;; record them.  Setting the parent here is a convenience.
	(set-char-table-parent safe table)
	(coding-system-put coding-system 'translation-table-for-encode table)))
    (add-hook 'minibuffer-setup-hook 'ucs-minibuffer-setup)))

(defun ucs-fragment-8859 (for-encode for-decode)
  "Undo the unification done by `ucs-unify-8859'.
With prefix arg, undo unification on encoding only, i.e. don't undo
unification on input operations."

  (when for-encode
    ;; Disable mule-utf-* encoding for all characters in
    ;; ucs-mule-to-mule-unicode except what was originally supported
    ;; and what is translated by utf-translation-table-for-decode when
    ;; `utf-fragment-on-decoding' is non-nil.
    (let ((coding-list '(mule-utf-8 mule-utf-16be mule-utf-16le
				    mule-utf-16be-with-signature
				    mule-utf-16le-with-signature))
	  (safe (coding-system-get 'mule-utf-8 'safe-chars)))
      (dolist (coding coding-list)
	(set-char-table-parent (coding-system-get coding 'safe-chars) nil))
      (if (not utf-fragment-on-decoding)
	  (define-translation-table 'utf-translation-table-for-encode)
	(define-translation-table 'utf-translation-table-for-encode
	  utf-defragmentation-table)))

    ;; For each charset, remove the parent of `safe-chars' property of
    ;; the corresponding coding system.
    (dolist (n '(1 2 3 4 5 7 8 9 14 15))
      (let* ((coding-system
	      (coding-system-base (intern (format "iso-8859-%d" n))))
	     (safe (coding-system-get coding-system 'safe-chars)))
	(if (char-table-parent safe)
	    (set-char-table-parent safe nil))
	(coding-system-put coding-system 'translation-table-for-encode nil)))
    (remove-hook 'minibuffer-setup-hook 'ucs-minibuffer-setup)))

(defun ucs-insert (arg)
  "Insert the Emacs character representation of the given Unicode.
Interactively, prompts for a hex string giving the code."
  (interactive "sUnicode (hex): ")
  (or (integerp arg)
      (setq arg (string-to-number arg 16)))
  (let ((c (decode-char 'ucs arg)))
    (if c
	(insert c)
      (if (or (< arg 0) (> arg #x10FFFF))
	  (error "Not a Unicode character code: 0x%X" arg)
	(error "Character U+%04X is not yet supported" arg)))))

;;; Dealing with non-8859 character sets.

;; We only set up translation on encoding to utf-8.  Also translation
;; tables ucs-CS-encode-table are constructed for some coding systems

  "Set up translation-tables for unifying ISO 8859 characters on encoding.

The ISO 8859 characters sets overlap, e.g. 8859-1 (Latin-1) and
8859-15 (Latin-9) differ only in a few characters.  Emacs normally
distinguishes equivalent characters from those ISO-8859 character sets
which are built in to Emacs.  This behavior is essentially inherited
from the European-originated international standards.  Treating them
equivalently, by translating to and from a single representation is
called `unification'.  (The `utf-8' coding system treats the
characters of European scripts in a unified manner.)

;; Arrange to set up the translation-table for keyboard input.  This
;; is called from get-buffer-create, set-buffer-file-coding-system,
;; normal-mode and minibuffer-setup-hook.
(defun ucs-set-table-for-input (&optional buffer)
  "Set up an appropriate `translation-table-for-input' for BUFFER.
BUFFER defaults to the current buffer.  This function is
automatically called directly at the end of `get-buffer-create'."
  (when (and unify-8859-on-encoding-mode
             (not unify-8859-on-decoding-mode)
	     (char-table-p translation-table-for-input))
    (let ((cs (and buffer-file-coding-system
		   (coding-system-base buffer-file-coding-system)))
	  table)
      (if (or (null cs)

	  (setq cs
		(and default-buffer-file-coding-system
		     (coding-system-base default-buffer-file-coding-system))))
      (when cs
	(setq table (coding-system-get cs 'translation-table-for-encode))
	(if (and table (symbolp table))
	    (setq table (get table 'translation-table)))
	(unless (char-table-p table)
	  (setq table (coding-system-get cs 'translation-table-for-input))
	  (if (and table (symbolp table))
	      (setq table (get table 'translation-table))))
	(when (char-table-p table)
	  (if buffer
	      (with-current-buffer buffer
		(set (make-local-variable 'translation-table-for-input)
		     table))
	    (set (make-local-variable 'translation-table-for-input)
		 table)))))))

;; The minibuffer needs to acquire a `buffer-file-coding-system' for
;; the above to work in it.
(defun ucs-minibuffer-setup ()

	 buffer-file-coding-system))
  (ucs-set-table-for-input))

(provide 'ucs-tables)

;; arch-tag: b497e22b-7fe1-486a-9352-e2d7f7d76a76
;;; ucs-tables.el ends here