Function: quail-insert-kbd-layout

quail-insert-kbd-layout is a byte-compiled function defined in quail.el.gz.

Signature

(quail-insert-kbd-layout KBD-LAYOUT)

Documentation

Insert the visual keyboard layout table according to KBD-LAYOUT.

The format of KBD-LAYOUT is the same as quail-keyboard-layout.

Source Code

;; Defined in /usr/src/emacs/lisp/international/quail.el.gz
(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)
    (setq bidi-paragraph-direction 'left-to-right)
    ;; 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
                        (if (> (length (cdr translation)) 0)
                            (aref (cdr translation) 0)
                          " ")))
	      (setq done-list (cons translation done-list)))
	  (setq translation (aref kbd-layout i)))
	(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 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)))
	(insert bar)
	(if (< (if (stringp lower) (string-width lower) (char-width lower)) 2)
	    (insert " "))
	(if (characterp lower)
            (setq lower
                  (if (eq (get-char-code-property lower 'general-category) 'Mn)
                      ;; Pad the left and right of non-spacing characters.
                      (compose-string (string lower) 0 1
                                      (format "\t%c\t" lower))
                    (string lower))))
	(if (characterp upper)
	    (setq upper
                  (if (eq (get-char-code-property upper 'general-category) 'Mn)
                      ;; Pad the left and right of non-spacing characters.
                      (compose-string (string upper) 0 1
                                      (format "\t%c\t" upper))
                    (string upper))))
	(insert (bidi-string-mark-left-to-right lower)
		(propertize " " 'invisible t)
		(bidi-string-mark-left-to-right upper))
	(if (< (string-width upper) 2)
	    (insert " "))
	(setq i (+ i 2))
	(if (= (% i 30) 0)
	    (insert bar "\n")))
      ;; Insert horizontal lines while deleting blank key columns at the
      ;; beginning and end of each line.
      (save-restriction
	(narrow-to-region pos (point))
	(goto-char pos)
	;;(while (looking-at "[| ]*$")
	;;(forward-line 1)
	;;(delete-region pos (point)))
	(let ((from1 100) (to1 0) from2 to2)
	  (while (not (eobp))
	    (if (looking-at "[| \u202c\u202d]*$")
		;; The entire row is blank.
		(delete-region (point) (match-end 0))
	      ;; Delete blank key columns at the head.
	      (if (looking-at "\u202d? *\\(|     \\)+")
		  (subst-char-in-region (point) (match-end 0) ?| ? ))
	      ;; Delete blank key columns at the tail.
	      (if (re-search-forward "\\(     |\\)+\u202c?$"
				     (line-end-position) t)
		  (delete-region (match-beginning 0) (point)))
	      (beginning-of-line))
	    ;; Calculate the start and end columns of a horizontal line.
	    (if (eolp)
		(setq from2 from1 to2 to1)
	      (skip-chars-forward " \u202d")
	      (setq from2 (current-column))
	      (end-of-line)
	      (setq to2 (current-column))
	      (if (< from2 from1)
		  (setq from1 from2))
	      (if (> to2 to1)
		  (setq to1 to2))
	      (beginning-of-line))
	    ;; If the previous or the current line has at least one key
	    ;; column, insert a horizontal line.
	    (when (> to1 0)
	      (insert-char 32 from1)
	      (setq pos (point))
	      (insert "+")
	      (insert-char ?- (- (- to1 from1) 2))
	      (insert "+")
	      (put-text-property pos (point) 'face 'bold)
	      (insert "\n"))
	    (setq from1 from2 to1 to2)
	    (forward-line 1)))
	;; Insert "space bar" box.
	(forward-line -1)
	(setq pos (point))
	(insert
"		    +-----------------------------+
		    |          space bar          |
		    +-----------------------------+
")
	(put-text-property pos (point) 'face 'bold)
	(insert ?\n)))

    done-list))