/
tc-is20u.el
241 lines (211 loc) · 9.47 KB
/
tc-is20u.el
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
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
;;; tc-is20u.el -*- Emacs-Lisp; coding:shift_jis -*-
;; Copyright (C) 2005 YAGI Tatsuya <ynyaaa@ybb.ne.jp>
;; Author: YAGI Tatsuya <ynyaaa@ybb.ne.jp>
;; Maintainer: Masayuki Ataka <masayuki.ataka@gmail.com>
;;; Commentary
;; 最近は全角と半角が入り混じった
;; テキストを見る事が多くて検索するのが面倒だと感じるようになったので
;; 全角と半角を区別せずに検索するプログラムを書いてみました。
;; Meadow-2.11 based on GNU Emacs 21.4.1 でテストしています。
;; emacs21 なら多分動くでしょう。
;; emacs20.2 以前では多分動きません。
;; (文字列中のマルチバイト文字を aref で参照している)
;; tcode-isearch-enable-wrapped-search と
;; tcode-isearch-enable-unification-search が
;; 共に non-nil の時に働きます。(ちょっと手抜き)
;; 統合検索のルールは tcode-isearch-unification-list に記述します。
;; この変数はリストで各要素は文字列またはリストです。
;; 要素が文字列の場合は文字列の各文字が入力された時に互いに区別せずに
;; 検索する文字となります。
;; 例: '("亜亞" "秋穐龝" ...) とすると異体字を区別せずに検索します。
;; ある文字が入力された時、対応する文字列表現(二文字以上)も検索したい場合に
;; 要素としてリストを指定します。このリストの要素は文字または文字列です。
;; 例: '((?ガ "カ゛") (?ギ "キ゛") ...) とすると「ガ」を入力する事で
;; 「カ゛」も検索されます。
;; ただし「カ゛」を入力しても「ガ」は検索できません。
;; tcode-isearch-unification-list を設定する場合は tc-is20u.el をロードする
;; 前に値を設定するか、tc-is20u.el を既にロードしている場合は明示的に
;; (tcode-isearch-unification-setup nil) を評価して下さい。
;; 文字を互いに区別しないのではなく、非対称にしたい場合は
;; tcode-isearch-unification-reverse を nil にして tc-is20u.el をロードする
;; か、(tcode-isearch-unification-setup t) を評価して下さい。
;; この場合は互いに区別しなくて良い文字の組については全ての文字について
;; tcode-isearch-unification-list に区別しない事を明示する必要があります。
;; 例: tcode-isearch-unification-reverse が nil で
;; A,Ａ を互いに区別しない場合は以下のように指定する。
;; '("AＡ" "ＡA")
;; 半角の A を入力した時は全角のＡを検索したいが
;; 全角のＡを入力した時には半角の A を検索しなくて良い場合は
;; '("AＡ")
;; だけを指定する。
;;; Code:
(require 'tc-is20)
(defvar tcode-isearch-enable-unification-search t
"*2バイト文字でサーチするときに、字種統合検索をする。")
(put 'tcode-isearch-unification-char-table 'char-table-extra-slots 0)
(defvar tcode-isearch-unification-char-table nil
"字種統合検索するときの統合ルールを定める表。")
(defvar tcode-isearch-unification-list
'(" " "!！" "\"”" "#＃" "$＄" "%％" "&＆" "'’"
"(（" ")）" "*＊" "+＋" ",，" "-−" ".．" "/／"
"0０" "1１" "2２" "3３" "4４" "5５" "6６" "7７" "8８" "9９"
":：" ";；" "<＜" "=＝" ">＞" "?？"
"@＠" "AＡ" "BＢ" "CＣ" "DＤ" "EＥ" "FＦ" "GＧ"
"HＨ" "IＩ" "JＪ" "KＫ" "LＬ" "MＭ" "NＮ" "OＯ"
"PＰ" "QＱ" "RＲ" "SＳ" "TＴ" "UＵ" "VＶ" "WＷ"
"XＸ" "YＹ" "ZＺ" "[［" "\\¥" "]］" "^＾" "_＿"
"`‘" "aａ" "bｂ" "cｃ" "dｄ" "eｅ" "fｆ" "gｇ"
"hｈ" "iｉ" "jｊ" "kｋ" "lｌ" "mｍ" "nｎ" "oｏ"
"pｐ" "qｑ" "rｒ" "sｓ" "tｔ" "uｕ" "vｖ" "wｗ"
"xｘ" "yｙ" "zｚ" "{｛" "|｜" "}｝" "~‾"
"。。" "「「" "」」" "、、" "・・" "゛゛" "゜゜" "ーー"
"アア" "イイ" "ウウ" "エエ" "オオ"
"カカ" "キキ" "クク" "ケケ" "ココ"
"ササ" "シシ" "スス" "セセ" "ソソ"
"タタ" "チチ" "ツツ" "テテ" "トト"
"ナナ" "ニニ" "ヌヌ" "ネネ" "ノノ"
"ハハ" "ヒヒ" "フフ" "ヘヘ" "ホホ"
"ママ" "ミミ" "ムム" "メメ" "モモ"
"ヤヤ" "ユユ" "ヨヨ"
"ララ" "リリ" "ルル" "レレ" "ロロ"
"ワワ" "ヲヲ" "ンン"
"ァァ" "ィィ" "ゥゥ" "ェェ" "ォォ"
"ャャ" "ュュ" "ョョ" "ッッ"
(?ガ "ガ") (?ギ "ギ") (?グ "グ") (?ゲ "ゲ") (?ゴ "ゴ")
(?ザ "ザ") (?ジ "ジ") (?ズ "ズ") (?ゼ "ゼ") (?ゾ "ゾ")
(?ダ "ダ") (?ヂ "ヂ") (?ヅ "ヅ") (?デ "デ") (?ド "ド")
(?バ "バ") (?ビ "ビ") (?ブ "ブ") (?ベ "ベ") (?ボ "ボ")
(?パ "パ") (?ピ "ピ") (?プ "プ") (?ペ "ペ") (?ポ "ポ")
(?ヴ "ヴ"))
"字種統合検索するときの統合ルールを定めるリスト。")
(defvar tcode-isearch-unification-reverse t
"*non-nil の時は tcode-isearch-unification-list の文字を常に区別しない。
nil の時は alist の先頭要素の文字が入力された時だけ区別しない。")
(defun tcode-isearch-unification-setup (&optional no-reverse)
(interactive "P")
(let ((tab (make-char-table 'tcode-isearch-unification-char-table))
reg)
(if no-reverse
(dolist (cell tcode-isearch-unification-list)
(if (stringp cell) (setq cell (string-to-list cell)))
(setq reg (tcode-isearch-unification-make-regexp cell))
(aset tab (car cell) reg))
(dolist (cell tcode-isearch-unification-list)
(if (stringp cell) (setq cell (string-to-list cell)))
(dolist (c cell)
(when (not (stringp c))
(setq reg (tcode-isearch-unification-make-regexp
(cons c (delq c (copy-sequence cell)))))
(aset tab c reg)))))
(setq tcode-isearch-unification-char-table tab)))
(defun tcode-isearch-unification-make-regexp (l)
(let ((c (car l))
(ch-l nil)
(st-l nil))
(while (setq l (cdr l))
(cond ((stringp (car l))
(setq st-l (cons (car l) st-l)))
((memq (car l) '(?^ ?- ?\]))
(setq st-l (cons (string (car l)) st-l)))
(t (setq ch-l (cons (car l) ch-l)))))
(if (null ch-l)
(if (null st-l)
nil ;; character itself
(setq st-l (cons (string c) st-l))
(concat "\\(" (mapconcat 'regexp-quote st-l "\\|") "\\)"))
(if (eq c ?^) ;; ?- or ?\] is not special as a first char in [...].
(if (null (cdr ch-l))
(concat "\\("
(mapconcat 'regexp-quote
(cons (string c)
(cons (string (car ch-l)) st-l))
"\\|")
"\\)")
(setq st-l (mapcar 'regexp-quote st-l)
st-l (cons (concat "[" (apply 'string ch-l) "]") st-l)
st-l (cons (regexp-quote (string c)) st-l))
(concat "\\("
(mapcar 'identity st-l "\\|")
"\\)"))
(setq ch-l (cons c ch-l))
(if (null st-l)
(concat "[" (apply 'string ch-l) "]")
(concat "\\(" (concat "[" (apply 'string ch-l) "]")
(mapcar 'regexp-quote st-l "\\|")
"\\)"))
))))
(defun tcode-isearch-unification-char-to-regexp (c)
(or (aref tcode-isearch-unification-char-table c)
(char-to-string c)))
(defun tcode-isearch-unification-regexp-to-char (regexp pos)
(let ((c (aref regexp pos)))
(cond ((eq ?\[ c)
(aref regexp (1+ pos)))
((not (eq ?\\ c))
c)
((not (eq ?\( (setq c (aref regexp (1+ pos)))))
c)
((eq ?\[ (setq c (aref regexp (+ pos 2))))
(aref regexp (+ pos 3)))
((eq ?\\ c)
(aref regexp (+ pos 3)))
(t c))))
(defun tcode-isearch-unification-regexp-to-string (regexp)
(let ((il (length tcode-isearch-ignore-regexp))
(b 0) (l (length regexp)) (ret nil) c)
(while (< b l)
(if (eq t (compare-strings tcode-isearch-ignore-regexp 0 il
regexp b (+ b il)))
(setq b (+ b il))
(setq c (tcode-isearch-unification-regexp-to-char regexp b)
ret (cons c ret)
b (+ (if (or (not (eq c (aref regexp b)))
(eq c ?\[))
(length (tcode-isearch-unification-char-to-regexp c))
1)
b))))
(apply 'string (nreverse ret))))
(defun tcode-isearch-make-string-for-wrapping (string)
(let ((string-list (and string
(string-to-list string))))
(if (and tcode-isearch-enable-wrapped-search
(not isearch-regexp)
string-list)
(mapconcat
(lambda (a)
(let ((s (char-to-string a)))
(cond ((and (string-match tcode-isearch-ignore-regexp s)
(> (match-end 0) 0))
tcode-isearch-ignore-regexp)
(tcode-isearch-enable-unification-search
(if (= (char-width a) 2)
(concat tcode-isearch-ignore-regexp
(tcode-isearch-unification-char-to-regexp a))
(tcode-isearch-unification-char-to-regexp a)))
((= (char-width a) 2)
(concat tcode-isearch-ignore-regexp s))
(t
(regexp-quote s)))))
string-list
nil)
string)))
(defun tcode-isearch-remove-ignore-regexp (str)
"変数 `tcode-isearch-enable-wrapped-search' が nil でないとき、
STR から `tcode-isearch-ignore-regexp' を取り除く。"
(if (or (not tcode-isearch-enable-wrapped-search)
isearch-regexp)
str
(if tcode-isearch-enable-unification-search
(tcode-isearch-unification-regexp-to-string str)
(let (idx
(regexp-len (length tcode-isearch-ignore-regexp)))
(while (setq idx (string-match
(regexp-quote tcode-isearch-ignore-regexp)
str))
(setq str (concat (substring str 0 idx)
(substring str (+ idx regexp-len) nil))))
(tcode-regexp-unquote str)))))
(unless tcode-isearch-unification-char-table
(tcode-isearch-unification-setup (not tcode-isearch-unification-reverse)))
(provide 'tc-is20u)
;;; tc-is20u.el ends here.