1 files changed, 216 insertions, 0 deletions
diff --git a/elisp/erbot/erbim.el b/elisp/erbot/erbim.el
new file mode 100644
index 0000000..f43a386
--- /dev/null
+++ b/elisp/erbot/erbim.el
@@ -0,0 +1,216 @@
+;;; erbim.el --- input method searching
+;; Time-stamp: <2006-08-22 01:16:17 fledermaus>
+;; Copyright (C) 2006 V. Dasmohapatra
+;; Emacs Lisp Archive entry
+;; Filename: erbim.el
+;; Package: erbim
+;; Author: V. Dasmohapatra <vivek@etla.org>
+;; Keywords:  
+;; Version:  
+;; URL:  http://www.emacswiki.org/cgi-bin/wiki.pl?ErBot
+;; For latest version: 
+
+(require 'quail)
+(require 'iso-transl)
+
+(defvar erbim-keymaps-map nil
+  "Storage for the inverted keymaps for the input methods we have searched.")
+
+(defun erbim-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 erbim-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 erbim-map (map)
+  "Traverse the input method's MAP, invert it, and return that."
+  (let ((char-map nil))
+    (mapc (lambda (M) (erbim-map-internal M "")) (cdr map)) char-map))
+
+(defun erbim-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) (erbim-c2s T) T)) target)
+    (if (and (listp target) (listp (car target)))
+        (progn (message "weird target: %S" target)
+          (erbim-interpret-target (cdr target)))
+      (if (symbolp target)
+          (and (fboundp target) 
+               (and (vectorp (symbol-function target)) 
+                    (erbim-interpret-target (symbol-function target)) )) 
+        (list (if (integerp target) (string target) target)) )) ))
+
+(defun erbim-map-internal (map &optional so-far)
+  "Does the actual work of `erbim-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 (erbim-enc T) iseq-str))
+                         (erbim-interpret-target tgt)) ))
+          (when (and (listp (cdr map)) (setq tail (cddr map)))
+            (if (listp (cdar tail))
+                (erbim-map-internal (car tail) iseq-str)
+              ;;(message "path B: %S" tail)
+              (mapcar (lambda (M) (erbim-map-internal M iseq-str)) tail)) ))
+      (when (listp (cdr map))
+        (mapcar
+         (lambda (M) (erbim-map-internal M iseq-str)) (cddr map))) ) ))
+
+(defun erbim-package-list ()
+  "Return the list of input methods that erbim 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 erbim-keymap-map (im)
+  "Return the inside-out keymap for input method IM (IM is a string)."
+  (or (cdr (assoc im erbim-keymaps-map))
+      (let ( (map (erbim-map 
+                   (nth 2 (assoc im quail-package-alist)))) )
+        (setq erbim-keymaps-map (cons (cons im map) erbim-keymaps-map)) map) ))
+
+(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 `erbim-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 fsbot becuase of
+  ;; some screen/emacs/terminal black magic (which I do not understand)
+  ;; so we cannot use (aref string 0) or string-to-char reliably.
+  (let ((char (erbim-enc c))
+        (res   nil)
+        (qsec  nil))
+    (mapc (lambda (Q)
+            ;; exclude chinese-* methods (too big) and misc problematic ones:
+            (when (and Q 
+                       (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 (equal Q "iso-transl")
+                  (with-temp-buffer
+                    (or (assoc Q quail-package-alist) 
+                        (activate-input-method     Q)) ))
+              (message "checking %s" 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 (equal Q "iso-transl") (assoc Q quail-package-alist))
+                ;;(message "%s keymap - %d" Q (length (erbim-keymap-map Q)))
+                ;; 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 (erbim-keymap-map Q)))
+                  ;;(message "found sequence %s" qsec)
+                  (setq res (cons (cons Q (cdr qsec)) res)) )) ))
+          (or im-list (erbim-package-list)))
+    ;; feed the results to the user (if there are lots of input methods,
+    ;; just list the input methods instead):
+    (if (> (length res) 10)
+        (format "%s is in the following input methods:\n%s"
+                c (mapconcat 'car res " "))
+      (mapconcat 
+       (lambda (R) 
+         (if (equal (car R) "iso-transl")
+             (mapconcat 'identity 
+                        (cons "C-x 8" (split-string (cdr R) "")) " ")
+           (format "%s: %s" (car R) (cdr R)) )) res "\n")) ))
+
+(defun fsi-where-is-char (&optional key &rest im-list)
+  (let ((imlist nil) 
+	(key (if key (if (symbolp key) (symbol-name key) key) nil)))
+    (if key (where-is-char key (mapcar 'symbol-name im-list)) 
+      "where-is-char <CHAR-OR-SEQUENCE> [ INPUT-METHOD INPUT-METHOD... ]") ))
+
+;; load iso-transl's inverted keymap
+(add-to-list 'erbim-keymaps-map 
+             (cons "iso-transl" (erbim-map iso-transl-ctl-x-8-map)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Unicode information functions:
+(defvar erbim-unidata-file "/usr/share/perl/5.8.4/unicore/UnicodeData.txt")
+
+(defun erbim-name-by-character (thing)
+  (let ((char (if (stringp thing) (string-to-char thing) thing)) 
+        (unicode nil))
+    (setq unicode 
+          (when (or (< char 256)
+                    (memq 'coding-category-utf-8
+                          (mapcar 'coding-system-category
+                                  (find-coding-systems-string thing))))
+            (encode-char char 'ucs)) )
+    (erbim-name-by-codepoint unicode)) )
+
+(defun erbim-name-by-codepoint (codepoint)
+  (let ((cpstring (format "%04X" codepoint))
+        (unidata  (find-file-noselect erbim-unidata-file)))
+    (with-current-buffer unidata
+      (goto-char (point-min))
+      (if (re-search-forward (concat "^" cpstring ";\\([^;]*\\);") nil t)
+          (format "#x%s: %s" cpstring (match-string 1))
+        (format "Unknown character #x%s" cpstring) )) ))
+
+(defun erbim-search-by-description (pat)
+  (let ( (unidata (find-file-noselect erbim-unidata-file)) 
+         (pattern        nil)
+         (case-fold-search t)
+         (count            0)
+         (limit           10)
+         (found          nil)
+         (char           nil)
+         (cp             nil)
+         (matches        nil))
+    (setq pattern (replace-regexp-in-string "^\\^\\|\\$$" "" pat)
+          pattern 
+          (concat "^\\([0-9A-F]+\\);\\(" (if (eq (aref pat 0) ?^) "" "[^;]*")
+                  pattern
+                  (if (eq (aref pat (1- (length pat))) ?$) "" "[^;]*") "\\);"))
+    (with-current-buffer unidata
+      (goto-char (point-min))
+      (while (re-search-forward pattern nil t)
+        (when (< (setq count (1+ count)) limit)
+          (setq cp    (string-to-int (match-string 1) #x10)
+                char  (or (decode-char 'ucs cp) ?�)
+                found (format "#x%04x (%c): %s" cp char (match-string 2)) 
+                matches   (cons found matches)) )) )
+    (if (< count limit)
+        (mapconcat 'identity (nreverse matches) "\n")
+      (format "Too many matches (%d) for %S" count pat)) ))
+
+(defun fs-unicode-find (&optional pattern)
+  (if pattern (erbim-search-by-description pattern)
+    "Usage: unicode-find <REGEX TO MATCH UNICODE DATA FILE DESCRIPTION>"))
+
+(defun fs-unicode-describe (&optional thing)
+  (cond ((not thing) "Usage: unicode-describe <CODEPOINT-INTEGER | CHARACTER>")
+        ((integerp thing) (erbim-name-by-codepoint thing))
+        ((symbolp  thing) (erbim-name-by-character (symbol-name thing)))
+        (thing            (erbim-name-by-character thing)) ))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; trigger the preprocessing of the rest of the input methods:
+(where-is-char "x")
+
+(provide 'erbim)
+