;;; wic.el --- input method searching
;; Time-stamp: <2007-01-27 00:17:33 fledermaus>
;; Copyright (C) 2006,2007 V. Dasmohapatra
;; Emacs Lisp Archive entry
;; Filename: wic.el
;; Package: wic
;; Author: V. Dasmohapatra <vivek@etla.org>
;; Keywords:  
;; Version:  
(require 'quail)
(require 'iso-transl)

(defvar wic-keymaps-map nil
  "Storage for the inverted keymaps for the input methods we have searched.")

(defun wic-enc (thing)
  "Standard encoding for all strings (many chars don't work in an emacs
running screen, so chars and unencoded strings may not be safe or work)."
  (encode-coding-string thing 'utf-8))

(defun wic-c2s (thing)
  "map a character to the appropriate string. This is not a straightforward
operation using char-to-string (for some reason)."
  (if (> 256 thing) (single-key-description thing) (char-to-string thing)))

(defun wic-map (map)
  "Traverse the input method's MAP, invert it, and return that."
  (let ((char-map nil))
    (mapc (lambda (M) (wic-map-internal M "")) (cdr map)) char-map))

(defun wic-interpret-target (target)
  "Examine the TARGET of a given input method map entry and turn it
into a list of (unencoded) strings.\n
Destinations can be symbols (keyboard macros) vectors of strings or 
vectors of characters, or a cons of the form (LIST . TARGET)."
  ;;(message "target %S" target)
  (if (vectorp target) 
      (mapcar (lambda (T) (if (integerp T) (wic-c2s T) T)) target)
    (if (and (listp target) (listp (car target)))
        (progn (message "weird target: %S" target)
          (wic-interpret-target (cdr target)))
      (if (symbolp target)
          (and (fboundp target) 
               (and (vectorp (symbol-function target)) 
                    (wic-interpret-target (symbol-function target)) )) 
        (list (if (integerp target) (string target) target)) )) ))

(defun wic-map-internal (map &optional so-far)
  "Does the actual work of `wic-map'."  
  (let ((iseq-str
         (format (if (symbolp (car map)) "%s %S " "%s%c") (or so-far "")
                 (car map)))
        (tgt  nil)
        (tail nil))
    ;;(message "%S %S" map so-far)
    (setq tgt (cdr map))
    (if (setq tgt (or (car-safe tgt) 
                      (and (vectorp tgt) tgt) 
                      (and (symbolp tgt) tgt)))
        (progn
          ;;(message "tgt: %S" tgt)
          (setq char-map
                (append char-map
                        (mapcar 
                         (lambda (T) (cons (wic-enc T) iseq-str))
                         (wic-interpret-target tgt)) ))
          (when (and (listp (cdr map)) (setq tail (cddr map)))
            (if (listp (cdar tail))
                (wic-map-internal (car tail) iseq-str)
              ;;(message "path B: %S" tail)
              (mapcar (lambda (M) (wic-map-internal M iseq-str)) tail)) ))
      (when (listp (cdr map))
        (mapcar
         (lambda (M) (wic-map-internal M iseq-str)) (cddr map))) ) ))

(defun wic-package-list ()
  "Return the list of input methods that wic can understand.
iso-transl is not exactly an input method, but it is a special case."
  (cons "iso-transl"
        (mapcar (lambda (I) (if (eq (caddr I) 'quail-use-package) (car I))) 
                input-method-alist) ))

(defun wic-keymap-map (im)
  "Return the inside-out keymap for input method IM (IM is a string)."
  (or (cdr (assoc im wic-keymaps-map))
      (let ( (map (wic-map 
                   (nth 2 (assoc im quail-package-alist)))) )
        (setq wic-keymaps-map (cons (cons im map) wic-keymaps-map)) map) ))

(defun wic-test (c &optional im-list)
  
  (message "[%S %S]" c im-list))

(defun where-is-char (c &optional im-list)
  "Given a string C (usually, but not always, one character (but NOT 
necessarily one byte)) in length, search the input methods in either IM-LIST 
or `wic-package-list' and return a help string describing the key sequences 
\(per input method) that can be used to enter C."
  ;; assume we got a string: char functions are broken in erbot because of
  ;; some screen/emacs/terminal black magic (which I do not understand)
  ;; so we cannot use (aref string 0) or string-to-char reliably.
  (interactive 
   (let ( (input-method-alist (cons '("iso-transl") input-method-alist)) 
          args char im)
     (setq char (read-string "Character or Sequence: "))
     (while (setq im (read-input-method-name "Input Method [RET to end]: " nil))
       (setq args (cons im args)))
     (list char args) ))
  (if (not (listp im-list)) (setq im-list (list im-list)))
  (let ((char (wic-enc c))
        (res          nil)
        (qsec         nil))
    (mapc (lambda (Q)
            (let ((iso-transl (equal Q "iso-transl"))
                  (seq-string nil))
              (when (and Q 
                         ;; exclude chinese-* methods (too big) 
                         ;; and misc problematic ones:
                         (not (string-match "^chinese-" Q))
                         (not (member Q '("tibetan-wylie" ;; too big?
                                          ;; "greek-ibycus4" ;; ok actually
                                          )) ))
                ;; load the input method if it's not iso-transl (special case)
                ;; and we haven't already done so:
                (or iso-transl
                    (with-temp-buffer
                      (or (assoc Q quail-package-alist) 
                          (activate-input-method     Q)) ))
                ;; check to see if we have a quail package (iso-transl is
                ;; not a quail package, don't check for it here):
                (when (or iso-transl (assoc Q quail-package-alist))
                  ;; extract the inverse keymap if there is one, and pull
                  ;; out the first entry for the char we are looking for:
                  (when (setq qsec (assoc char (wic-keymap-map Q)))
                    (setq seq-string 
                          (if iso-transl (concat "C-x 8 " (cdr qsec))(cdr qsec))
                          res (cons (cons Q seq-string) res)) )) )))
          (or im-list (wic-package-list)))
    ;; feed the results to the user (if there are lots of input methods,
    ;; just list the input methods instead):
    (when (interactive-p)
      (display-message-or-buffer 
       (mapconcat (lambda (R) (format "%s: %s" (car R) (cdr R)) ) res "\n")
       "*Where Is Char*"))
    res))

;; load iso-transl's inverted keymap
(add-to-list 'wic-keymaps-map 
             (cons "iso-transl" (wic-map iso-transl-ctl-x-8-map)))
;; trigger the preprocessing of the rest of the input methods:
(where-is-char "x")

(provide 'wic)