root/trunk/lisp/international/quail.el

;;; quail.el --- provides simple input method for multilingual text

;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
;;   2006, 2007, 2008  Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
;;   2005, 2006, 2007, 2008
;;   National Institute of Advanced Industrial Science and Technology (AIST)
;;   Registration Number H14PRO021

;; Author: Kenichi HANDA <handa@etl.go.jp>
;;         Naoto TAKAHASHI <ntakahas@etl.go.jp>
;; Maintainer: Kenichi HANDA <handa@etl.go.jp>
;; Keywords: mule, multilingual, input method, i18n

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; 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:

;; In Quail minor mode, you can input multilingual text easily.  By
;; defining a translation table (named Quail map) which maps ASCII key
;; string to multilingual character or string, you can input any text
;; from ASCII keyboard.
;;
;; We use words "translation" and "conversion" differently.  The
;; former is done by Quail package itself, the latter is the further
;; process of converting a translated text to some more desirable
;; text.  For instance, Quail package for Japanese (`quail-jp')
;; translates Roman text (transliteration of Japanese in Latin
;; alphabets) to Hiragana text, which is then converted to
;; Kanji-and-Kana mixed text or Katakana text by commands specified in
;; CONVERSION-KEYS argument of the Quail package.

;; [There was an input method for Mule 2.3 called `Tamago' from the
;; Japanese `TAkusan MAtasete GOmenasai', or `Sorry for having you
;; wait so long'; this couldn't be included in Emacs 20.  `Tamago' is
;; Japanese for `egg' (implicitly a hen's egg).  Handa-san made a
;; smaller and simpler system; the smaller quail egg is also eaten in
;; Japan.  Maybe others will be egged on to write more sorts of input
;; methods.]

;;; Code:

(require 'help-mode)

(defgroup quail nil
  "Quail: multilingual input method."
  :group 'leim)

;; Buffer local variables

(defvar quail-current-package nil
  "The current Quail package, which depends on the current input method.
See the documentation of `quail-package-alist' for the format.")
(make-variable-buffer-local 'quail-current-package)
(put 'quail-current-package 'permanent-local t)

;; Quail uses the following variables to assist users.
;; A string containing available key sequences or translation list.
(defvar quail-guidance-str nil)
;; A buffer to show completion list of the current key sequence.
(defvar quail-completion-buf nil)
;; We may display the guidance string in a buffer on a one-line frame.
(defvar quail-guidance-buf nil)
(defvar quail-guidance-frame nil)

;; Each buffer in which Quail is activated should use different
;; guidance string.
(make-variable-buffer-local 'quail-guidance-str)
(put 'quail-guidance-str 'permanent-local t)

(defvar quail-overlay nil
  "Overlay which covers the current translation region of Quail.")
(make-variable-buffer-local 'quail-overlay)

(defvar quail-conv-overlay nil
  "Overlay which covers the text to be converted in Quail mode.")
(make-variable-buffer-local 'quail-conv-overlay)

(defvar quail-current-key nil
  "Current key for translation in Quail mode.")
(make-variable-buffer-local 'quail-current-key)

(defvar quail-current-str nil
  "Currently selected translation of the current key.")
(make-variable-buffer-local 'quail-current-str)

(defvar quail-current-translations nil
  "Cons of indices and vector of possible translations of the current key.
Indices is a list of (CURRENT START END BLOCK BLOCKS), where
CURRENT is an index of the current translation,
START and END are indices of the start and end of the current block,
BLOCK is the current block index,
BLOCKS is a number of  blocks of translation.")
(make-variable-buffer-local 'quail-current-translations)

(defvar quail-current-data nil
  "Any Lisp object holding information of current translation status.
When a key sequence is mapped to TRANS and TRANS is a cons
of actual translation and some Lisp object to be referred
for translating the longer key sequence, this variable is set
to that Lisp object.")
(make-variable-buffer-local 'quail-current-data)

;; Quail package handlers.

(defvar quail-package-alist nil
  "List of Quail packages.
A Quail package is a list of these elements:
  NAME, TITLE, QUAIL-MAP, GUIDANCE, DOCSTRING, TRANSLATION-KEYS,
  FORGET-LAST-SELECTION, DETERMINISTIC, KBD-TRANSLATE, SHOW-LAYOUT,
  DECODE-MAP, MAXIMUM-SHORTEST, OVERLAY-PLIST, UPDATE-TRANSLATION-FUNCTION,
  CONVERSION-KEYS, SIMPLE.

QUAIL-MAP is a data structure to map key strings to translations.  For
the format, see the documentation of `quail-map-p'.

DECODE-MAP is an alist of translations and corresponding keys.

See the documentation of `quail-define-package' for the other elements.")

;; Return various slots in the current quail-package.

(defsubst quail-name ()
  "Return the name of the current Quail package."
  (nth 0 quail-current-package))
;;;###autoload
(defun quail-title ()
  "Return the title of the current Quail package."
  (let ((title (nth 1 quail-current-package)))
    ;; TITLE may be a string or a list.  If it is a list, each element
    ;; is a string or the form (VAR STR1 STR2), and the interpretation
    ;; of the list is the same as that of mode-line-format.
    (if (stringp title)
        title
      (condition-case nil
          (mapconcat
           (lambda (x)
             (cond ((stringp x) x)
                   ((and (listp x) (symbolp (car x)) (= (length x) 3))
                    (if (symbol-value (car x))
                        (nth 1 x) (nth 2 x)))
                   (t "")))
           title "")
        (error "")))))
(defsubst quail-map ()
  "Return the translation map of the current Quail package."
  (nth 2 quail-current-package))
(defsubst quail-guidance ()
  "Return an object used for `guidance' feature of the current Quail package.
See also the documentation of `quail-define-package'."
  (nth 3 quail-current-package))
(defsubst quail-docstring ()
  "Return the documentation string of the current Quail package."
  (nth 4 quail-current-package))
(defsubst quail-translation-keymap ()
  "Return translation keymap in the current Quail package.
Translation keymap is a keymap used while translation region is active."
  (nth 5 quail-current-package))
(defsubst quail-forget-last-selection ()
  "Return `forget-last-selection' flag of the current Quail package.
See also the documentation of `quail-define-package'."
  (nth 6 quail-current-package))
(defsubst quail-deterministic ()
  "Return `deterministic' flag of the current Quail package.
See also the documentation of `quail-define-package'."
  (nth 7 quail-current-package))
(defsubst quail-kbd-translate ()
  "Return `kbd-translate' flag of the current Quail package.
See also the documentation of `quail-define-package'."
  (nth 8 quail-current-package))
(defsubst quail-show-layout ()
  "Return `show-layout' flag of the current Quail package.
See also the documentation of `quail-define-package'."
  (nth 9 quail-current-package))
(defsubst quail-decode-map ()
  "Return decode map of the current Quail package.
It is an alist of translations and corresponding keys."
  (nth 10 quail-current-package))
(defsubst quail-maximum-shortest ()
  "Return `maximum-shortest' flag of the current Quail package.
See also the documentation of `quail-define-package'."
  (nth 11 quail-current-package))
(defsubst quail-overlay-plist ()
  "Return property list of an overly used in the current Quail package."
  (nth 12 quail-current-package))
(defsubst quail-update-translation-function ()
  "Return a function for updating translation in the current Quail package."
  (nth 13 quail-current-package))
(defsubst quail-conversion-keymap ()
  "Return conversion keymap in the current Quail package.
Conversion keymap is a keymap used while conversion region is active
 but translation region is not active."
  (nth 14 quail-current-package))
(defsubst quail-simple ()
  "Return t if the current Quail package is simple."
  (nth 15 quail-current-package))

(defsubst quail-package (name)
  "Return Quail package named NAME."
  (assoc name quail-package-alist))

(defun quail-add-package (package)
  "Add Quail package PACKAGE to `quail-package-alist'."
  (let ((pac (quail-package (car package))))
    (if pac
        (setcdr pac (cdr package))
      (setq quail-package-alist (cons package quail-package-alist)))))

(defun quail-select-package (name)
  "Select Quail package named NAME as the current Quail package."
  (let ((package (quail-package name)))
    (if (null package)
        (error "No Quail package `%s'" name))
    (setq quail-current-package package)
    (setq-default quail-current-package package)
    name))

;;;###autoload
(defun quail-use-package (package-name &rest libraries)
  "Start using Quail package PACKAGE-NAME.
The remaining arguments are libraries to be loaded before using the package.

This activates input method defined by PACKAGE-NAME by running
`quail-activate', which see."
  (let ((package (quail-package package-name)))
    (if (null package)
        ;; Perhaps we have not yet loaded necessary libraries.
        (while libraries
          (if (not (load (car libraries) t))
              (progn
                (with-output-to-temp-buffer "*Help*"
                  (princ "Quail package \"")
                  (princ package-name)
                  (princ "\" can't be activated\n  because library \"")
                  (princ (car libraries))
                  (princ "\" is not in `load-path'.

The most common case is that you have not yet installed appropriate
libraries in LEIM (Libraries of Emacs Input Method) which is
distributed separately from Emacs.

LEIM is available from the same ftp directory as Emacs."))
                (error "Can't use the Quail package `%s'" package-name))
            (setq libraries (cdr libraries))))))
  (quail-select-package package-name)
  (setq current-input-method-title (quail-title))
  (quail-activate)
  ;; Hide all '... loaded' message.
  (message nil))

(defvar quail-translation-keymap
  (let ((map (make-keymap))
        (i 0))
    (while (< i ?\ )
      (define-key map (char-to-string i) 'quail-other-command)
      (setq i (1+ i)))
    (while (< i 127)
      (define-key map (char-to-string i) 'quail-self-insert-command)
      (setq i (1+ i)))
    (setq i 128)
    (while (< i 256)
      (define-key map (vector i) 'quail-self-insert-command)
      (setq i (1+ i)))
    (define-key map "\177" 'quail-delete-last-char)
    (define-key map "\C-f" 'quail-next-translation)
    (define-key map "\C-b" 'quail-prev-translation)
    (define-key map "\C-n" 'quail-next-translation-block)
    (define-key map "\C-p" 'quail-prev-translation-block)
    (define-key map [right] 'quail-next-translation)
    (define-key map [left] 'quail-prev-translation)
    (define-key map [down] 'quail-next-translation-block)
    (define-key map [up] 'quail-prev-translation-block)
    (define-key map "\C-i" 'quail-completion)
    (define-key map "\C-@" 'quail-select-current)
    ;; Following simple.el, Enter key on numeric keypad selects the
    ;; current translation just like `C-SPC', and `mouse-2' chooses
    ;; any completion visible in the *Quail Completions* buffer.
    (define-key map [kp-enter] 'quail-select-current)
    (define-key map [mouse-2] 'quail-mouse-choose-completion)
    (define-key map [down-mouse-2] nil)
    (define-key map "\C-h" 'quail-translation-help)
    (define-key map [?\C- ] 'quail-select-current)
    (define-key map [tab] 'quail-completion)
    (define-key map [delete] 'quail-delete-last-char)
    (define-key map [backspace] 'quail-delete-last-char)
    map)
  "Keymap used processing translation in complex Quail modes.
Only a few especially complex input methods use this map;
most use `quail-simple-translation-keymap' instead.
This map is activated while translation region is active.")

(defvar quail-translation-docstring
  "When you type keys, the echo area shows the possible characters
which correspond to that key sequence, each preceded by a digit.  You
can select one of the characters shown by typing the corresponding
digit.  Alternatively, you can use C-f and C-b to move through the
line to select the character you want, then type a letter to begin
entering another Chinese character or type a space or punctuation
character.

If there are more than ten possible characters for the given spelling,
the echo area shows ten characters at a time; you can use C-n to move
to the next group of ten, and C-p to move back to the previous group
of ten.")

;; Categorize each Quail commands to make the output of quail-help
;; concise.  This is done by putting `quail-help' property.  The value
;; is:
;;      hide -- never show this command
;;      non-deterministic -- show only for non-deterministic input method
(let ((l '((quail-other-command . hide)
           (quail-self-insert-command . hide)
           (quail-delete-last-char . hide)
           (quail-next-translation . non-deterministic)
           (quail-prev-translation . non-deterministic)
           (quail-next-translation-block . non-deterministic)
           (quail-prev-translation-block . non-deterministic))))
  (while l
    (put (car (car l)) 'quail-help (cdr (car l)))
    (setq l (cdr l))))

(defvar quail-simple-translation-keymap
  (let ((map (make-keymap))
        (i 0))
    (while (< i ?\ )
      (define-key map (char-to-string i) 'quail-other-command)
      (setq i (1+ i)))
    (while (< i 127)
      (define-key map (char-to-string i) 'quail-self-insert-command)
      (setq i (1+ i)))
    (setq i 128)
    (while (< i 256)
      (define-key map (vector i) 'quail-self-insert-command)
      (setq i (1+ i)))
    (define-key map "\177" 'quail-delete-last-char)
    (define-key map [delete] 'quail-delete-last-char)
    (define-key map [backspace] 'quail-delete-last-char)
    ;;(let ((meta-map (make-sparse-keymap)))
    ;;(define-key map (char-to-string meta-prefix-char) meta-map)
    ;;(define-key map [escape] meta-map))
    map)
  "Keymap used while processing translation in simple Quail modes.
A few especially complex input methods use `quail-translation-keymap' instead.
This map is activated while translation region is active.")

(defvar quail-conversion-keymap
  (let ((map (make-keymap))
        (i ?\ ))
    (while (< i 127)
      (define-key map (char-to-string i) 'quail-self-insert-command)
      (setq i (1+ i)))
    (setq i 128)
    (while (< i 256)
      (define-key map (vector i) 'quail-self-insert-command)
      (setq i (1+ i)))
    (define-key map "\C-b" 'quail-conversion-backward-char)
    (define-key map "\C-f" 'quail-conversion-forward-char)
    (define-key map "\C-a" 'quail-conversion-beginning-of-region)
    (define-key map "\C-e" 'quail-conversion-end-of-region)
    (define-key map "\C-d" 'quail-conversion-delete-char)
    (define-key map "\C-k" 'quail-conversion-delete-tail)
    (define-key map "\C-h" 'quail-translation-help)
    (define-key map "\177" 'quail-conversion-backward-delete-char)
    (define-key map [delete] 'quail-conversion-backward-delete-char)
    (define-key map [backspace] 'quail-conversion-backward-delete-char)
    map)
  "Keymap used for processing conversion in Quail mode.
This map is activated while conversion region is active but translation
region is not active.")

;; Just a dummy definition.
(defun quail-other-command ()
  (interactive)
  )

;;;###autoload
(defun quail-define-package (name language title
                                  &optional guidance docstring translation-keys
                                  forget-last-selection deterministic
                                  kbd-translate show-layout create-decode-map
                                  maximum-shortest overlay-plist
                                  update-translation-function
                                  conversion-keys simple)
  "Define NAME as a new Quail package for input LANGUAGE.
TITLE is a string to be displayed at mode-line to indicate this package.
Optional arguments are GUIDANCE, DOCSTRING, TRANSLATION-KEYS,
 FORGET-LAST-SELECTION, DETERMINISTIC, KBD-TRANSLATE, SHOW-LAYOUT,
 CREATE-DECODE-MAP, MAXIMUM-SHORTEST, OVERLAY-PLIST,
 UPDATE-TRANSLATION-FUNCTION, CONVERSION-KEYS and SIMPLE.

GUIDANCE specifies how a guidance string is shown in echo area.
If it is t, list of all possible translations for the current key is shown
 with the currently selected translation being highlighted.
If it is an alist, the element has the form (CHAR . STRING).  Each character
 in the current key is searched in the list and the corresponding string is
 shown.
If it is nil, the current key is shown.

DOCSTRING is the documentation string of this package.  The command
`describe-input-method' shows this string while replacing the form
\\=\\<VAR> in the string by the value of VAR.  That value should be a
string.  For instance, the form \\=\\<quail-translation-docstring> is
replaced by a description about how to select a translation from a
list of candidates.

TRANSLATION-KEYS specifies additional key bindings used while translation
region is active.  It is an alist of single key character vs. corresponding
command to be called.

FORGET-LAST-SELECTION non-nil means a selected translation is not kept
for the future to translate the same key.  If this flag is nil, a
translation selected for a key is remembered so that it can be the
first candidate when the same key is entered later.

DETERMINISTIC non-nil means the first candidate of translation is
selected automatically without allowing users to select another
translation for a key.  In this case, unselected translations are of
no use for an interactive use of Quail but can be used by some other
programs.  If this flag is non-nil, FORGET-LAST-SELECTION is also set
to t.

KBD-TRANSLATE non-nil means input characters are translated from a
user's keyboard layout to the standard keyboard layout.  See the
documentation of `quail-keyboard-layout' and
`quail-keyboard-layout-standard' for more detail.

SHOW-LAYOUT non-nil means the `quail-help' command should show
the user's keyboard layout visually with translated characters.
If KBD-TRANSLATE is set, it is desirable to set also this flag unless
this package defines no translations for single character keys.

CREATE-DECODE-MAP non-nil means decode map is also created.  A decode
map is an alist of translations and corresponding original keys.
Although this map is not used by Quail itself, it can be used by some
other programs.  For instance, Vietnamese supporting needs this map to
convert Vietnamese text to VIQR format which uses only ASCII
characters to represent Vietnamese characters.

MAXIMUM-SHORTEST non-nil means break key sequence to get maximum
length of the shortest sequence.  When we don't have a translation of
key \"..ABCD\" but have translations of \"..AB\" and \"CD..\", break
the key at \"..AB\" and start translation of \"CD..\".  Hangul
packages, for instance, use this facility.  If this flag is nil, we
break the key just at \"..ABC\" and start translation of \"D..\".

OVERLAY-PLIST if non-nil is a property list put on an overlay which
covers Quail translation region.

UPDATE-TRANSLATION-FUNCTION if non-nil is a function to call to update
the current translation region according to a new translation data.  By
default, a translated text or a user's key sequence (if no translation
for it) is inserted.

CONVERSION-KEYS specifies additional key bindings used while
conversion region is active.  It is an alist of single key character
vs. corresponding command to be called.

If SIMPLE is non-nil, then we do not alter the meanings of
commands such as C-f, C-b, C-n, C-p and TAB; they are treated as
non-Quail commands."
  (let (translation-keymap conversion-keymap)
    (if deterministic (setq forget-last-selection t))
    (if translation-keys
        (progn
          (setq translation-keymap (copy-keymap
                                    (if simple quail-simple-translation-keymap
                                      quail-translation-keymap)))
          (while translation-keys
            (define-key translation-keymap
              (car (car translation-keys)) (cdr (car translation-keys)))
            (setq translation-keys (cdr translation-keys))))
      (setq translation-keymap
            (if simple quail-simple-translation-keymap
              quail-translation-keymap)))
    (when conversion-keys
      (setq conversion-keymap (copy-keymap quail-conversion-keymap))
      (while conversion-keys
        (define-key conversion-keymap
          (car (car conversion-keys)) (cdr (car conversion-keys)))
        (setq conversion-keys (cdr conversion-keys))))
    (quail-add-package
     (list name title (list nil) guidance (or docstring "")
           translation-keymap
           forget-last-selection deterministic kbd-translate show-layout
           (if create-decode-map (list 'decode-map) nil)
           maximum-shortest overlay-plist update-translation-function
           conversion-keymap simple))

    ;; Update input-method-alist.
    (let ((slot (assoc name input-method-alist))
          (val (list language 'quail-use-package title docstring)))
      (if slot (setcdr slot val)
        (setq input-method-alist (cons (cons name val) input-method-alist)))))

  (quail-select-package name))

;; Quail minor mode handlers.

;; Setup overlays used in Quail mode.
(defun quail-setup-overlays (conversion-mode)
  (let ((pos (point)))
    (if (overlayp quail-overlay)
        (move-overlay quail-overlay pos pos)
      (setq quail-overlay (make-overlay pos pos))
      (if input-method-highlight-flag
          (overlay-put quail-overlay 'face 'underline))
      (let ((l (quail-overlay-plist)))
        (while l
          (overlay-put quail-overlay (car l) (car (cdr l)))
          (setq l (cdr (cdr l))))))
    (if conversion-mode
        (if (overlayp quail-conv-overlay)
            (if (not (overlay-start quail-conv-overlay))
                (move-overlay quail-conv-overlay pos pos))
          (setq quail-conv-overlay (make-overlay pos pos))
          (if input-method-highlight-flag
              (overlay-put quail-conv-overlay 'face 'underline))))))

;; Delete overlays used in Quail mode.
(defun quail-delete-overlays ()
  (if (and (overlayp quail-overlay) (overlay-start quail-overlay))
      (delete-overlay quail-overlay))
  (if (and (overlayp quail-conv-overlay) (overlay-start quail-conv-overlay))
      (delete-overlay quail-conv-overlay)))

(defun quail-inactivate ()
  "Inactivate Quail input method.

This function runs the normal hook `quail-inactivate-hook'."
  (interactive)
  (quail-activate -1))

(defun quail-activate (&optional arg)
  "Activate Quail input method.
With arg, activate Quail input method if and only if arg is positive.

This function runs `quail-activate-hook' if it activates the input
method, `quail-inactivate-hook' if it deactivates it.

While this input method is active, the variable
`input-method-function' is bound to the function `quail-input-method'."
  (if (and arg
          (< (prefix-numeric-value arg) 0))
      ;; Let's inactivate Quail input method.
      (unwind-protect
          (progn
            (quail-delete-overlays)
            (setq describe-current-input-method-function nil)
            (quail-hide-guidance)
            (remove-hook 'post-command-hook 'quail-show-guidance t)
            (run-hooks 'quail-inactivate-hook))
        (kill-local-variable 'input-method-function))
    ;; Let's activate Quail input method.
    (if (null quail-current-package)
        ;; Quail package is not yet selected.  Select one now.
        (let (name)
          (if quail-package-alist
              (setq name (car (car quail-package-alist)))
            (error "No Quail package loaded"))
          (quail-select-package name)))
    (setq inactivate-current-input-method-function 'quail-inactivate)
    (setq describe-current-input-method-function 'quail-help)
    (quail-delete-overlays)
    (setq quail-guidance-str "")
    (quail-show-guidance)
    ;; If we are in minibuffer, turn off the current input method
    ;; before exiting.
    (when (eq (selected-window) (minibuffer-window))
      (add-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer)
      (add-hook 'post-command-hook 'quail-show-guidance nil t))
    (run-hooks 'quail-activate-hook)
    (make-local-variable 'input-method-function)
    (setq input-method-function 'quail-input-method)))

(defun quail-exit-from-minibuffer ()
  (inactivate-input-method)
  (if (<= (minibuffer-depth) 1)
      (remove-hook 'minibuffer-exit-hook 'quail-exit-from-minibuffer)))

;; Keyboard layout translation handlers.

;; Some Quail packages provide localized keyboard simulation which
;; requires a particular keyboard layout.  In this case, what we need
;; is locations of keys the user entered, not character codes
;; generated by those keys.  However, for the moment, there's no
;; common way to get such information.  So, we ask a user to give
;; information of his own keyboard layout, then translate it to the
;; standard layout which we defined so that all Quail packages depend
;; just on it.

(defconst quail-keyboard-layout-standard
  "\
                              \
  1!2@3#4$5%6^7&8*9(0)-_=+`~  \
  qQwWeErRtTyYuUiIoOpP[{]}    \
  aAsSdDfFgGhHjJkKlL;:'\"\\|    \
  zZxXcCvVbBnNmM,<.>/?        \
                              "
  "Standard keyboard layout of printable characters Quail assumes.
See the documentation of `quail-keyboard-layout' for this format.
This layout is almost the same as that of VT100,
 but the location of key \\ (backslash) is just right of key ' (single-quote),
 not right of RETURN key.")

(defconst quail-keyboard-layout-len 180)

;; Here we provide several examples of famous keyboard layouts.
;; This is a candidate for a language environment-dependent setting.
(defvar quail-keyboard-layout-alist
  (list
   (cons "standard" quail-keyboard-layout-standard)
   '("sun-type3" . "\
                              \
  1!2@3#4$5%6^7&8*9(0)-_=+\\|`~\
  qQwWeErRtTyYuUiIoOpP[{]}    \
  aAsSdDfFgGhHjJkKlL;:'\"      \
  zZxXcCvVbBnNmM,<.>/?        \
                              ")
   '("atari-german" . "\
                              \
  1!2\"3\2474$5%6&7/8(9)0=\337?'`#^  \
  qQwWeErRtTzZuUiIoOpP\374\334+*    \
  aAsSdDfFgGhHjJkKlL\366\326\344\304~|    \
<>yYxXcCvVbBnNmM,;.:-_        \
                              ")

   '("pc102-de" . "\
                              \
^\2601!2\"3\2474$5%6&7/8(9)0=\337?\264`#'  \
  qQwWeErRtTzZuUiIoOpP\374\334+*    \
  aAsSdDfFgGhHjJkKlL\366\326\344\304      \
<>yYxXcCvVbBnNmM,;.:-_        \
                              ")

   '("jp106" . "\
                              \
  1!2\"3#4$5%6&7'8(9)0~-=^~\\|  \
  qQwWeErRtTyYuUiIoOpP@`[{    \
  aAsSdDfFgGhHjJkKlL;+:*]}    \
  zZxXcCvVbBnNmM,<.>/?\\_      \
                              ")
   '("pc105-uk" . "\
                              \
`\2541!2\"3\2434$5%6^7&8*9(0)-_=+     \
  qQwWeErRtTyYuUiIoOpP[{]}    \
  aAsSdDfFgGhHjJkKlL;:'@#~    \
\\|zZxXcCvVbBnNmM,<.>/?        \
                              ")
   )
  "Alist of keyboard names and corresponding layout strings.
See the documentation of `quail-keyboard-layout' for the format of
the layout string.")

(defcustom quail-keyboard-layout quail-keyboard-layout-standard
  "A string which represents physical key layout of a particular keyboard.
We assume there are six rows and each row has 15 keys (columns),
        the first row is above the `1' - `0' row,
        the first column of the second row is left of key `1',
        the first column of the third row is left of key `q',
        the first column of the fourth row is left of key `a',
        the first column of the fifth row is left of key `z',
        the sixth row is below the `z' - `/' row.
Nth (N is even) and (N+1)th characters in the string are non-shifted
and shifted characters respectively at the same location.
The location of Nth character is row (N / 30) and column ((N mod 30) / 2).
The command `quail-set-keyboard-layout' usually sets this variable."
  :group 'quail
  :type `(choice
          ,@(mapcar (lambda (pair)
                      (list 'const :tag (car pair) (cdr pair)))
                    quail-keyboard-layout-alist)
          (string :tag "Other")))

;; A non-standard keyboard layout may miss some key locations of the
;; standard layout while having additional key locations not in the
;; standard layout.  This alist maps those additional key locations to
;; the missing locations.  The value is updated automatically by
;; quail-set-keyboard-layout.
(defvar quail-keyboard-layout-substitution nil)

(defun quail-update-keyboard-layout (kbd-type)
  (let ((layout (assoc kbd-type quail-keyboard-layout-alist)))
    (if (null layout)
        ;; Here, we had better ask a user to define his own keyboard
        ;; layout interactively.
        (error "Unknown keyboard type `%s'" kbd-type))
    (setq quail-keyboard-layout (cdr layout))
    (let ((i quail-keyboard-layout-len)
          subst-list missing-list)
      ;; Sum up additional key locations not in the standard layout in
      ;; subst-list, and missing key locations in missing-list.
      (while (> i 0)
        (setq i (1- i))
        (if (= (aref quail-keyboard-layout i) ? )
            (if (/= (aref quail-keyboard-layout-standard i) ? )
                (setq missing-list (cons i missing-list)))
          (if (= (aref quail-keyboard-layout-standard i) ? )
              (setq subst-list (cons (cons i nil) subst-list)))))
      (setq quail-keyboard-layout-substitution subst-list)
      ;; If there are additional key locations, map them to missing
      ;; key locations.
      (while missing-list
        (while (and subst-list (cdr (car subst-list)))
          (setq subst-list (cdr subst-list)))
        (if subst-list
            (setcdr (car subst-list) (car missing-list)))
        (setq missing-list (cdr missing-list))))))

(defcustom quail-keyboard-layout-type "standard"
  "Type of keyboard layout used in Quail base input method.
Available types are listed in the variable `quail-keyboard-layout-alist'."
  :group 'quail
  :type (cons 'choice (mapcar (lambda (elt)
                                (list 'const (car elt)))
                              quail-keyboard-layout-alist))
  :set #'(lambda (symbol value)
           (quail-update-keyboard-layout value)
           (set symbol value)))

;;;###autoload
(defun quail-set-keyboard-layout (kbd-type)
  "Set the current keyboard layout to the same as keyboard KBD-TYPE.

Since some Quail packages depends on a physical layout of keys (not
characters generated by them), those are created by assuming the
standard layout defined in `quail-keyboard-layout-standard'.  This
function tells Quail system the layout of your keyboard so that what
you type is correctly handled."
  (interactive
   (let* ((completion-ignore-case t)
          (type (completing-read "Keyboard type: "
                                 quail-keyboard-layout-alist)))
     (list type)))
  (quail-update-keyboard-layout kbd-type)
  (setq quail-keyboard-layout-type kbd-type))

(defun quail-keyboard-translate (char)
  "Translate CHAR to the one in the standard keyboard layout."
  (if (eq quail-keyboard-layout quail-keyboard-layout-standard)
      ;; All Quail packages are designed based on
      ;; `quail-keyboard-layout-standard'.
      char
    (let ((i 0))
      ;; Find the key location on the current keyboard layout.
      (while (and (< i quail-keyboard-layout-len)
                  (/= char (aref quail-keyboard-layout i)))
        (setq i (1+ i)))
      (if (= i quail-keyboard-layout-len)
          ;; CHAR is not in quail-keyboard-layout, which means that a
          ;; user typed a key which generated a character code to be
          ;; handled out of Quail.  Just return CHAR and make
          ;; quail-execute-non-quail-command handle it correctly.
          char
        (let ((ch (aref quail-keyboard-layout-standard i)))
          (if (= ch ?\ )
              ;; This location not available in the standard keyboard
              ;; layout.  Check if the location is used to substitute
              ;; for the other location of the standard layout.
              (if (setq i (cdr (assq i quail-keyboard-layout-substitution)))
                  (aref quail-keyboard-layout-standard i)
                ;; Just return CHAR as well as above.
                char)
            ch))))))

(defun quail-keyseq-translate (keyseq)
  (apply 'string
         (mapcar (function (lambda (x) (quail-keyboard-translate x)))
                 keyseq)))

(defun quail-insert-kbd-layout (kbd-layout)
"Insert the visual keyboard layout table according to KBD-LAYOUT.
The format of KBD-LAYOUT is the same as `quail-keyboard-layout'."
  (let (done-list layout i ch)
    ;; At first, convert KBD-LAYOUT to the same size vector that
    ;; contains translated character or string.
    (setq layout (string-to-vector kbd-layout)
          i 0)
    (while (< i quail-keyboard-layout-len)
      (setq ch (aref kbd-layout i))
      (if (quail-kbd-translate)
          (setq ch (quail-keyboard-translate ch)))
      (let* ((map (cdr (assq ch (cdr (quail-map)))))
             (translation (and map (quail-get-translation
                                    (car map) (char-to-string ch) 1))))
        (if translation
            (progn
              (if (consp translation)
                  (setq translation (aref (cdr translation) 0)))
              (setq done-list (cons translation done-list)))
          (setq translation ch))
        (aset layout i translation))
      (setq i (1+ i)))

    (let ((pos (point))
          (bar "|")
          lower upper row)
      ;; Make table without horizontal lines.  Each column for a key
      ;; has the form "| LU |" where L is for lower key and and U is
      ;; for a upper key.  If width of L (U) is greater than 1,
      ;; preceding (following) space is not inserted.
      (put-text-property 0 1 'face 'bold bar)
      (setq i 0)
      (while (< i quail-keyboard-layout-len)
        (when (= (% i 30) 0)
          (setq row (/ i 30))
          (if (> row 1)
              (insert-char 32 (+ row (/ (- row 2) 2)))))
        (setq lower (aref layout i)
              upper (aref layout (1+ i)))
        (if (and (integerp lower) (>= lower 128) (< lower 256))
            (setq lower (unibyte-char-to-multibyte lower)))
        (if (and (integerp upper) (>= upper 128) (< upper 256))
            (setq upper (unibyte-char-to-multibyte upper)))
        (insert bar)
        (if (= (if (stringp lower) (string-width lower) (char-width lower)) 1)
            (insert " "