Merge changes from emacs-23 branch
[bpt/emacs.git] / lisp / international / quail.el
index db2e09c..2174beb 100644 (file)
@@ -1,9 +1,8 @@
 ;;; quail.el --- provides simple input method for multilingual text
 
-;; Copyright (C) 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005,
-;;   2006, 2007, 2008, 2009  Free Software Foundation, Inc.
+;; Copyright (C) 1997-1998, 2000-2011  Free Software Foundation, Inc.
 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009
+;;   2005, 2006, 2007, 2008, 2009, 2010, 2011
 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
 ;;   Registration Number H14PRO021
 
@@ -54,6 +53,7 @@
 ;;; Code:
 
 (require 'help-mode)
+(eval-when-compile (require 'cl))
 
 (defgroup quail nil
   "Quail: multilingual input method."
@@ -662,7 +662,7 @@ This layout is almost the same as that of VT100,
                               ")
    '("pc105-uk" . "\
                               \
-`\2541!2\"3\2434$5%6^7&8*9(0)-_=+     \
+`\2541!2\"3\2434$5%6^7&8*9(0)-_=+    \
   qQwWeErRtTyYuUiIoOpP[{]}    \
   aAsSdDfFgGhHjJkKlL;:'@#~    \
 \\|zZxXcCvVbBnNmM,<.>/?        \
@@ -810,7 +810,7 @@ The format of KBD-LAYOUT is the same as `quail-keyboard-layout'."
                      (setq translation (aref (cdr translation) 0))
                    (setq translation " ")))
              (setq done-list (cons translation done-list)))
-         (setq translation ch))
+         (setq translation (aref kbd-layout i)))
        (aset layout i translation))
       (setq i (1+ i)))
 
@@ -830,10 +830,6 @@ The format of KBD-LAYOUT is the same as `quail-keyboard-layout'."
              (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 " "))
@@ -1024,9 +1020,8 @@ the following annotation types are supported.
        (while l
          (setq key (car (car l)) trans (car (cdr (car l))) l (cdr l))
          (quail-defrule-internal key trans map t decode-map props))
-       `(if (not (quail-decode-map))
-            (quail-install-map ',map)
-          (quail-install-map ',map)
+       `(if (prog1 (quail-decode-map)
+              (quail-install-map ',map))
           (quail-install-decode-map ',decode-map))))))
 
 ;;;###autoload
@@ -1095,7 +1090,10 @@ to the current translations for KEY instead of replacing them."
 
 (defun quail-vunion (v1 v2)
   (apply 'vector
-         (nreverse (delete-dups (nconc (append v1 ()) (append v2 ()))))))
+         ;; No idea why this was here, but it seems to cause the
+         ;; incorrect ordering, according to Nils Anders Danielsson.
+         ;; (nreverse
+         (delete-dups (nconc (append v1 ()) (append v2 ()))))) ;; )
 
 ;;;###autoload
 (defun quail-defrule-internal (key trans map &optional append decode-map props)
@@ -1294,11 +1292,12 @@ If STR has `advice' text property, append the following special event:
 \(quail-advice STR)"
   (let ((events (mapcar
                 (lambda (c)
-                  ;; This gives us the chance to unify on input
-                  ;; (e.g. using ucs-tables.el).
-                  (or (and translation-table-for-input
-                           (aref translation-table-for-input c))
-                      c))
+                  (or
+                   ;; Avoid "obsolete" warnings for translation-table-for-input.
+                   (with-no-warnings
+                     (and translation-table-for-input
+                          (aref translation-table-for-input c)))
+                   c))
                 str)))
     (if (or (get-text-property 0 'advice str)
            (next-single-property-change 0 'advice str))
@@ -1931,6 +1930,10 @@ Remaining args are for FUNC."
                    (frame-char-height) (* internal-border 2) (* border 2))))
     (if (< newtop 0)
        (setq newtop (+ top (frame-pixel-height) internal-border border)))
+    ;; If I leave the `parent-id' parameter, my frame ends up with 13 lines
+    ;; rather than just 1.  Not sure what is really going on, but
+    ;; clearly this parameter is not needed.  --Stef
+    (setq fparam (delq (assoc 'parent-id fparam) fparam))
     (make-frame (append '((user-position . t) (height . 1)
                          (minibuffer)
                          (menu-bar-lines . 0) (tool-bar-lines . 0))
@@ -1994,7 +1997,7 @@ minibuffer and the selected frame has no other windows)."
            ;; window system.
            (let ((guidance quail-guidance-str))
              (or (frame-live-p quail-guidance-frame)
-                 (setq quail-guidance-frame 
+                 (setq quail-guidance-frame
                        (quail-make-guidance-frame)))
              (or (buffer-live-p quail-guidance-buf)
                  (setq quail-guidance-buf
@@ -2003,14 +2006,15 @@ minibuffer and the selected frame has no other windows)."
                (erase-buffer)
                (setq cursor-type nil)
                (insert guidance))
-             (set-window-buffer (frame-root-window quail-guidance-frame)
-                                quail-guidance-buf)
+              (let ((win (frame-root-window quail-guidance-frame)))
+                (set-window-buffer win quail-guidance-buf)
+                (set-window-dedicated-p win t))
              (quail-minibuffer-message
               (format " [%s]" current-input-method-title)))
          ;; Show the guidance in the next line of the currrent
          ;; minibuffer.
          (quail-minibuffer-message
-          (format "  [%s]\n%s" 
+          (format "  [%s]\n%s"
                   current-input-method-title quail-guidance-str)))
       ;; Show the guidance in echo area without logging.
       (let ((message-log-max nil))
@@ -2183,7 +2187,7 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
   (setq this-command 'quail-completion))
 
 (defun quail-completion-1 (key map indent)
-"List all completions of KEY in MAP with indentation INDENT."
+  "List all completions of KEY in MAP with indentation INDENT."
   (let ((len (length key)))
     (quail-indent-to indent)
     (insert key ":")
@@ -2194,20 +2198,12 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
       (insert " -\n"))
     (setq indent (+ indent 2))
     (if (and (cdr map) (< (/ (1- indent) 2) quail-completion-max-depth))
-       (let ((l (cdr map))
-             (newkey (make-string (1+ len) 0))
-             (i 0))
+       (let ((l (cdr map)))
          (if (functionp l)
              (setq l (funcall l)))
-         ;; Set KEY in the first LEN characters of NEWKEY.
-         (while (< i len)
-           (aset newkey i (aref key i))
-           (setq i (1+ i)))
-         (setq l (reverse l))
-         (while l                      ; L = ((CHAR . DEFN) ....) ;
-           (aset newkey len (car (car l)))
-           (quail-completion-1 newkey (cdr (car l)) indent)
-           (setq l (cdr l)))))))
+         (dolist (elt (reverse l))     ; L = ((CHAR . DEFN) ....) ;
+           (quail-completion-1 (concat key (string (car elt)))
+                                (cdr elt) indent))))))
 
 (defun quail-completion-list-translations (map key indent)
   "List all possible translations of KEY in Quail MAP with indentation INDENT."
@@ -2245,13 +2241,15 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
 
 (defun quail-mouse-choose-completion (event)
   "Click on an alternative in the `*Quail Completions*' buffer to choose it."
-  (interactive "e")
   ;; This function is an exact copy of the mouse.el function
   ;; `mouse-choose-completion' except that we:
-  ;; 1) add two lines from `choose-completion' in simple.el to give
-  ;;    the `mouse-2' click a little more leeway.
   ;; 2) don't bury *Quail Completions* buffer, so comment a section, and
   ;; 3) delete/terminate the current quail selection here.
+  ;; FIXME: Consolidate with `choose-completion'.  The point number
+  ;; 1 has been done, already.  The point number 3 should be fairly
+  ;; easy to move to a choose-completion-string-function.  So all
+  ;; that's left is point number 2.
+  (interactive "e")
   ;; Give temporary modes such as isearch a chance to turn off.
   (run-hooks 'mouse-leave-buffer-hook)
   (let ((buffer (window-buffer))
@@ -2291,6 +2289,7 @@ are shown (at most to the depth specified `quail-completion-max-depth')."
 ;; previous implementation.
 (defun quail-choose-completion-string (choice &optional buffer base-size)
   (setq quail-current-str choice)
+  ;; FIXME: We need to pass `base-position' here.
   (choose-completion-string choice buffer))
 
 (defun quail-build-decode-map (map-list key decode-map num
@@ -2373,38 +2372,62 @@ should be made by `quail-build-decode-map' (which see)."
           (if (> width single-trans-width)
               (setq single-trans-width width)))))
     (when single-list
-      ;; Since decode-map is sorted, we known the longest key is at the end.
-      (let* ((max-key-width (max 3 (length (caar (last single-list)))))
+      ;; Figure out how many columns can fit.
+      (let* ((len (length single-list))
+             ;; The longest key is at the end, by virtue of the above `sort'.
+             (max-key-width (max 3 (length (caar (last single-list)))))
+             ;; Starting point: worst case.
              (col-width (+ max-key-width 1 single-trans-width 1))
              (cols (/ window-width col-width))
-             (rows (/ (+ (length single-list) (1- cols)) cols)) ; Round up.
-             col pos row)
-        (insert "key")
-        (quail-indent-to (1+ max-key-width))
-        (insert "char")
-        (quail-indent-to (1+ col-width))
+             rows)
+        ;; Now, let's see if we can pack in a few more columns since
+        ;; the first columns can often be made narrower thanks to the
+        ;; length-sorting.
+        (while (let ((newrows (/ (+ len cols) (1+ cols))) ;Round up.
+                     (width 0))
+                 (dotimes (col (1+ cols))
+                   (let ((last-col-elt (or (nth (1- (* (1+ col) newrows))
+                                                single-list)
+                                           (car (last single-list)))))
+                     (incf width (+ (max 3 (length (car last-col-elt)))
+                                    1 single-trans-width 1))))
+                 (< width window-width))
+          (incf cols))
+        (setq rows (/ (+ len cols -1) cols)) ;Round up.
+        (let ((key-width (max 3 (length (car (nth (1- rows) single-list))))))
+          (insert "key")
+          (quail-indent-to (1+ key-width))
+          (insert "char")
+          (quail-indent-to (+ 1 key-width 1 single-trans-width 1)))
         (insert "[type a key sequence to insert the corresponding character]\n")
-        (setq pos (point))
-        (insert-char ?\n (+ rows 2))
-        (goto-char pos)
-        (setq col (- col-width) row 0)
-        (dolist (elt single-list)
-          (when (= (% row rows) 0)
+        (let ((pos (point))
+              (col 0))
+          (insert-char ?\n (+ rows 2))
+          (while single-list
             (goto-char pos)
-            (setq col (+ col col-width))
-            (move-to-column col)
-            (quail-indent-to col)
-            (insert-char ?- max-key-width)
-            (insert ? )
-            (insert-char ?- single-trans-width)
-            (forward-line 1))
-          (move-to-column col)
-          (quail-indent-to col)
-          (insert (car elt))
-          (quail-indent-to (+ col max-key-width 1))
-          (insert (cdr elt))
-          (forward-line 1)
-          (setq row (1+ row)))
+            (let* ((key-width (max 3 (length
+                                      (car (or (nth (1- rows) single-list)
+                                               (car (last single-list)))))))
+                   (col-width (+ key-width 1 single-trans-width 1)))
+              ;; Insert the header-line.
+              (move-to-column col)
+              (quail-indent-to col)
+              (insert-char ?- key-width)
+              (insert ?\s)
+              (insert-char ?- single-trans-width)
+              (forward-line 1)
+              ;; Insert the key-tran pairs.
+              (dotimes (row rows)
+                (let ((elt (pop single-list)))
+                  (when elt
+                    (move-to-column col)
+                    (quail-indent-to col)
+                    (insert (propertize (car elt)
+                                        'face 'font-lock-comment-face))
+                    (quail-indent-to (+ col key-width 1))
+                    (insert (cdr elt))
+                    (forward-line 1))))
+              (setq col (+ col col-width)))))
         (goto-char (point-max))))
 
     (when multiple-list
@@ -2416,7 +2439,8 @@ should be made by `quail-build-decode-map' (which see)."
         (insert-char ?- max-key-width)
         (insert " ------------\n")
         (dolist (elt multiple-list)
-          (insert (car elt))
+          (insert (propertize (car elt)
+                              'face 'font-lock-comment-face))
           (quail-indent-to max-key-width)
           (if (vectorp (cdr elt))
               (mapc (function
@@ -2644,10 +2668,12 @@ KEY BINDINGS FOR CONVERSION
          (or (string= key elt)
              (aset table char (list key elt))))
       (aset table char key))
-    (if (and translation-table-for-input
-            (setq char (aref translation-table-for-input char)))
-       (let ((translation-table-for-input nil))
-         (quail-store-decode-map-key table char key)))))
+    ;; Avoid "obsolete" warnings for translation-table-for-input.
+    (with-no-warnings
+      (if (and translation-table-for-input
+              (setq char (aref translation-table-for-input char)))
+         (let ((translation-table-for-input nil))
+           (quail-store-decode-map-key table char key))))))
 
 ;; Helper function for quail-gen-decode-map.  Store key strings to
 ;; type each character under MAP in TABLE (char-table).  MAP is an
@@ -2696,9 +2722,11 @@ KEY BINDINGS FOR CONVERSION
 
 (defsubst quail-char-equal-p (char target)
   (or (= char target)
-      (and translation-table-for-input
-          (setq char (aref translation-table-for-input char))
-          (= char target))))
+      ;; Avoid "obsolete" warnings for translation-table-for-input.
+      (with-no-warnings
+       (and translation-table-for-input
+            (setq char (aref translation-table-for-input char))
+            (= char target)))))
 
 ;; Helper function for quail-find-key.  Prepend key strings to type
 ;; for inputting CHAR by the current input method to KEY-LIST and
@@ -3025,7 +3053,7 @@ of each directory."
 
     ;; At last, write out LEIM list file.
     (with-current-buffer list-buf
-      (let ((coding-system-for-write 'iso-2022-7bit))
+      (let ((coding-system-for-write 'utf-8))
        (save-buffer 0)))
     (kill-buffer list-buf)
     (message "Updating %s ... done" leim-list)))
@@ -3048,5 +3076,4 @@ call it with one argument STRING."
 ;;
 (provide 'quail)
 
-;; arch-tag: 46d7db54-5467-42c4-a2a9-53ca90a1e886
 ;;; quail.el ends here