blob: f43a38696cbbc7f93a340ead0ee87bee1e5179d4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
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)
|
