Develop and Download Open Source Software

Browse CVS Repository

Annotation of /kogiku/kogiku/kogiku.el

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.31 - (hide annotations) (download)
Sun Apr 17 05:00:09 2005 UTC (18 years, 11 months ago) by jet
Branch: MAIN
Changes since 1.30: +15 -11 lines
* kogiku.el (kogiku-file-name-completion): 末尾が「日本語の文字」以外
だった場合の判定条件と、正規表現の生成方法を変更した。
(kogiku-minibuffer-prompt): ツールチップを追加した。
(kogiku-version): バージョンを表示する関数を追加。

1 jet 1.31 ;;; kogiku.el --- reading file and directory names with migemo service
2 jet 1.1
3 jet 1.31 ;; Copyright (C) 2004, 2005 Masatake YAMATO and Hideyuki SHIRAI
4 jet 1.1
5 jet 1.25 ;; Author: Masatake YAMATO <jet@gyve.org> and
6 shirai 1.27 ;; Hideyuki SHIRAI <shirai@meadowy.org>
7 jet 1.1
8     ;; This file is free software; you can redistribute it and/or modify
9     ;; it under the terms of the GNU General Public License as published by
10     ;; the Free Software Foundation; either version 2, or (at your option)
11     ;; any later version.
12    
13     ;; This file is distributed in the hope that it will be useful,
14     ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15     ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16     ;; GNU General Public License for more details.
17    
18     ;; You should have received a copy of the GNU General Public License
19     ;; along with GNU Emacs; see the file COPYING. If not, write to
20     ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21     ;; Boston, MA 02111-1307, USA.
22    
23     ;;; Commentary:
24     ;; 日本語ファイル名の入力をmigemoを使って簡単にするプログラムです。
25    
26     ;; (今は使っていないのですが、)以前windowsでmeadowを使っていたときに、
27     ;; 「デスクトップ(実際には半角)」にぶちまけてあるファイルをfind-fileし
28     ;; ようとすると(仮名漢字変換が必要なため)ファイル名の指定が非常に面倒で
29     ;; あると感じました。"desukutoxtupu"と打鍵してそれを「デスクトップ」へ変換
30     ;; して[return]でやっと指定することができました。
31    
32     ;; 「デスクトップ」の指定をたとえば、"desktop"とか "de"[tab]とかで済めば
33     ;; すばらしいと思いませんか?migemoを使えばこれを実現することができそう
34     ;; です。"desktop"や"de"をmigemoで日本語に展開し、展開済みのパターンを
35     ;; 現在のディレクトリにある全てのファイルの名前と照合すれば、ファイル名
36     ;; を指定("desktop"と「デスクトップ」の一致)したり、補完候補を生成
37     ;; ("de"と「デスクトップ」の一致)したりすることができます。
38    
39     ;; kogiku.elはmigemo.el及びGNU Emacs 21に依存しています。migemo.elの
40     ;; 動作をまず確認して下さい。kogiku.elをロードパスが通って通っている
41     ;; ディレクトリに置き.emacsに (require 'kogiku)と書き加えてemacsを再
42 shirai 1.27 ;; 起動します。migemoは http://migemo.namazu.org から入手できます。
43 jet 1.1
44     ;;; Acknowledgments:
45    
46 shirai 1.13 ;; Some code used in `kogiku-file-name-completion'
47     ;; and `kogiku-try-completion-regexp' are copied from
48 jet 1.1 ;; http://www.bookshelf.jp/cgi-bin/goto.cgi?file=meadow&node=kogiku
49     ;; (MeadowMemo maintained by Akihisa Matsushita <akihisa@mail.ne.jp>).
50    
51 jet 1.31 ;; `kogiku-read-file-name-internal' is
52 shirai 1.13 ;; translated from emacs/src/fileio.c::read-file-name-internal
53 jet 1.1 ;; in elisp.
54    
55     ;;; History:
56     ;; 2.0.2
57     ;; -- inlucde shirai's patch
58     ;; -- introduce custom
59     ;;
60     ;; 2.0.1 -- update `Acknowledgments'.
61     ;;
62     ;; 2.0 -- rewrite.
63    
64     ;;; Code:
65    
66 jet 1.31 (defun kogiku-version ()
67     (interactive)
68     (message "小菊 %s" "2.0.2"))
69    
70 shirai 1.13 (eval-when-compile
71 jet 1.1 (require 'cl)
72     (require 'migemo))
73    
74     (defgroup kogiku nil
75     "reading file and directory name with migemo service"
76     :group 'convenience)
77    
78 shirai 1.27 (defcustom kogiku-enable-once t
79 jet 1.12 "*If non-nil, kogiku effects a one time when call with a prefix argument.
80     If nil, kogiku toggle with a prefix argument."
81     :group 'kogiku
82     :type 'boolean)
83 jet 1.1
84 shirai 1.15 (defcustom kogiku-mode-change-key "\M-k"
85     "*Key of change `kogiku-enable-once'."
86     :group 'kogiku
87     :type 'sexp)
88    
89 shirai 1.23 (defcustom kogiku-take-over-targets '(read-file-name-internal
90     ffap-read-file-or-url-internal)
91     "*小菊がのっとる`minibuffer-completion-table'の種類。
92     minibufferに制御が移ったときに`minibuffer-completion-table'の値が
93     `kogiku-take-over-targets'の要素であれば、小菊による補完の準備を行なう。"
94     :group 'kogiku
95     :type '(repeat symbol))
96    
97     (defcustom kogiku-minibuffer-prompt-string "kogiku"
98     "*Kogiku indicator in minibuffer."
99     :group 'kogiku
100     :type 'string)
101    
102 shirai 1.27 (defcustom kogiku-minibuffer-indicator-strings '("ON" "Fire")
103 shirai 1.23 "*Indicators in minibuffer prpmpt."
104     :group 'kogiku
105 shirai 1.27 :type '(list (string :tag "Kogiku-mode")
106 shirai 1.23 (string :tag "Oneshot-mode")))
107    
108 shirai 1.27 (defcustom kogiku-use-advocate t
109     "*Use kogiku `advocate' mode."
110     :group 'kogiku
111     :type 'boolean)
112    
113 shirai 1.15 (defface kogiku-indicator-face
114     '((((class color) (type tty)) (:foreground "blue" :bold t))
115     (((class color) (background light)) (:foreground "dark blue" :bold t))
116     (((class color) (background dark)) (:foreground "cyan" :bold t))
117     (t (:bold t)))
118     "*Face of kogiku indicator."
119     :group 'kogiku)
120    
121 shirai 1.27 (defface kogiku-indicator-advocate-face
122     '((((class color) (type tty)) (:foreground "red" :bold t))
123     (((class color) (background light))
124 shirai 1.29 (:foreground "firebrick" :background "wheat" :bold t))
125 shirai 1.27 (((class color) (background dark))
126     (:foreground "pink" :background "firebrick" :bold t))
127     (t (:inverse-video t :bold t)))
128     "*Face of kogiku indicator."
129     :group 'kogiku)
130    
131 jet 1.14 (defvar kogiku-original-functions nil)
132 shirai 1.23 (defvar kogiku-original-completion-tables nil)
133 jet 1.14
134 jet 1.12 (defvar kogiku-completion-key "\t")
135 shirai 1.13 (defvar kogiku-minibuffer-prompt-overlay nil)
136 shirai 1.15 (defvar kogiku-mode-change-original-functions nil)
137 jet 1.1
138 shirai 1.23 (defvar kogiku-emacs21-p (fboundp 'field-beginning))
139 shirai 1.27 (defvar kogiku-minibuffer-prompt-advocate-files nil)
140     (defvar kogiku-migemo-pattern-alist nil)
141     (defvar kogiku-migemo-pattern-alist-length 128)
142 shirai 1.10
143 shirai 1.23 (defvar kogiku-minibuffer-prompt-map nil
144     "kogiku prompt map for mode change.")
145    
146     (let ((map (make-sparse-keymap)))
147     (define-key map [mouse-2] 'kogiku-mode-change-at-mouse)
148     (setq kogiku-minibuffer-prompt-map map))
149    
150 shirai 1.27 (if kogiku-emacs21-p
151     (defalias 'kogiku-field-beginning 'field-beginning)
152     (defalias 'kogiku-field-beginning 'point-min))
153    
154     (defun kogiku-complete (&optional arg)
155     (interactive "P")
156     (let ((minibuffer-completion-table minibuffer-completion-table))
157     (when (or (and kogiku-enable-once arg)
158     (not (or kogiku-enable-once arg)))
159     (setq minibuffer-completion-table 'kogiku-read-file-name-internal))
160     (funcall (car kogiku-original-functions))))
161 shirai 1.13
162 jet 1.1 (if (fboundp 'compare-strings)
163     (defalias 'kogiku-compare-strings 'compare-strings)
164     (defun kogiku-compare-strings (string1 start1 end1 string2 start2 end2)
165     "Convenience `compare-strings' for XEmacs."
166     (let* ((str1 (substring string1 start1 end1))
167     (str2 (substring string2 start2 end2))
168     (len (min (length str1) (length str2)))
169     (i 0))
170     (if (string= str1 str2)
171     t
172     (setq i (catch 'ignore
173     (while (< i len)
174     (when (not (eq (aref str1 i) (aref str2 i)))
175     (throw 'ignore i))
176     (setq i (1+ i)))
177     i))
178     (1+ i)))))
179    
180     (defun kogiku-try-completion-regexp (regexp all-list)
181 shirai 1.13 (if (= (length regexp) 0)
182 jet 1.1 ""
183 jet 1.22 (substring
184 shirai 1.13 (car all-list)
185 jet 1.1 0
186 shirai 1.13 (apply 'min
187 jet 1.1 (mapcar
188     (lambda (a)
189 shirai 1.13 (apply 'min
190     (mapcar
191 jet 1.1 (lambda (b)
192 shirai 1.13 (- (abs
193 jet 1.1 (kogiku-compare-strings a 0 nil
194     b 0 nil))
195     1))
196     (delete a all-list))))
197 jet 1.22 all-list)))))
198 jet 1.1
199     (defun kogiku-migemo-get-pattern (string)
200 shirai 1.2 (let ((migemo-pattern-alist migemo-pattern-alist)
201 shirai 1.27 (migemo-white-space-regexp " *")
202     pattern)
203 jet 1.1 (let ((case-fold-search nil))
204     (while (string-match "[^a-zA-Z]\\([a-z]+\\)" string)
205     (setq string
206 shirai 1.7 (replace-match (capitalize (match-string 1 string)) nil nil string 1))))
207 shirai 1.27 (if (setq pattern (assoc string kogiku-migemo-pattern-alist))
208     (prog1
209     (cdr pattern)
210     (setq kogiku-migemo-pattern-alist
211     (cons pattern
212     (delete pattern kogiku-migemo-pattern-alist))))
213     (prog1
214     (setq pattern (migemo-get-pattern string))
215     (setq kogiku-migemo-pattern-alist
216     (cons (cons string pattern) kogiku-migemo-pattern-alist))
217     (when (> (length kogiku-migemo-pattern-alist)
218     kogiku-migemo-pattern-alist-length)
219     (setcdr
220     (nthcdr (1- kogiku-migemo-pattern-alist-length) kogiku-migemo-pattern-alist)
221     nil))))))
222 jet 1.1
223     (defun kogiku-file-name-completion (string dir &optional all)
224     (let* ((expanded-string (expand-file-name string dir))
225     (files (directory-files dir))
226     (pattern
227     (if (string-match "/$" expanded-string)
228     ""
229     (concat "^\\("
230     (cond
231     ((string-match "\\cj$" string)
232     string)
233 jet 1.31 ((and (string-match "\\Cj+$" string)
234     (< 0 (match-beginning 0)))
235     (concat (substring string 0 (match-beginning 0))
236 jet 1.1 "\\("
237 jet 1.31 (kogiku-migemo-get-pattern (match-string 0 string))
238 jet 1.1 "\\)"))
239     (t
240     (kogiku-migemo-get-pattern (file-name-nondirectory string))))
241     "\\)")))
242 shirai 1.30 (ignore-pattern (format "\\(%s\\)$"
243     (mapconcat 'regexp-quote completion-ignored-extensions "\\|")))
244 jet 1.3 (candidates (delete nil
245 shirai 1.30 (mapcar
246     (lambda (f)
247     (when (string-match pattern f)
248     (when (file-directory-p (expand-file-name f dir))
249     ;; ディレクトリは / で終わるように
250     (setq f (file-name-as-directory f)))
251     (and (not (string-match ignore-pattern f)) f)))
252     files)))
253     count common)
254 jet 1.1 (if all
255 jet 1.3 candidates
256 shirai 1.30 (when (and (string= string "")
257     (= (length files) 3))
258     (setq candidates
259     (delete-if (lambda (f) (string-match "\\.\\.?/" f))
260     candidates)))
261     (setq count (length candidates))
262 jet 1.1 (cond
263     ((eq count 0) nil)
264 jet 1.3 ((eq count 1) (let ((candidate (car candidates)))
265 jet 1.1 (if (file-directory-p candidate)
266     (file-name-as-directory candidate)
267     candidate)))
268     (t
269 jet 1.3 (if (null (delete nil (mapcar (lambda (candidate)
270     (string-match "\\cj" candidate))
271     candidates)))
272     ;; 全ての候補が日本語を含んでいない場合、通常通り
273     ;; `try-completion' を呼んでまかせる。
274 shirai 1.4 (try-completion string (mapcar 'list candidates))
275 jet 1.3 (setq common (kogiku-try-completion-regexp pattern candidates))
276     (if (eq (length common) 0) string common)))))))
277 jet 1.1
278     (defun kogiku-file-name-all-completions (string dir)
279     (kogiku-file-name-completion string dir t))
280    
281 jet 1.3 (defun kogiku-double-dollars (input)
282 shirai 1.8 (let ((ret ""))
283     (while (string-match "\\$" input)
284     (setq ret (concat ret
285     (substring input 0 (match-beginning 0))
286     "$$"))
287     (setq input (substring input (match-end 0))))
288     (concat ret input)))
289 jet 1.3
290 jet 1.1 (defun kogiku-read-file-name-internal (string dir action)
291     (block nil
292     (unless (boundp 'read-file-name-predicate)
293     (setq read-file-name-predicate nil))
294     (let ((realdir dir)
295     (name string)
296     (orig-string)
297     (changed 0)
298     (val)
299     (specdir))
300     (if (eq 0 (length string))
301     (if (eq action 'lambda)
302     (return nil))
303     (setq orig-string string)
304     (setq string (substitute-in-file-name string))
305     (setq changed (null (string-equal string orig-string)))
306     (setq name (file-name-nondirectory string))
307     (setq val (file-name-directory string))
308     (if (not (null val))
309     (setq realdir (expand-file-name val realdir))))
310     (cond
311     ((null action)
312     (setq specdir (file-name-directory string))
313     (setq val (kogiku-file-name-completion name realdir))
314     (return (if (not (stringp val))
315 shirai 1.13 (if changed
316 jet 1.3 (kogiku-double-dollars string)
317 jet 1.1 val)
318 shirai 1.13 (if (not (null specdir))
319     (setq val (concat specdir val)))
320     (kogiku-double-dollars val))))
321 jet 1.1 ((eq action t)
322     (let ((all (kogiku-file-name-all-completions name realdir)))
323     (unless (or (null read-file-name-predicate)
324     (eq read-file-name-predicate 'file-exists-p))
325 shirai 1.13 (delete-if (lambda (x)
326 jet 1.24 (not (funcall read-file-name-predicate x)))
327     all))
328 jet 1.1 (return all)))
329     ((eq action 'lambda)
330     (return (if read-file-name-predicate
331     (funcall read-file-name-predicate string)
332     (file-exists-p string))))))))
333 jet 1.12
334 shirai 1.23 (defun kogiku-mode-change-at-mouse (event)
335     (interactive "e")
336     (save-window-excursion
337     (save-excursion
338     (set-buffer (window-buffer (posn-window (event-end event))))
339     (kogiku-mode-change))))
340    
341 shirai 1.15 (defun kogiku-mode-change ()
342     (interactive)
343 shirai 1.27 (setq kogiku-enable-once (not kogiku-enable-once)))
344    
345     (defun kogiku-minibuffer-prompt ()
346     (when (and (window-minibuffer-p (selected-window))
347     (not (input-pending-p)))
348     (let* ((advocate (and kogiku-use-advocate
349     (kogiku-minibuffer-prompt-advocate)))
350     (mode (if kogiku-enable-once
351     (nth 1 kogiku-minibuffer-indicator-strings)
352     (nth 0 kogiku-minibuffer-indicator-strings)))
353     (indicator
354     (cond
355     ((and kogiku-emacs21-p advocate)
356     (format "<%s:%s> " kogiku-minibuffer-prompt-string mode))
357     (kogiku-emacs21-p
358     (format "[%s:%s] " kogiku-minibuffer-prompt-string mode))
359     (advocate
360     (format "%s<%s>: " kogiku-minibuffer-prompt-string mode))
361     (t
362     (format "%s(%s): " kogiku-minibuffer-prompt-string mode))))
363     (max (if kogiku-emacs21-p (1+ (point-min)) (point-max)))
364     (force (and (not kogiku-emacs21-p) (eq (point-min) max))))
365     (when force
366     (insert " ")
367     (goto-char (point-min))
368     (setq max (point-max)))
369     (when kogiku-emacs21-p
370     (add-text-properties 0 (1- (length indicator))
371     `(face ,(if advocate
372     'kogiku-indicator-advocate-face
373     'kogiku-indicator-face))
374     indicator)
375     (add-text-properties 0 (length indicator)
376     `(local-map
377 jet 1.31 ,kogiku-minibuffer-prompt-map
378 shirai 1.27 mouse-face
379 jet 1.31 highlight
380     help-echo
381     "mouse-2: ワンショットモード(Fire)か常時モード(ON)かを切り替えます。")
382 shirai 1.27 indicator))
383     (if kogiku-minibuffer-prompt-overlay
384     (move-overlay kogiku-minibuffer-prompt-overlay
385     (point-min) max)
386     (setq kogiku-minibuffer-prompt-overlay
387     (make-overlay (point-min) max)))
388     (overlay-put kogiku-minibuffer-prompt-overlay
389     'before-string indicator)
390 shirai 1.29 (when (not kogiku-emacs21-p)
391     (overlay-put kogiku-minibuffer-prompt-overlay
392     'face (when advocate 'kogiku-indicator-advocate-face)))
393 shirai 1.27 (overlay-put kogiku-minibuffer-prompt-overlay 'evaporate t)
394     (when force
395     (let ((inhibit-quit t))
396     (sit-for 60)
397     (delete-region (point-min) (point-max))))
398     indicator)))
399    
400     (defun kogiku-minibuffer-prompt-advocate ()
401     (when (and (window-minibuffer-p (selected-window))
402     (not (input-pending-p)))
403     (let* ((full (buffer-substring-no-properties
404     (kogiku-field-beginning) (point-max)))
405     (dir (or (file-name-directory full) default-directory))
406 shirai 1.28 (file (or (file-name-nondirectory full) ""))
407 shirai 1.27 (files (cdr (assoc dir kogiku-minibuffer-prompt-advocate-files)))
408     (count 0)
409     (kcount 0)
410     (case-fold-search completion-ignore-case)
411     fileregex tmpfiles host)
412     (catch 'advocate
413     (unless (and (not files)
414     (or (not (eq (point) (point-max)))
415 shirai 1.28 (not dir)
416 shirai 1.27 (and (string-match "^\\(/[^/]+:\\)\\|\\(//[^/]+/[^/]+\\)" dir)
417     (setq host (concat "^" (regexp-quote (match-string 0 dir))))
418     (not (string-match host default-directory)))))
419     (unless (or (input-pending-p)
420     (not (and (file-exists-p dir) (file-directory-p dir))))
421     (unless files
422     (setq files (directory-files dir nil nil 'nosort))
423     (setq kogiku-minibuffer-prompt-advocate-files
424     (cons (cons dir files) kogiku-minibuffer-prompt-advocate-files)))
425     (if (or (and (string= file "") (setq fileregex "^\\cj"))
426     (and (string-match "\\cj$" file)
427     (setq fileregex (concat "^" (regexp-quote file) "\\cj"))))
428     (while (and files (not (input-pending-p)))
429     (when (string-match fileregex (car files))
430     (throw 'advocate t))
431     (setq files (cdr files)))
432     (unless (input-pending-p)
433     (setq tmpfiles files)
434     (setq fileregex (concat "^" (regexp-quote file) "\\Cj"
435     "\\|^" (regexp-quote file) "$"))
436     (while (and tmpfiles (not (input-pending-p)))
437     (when (string-match fileregex (car tmpfiles))
438     (setq count (1+ count)))
439     (setq tmpfiles (cdr tmpfiles)))
440     (unless (input-pending-p)
441     (setq fileregex
442     (concat "^\\("
443     (if (string-match "^\\(\\(\\Cj*\\)?\\cj+\\)\\(\\Cj+\\)$" file)
444     (concat (match-string 1 file)
445     "\\("
446     (kogiku-migemo-get-pattern (match-string 3 file))
447     "\\)")
448     (kogiku-migemo-get-pattern file))
449     "\\)"))
450     (while (and (<= kcount count)
451     files (not (input-pending-p)))
452     (when (string-match fileregex (car files))
453     (setq kcount (1+ kcount)))
454     (setq files (cdr files)))
455     (> kcount count))))))))))
456 shirai 1.15
457 jet 1.12 (defun kogiku-install-key ()
458 shirai 1.15 (when (memq minibuffer-completion-table kogiku-take-over-targets)
459 shirai 1.26 (let ((table (car kogiku-original-completion-tables))
460     (func (lookup-key (current-local-map) kogiku-completion-key))
461     (cfunc (lookup-key (current-local-map) kogiku-mode-change-key)))
462     (if (eq func 'kogiku-complete)
463     (progn
464     (push table kogiku-original-completion-tables)
465     (push (car kogiku-original-functions)
466     kogiku-original-functions)
467     (push (car kogiku-mode-change-original-functions)
468     kogiku-mode-change-original-functions))
469     (push minibuffer-completion-table kogiku-original-completion-tables)
470     (push func kogiku-original-functions)
471     (push cfunc kogiku-mode-change-original-functions))
472     (define-key (current-local-map) kogiku-completion-key 'kogiku-complete)
473     (define-key (current-local-map) kogiku-mode-change-key 'kogiku-mode-change)
474 shirai 1.27 (setq kogiku-minibuffer-prompt-advocate-files nil)
475     (add-hook 'post-command-hook 'kogiku-minibuffer-prompt)
476 shirai 1.26 (kogiku-minibuffer-prompt))))
477 shirai 1.13
478 jet 1.12 (add-hook 'minibuffer-setup-hook 'kogiku-install-key)
479    
480     (defun kogiku-uninstall-key ()
481 jet 1.14 (when (and (or (eq minibuffer-completion-table 'kogiku-read-file-name-internal)
482     (memq minibuffer-completion-table kogiku-take-over-targets))
483 jet 1.12 (eq (lookup-key (current-local-map) kogiku-completion-key)
484 shirai 1.13 'kogiku-complete))
485 shirai 1.23 (pop kogiku-original-completion-tables)
486 shirai 1.15 (define-key (current-local-map) kogiku-completion-key (pop kogiku-original-functions))
487     (when (eq (lookup-key (current-local-map) kogiku-mode-change-key)
488     'kogiku-mode-change)
489     (define-key (current-local-map) kogiku-mode-change-key
490 shirai 1.27 (pop kogiku-mode-change-original-functions))))
491     (setq kogiku-minibuffer-prompt-advocate-files nil)
492     (remove-hook 'post-command-hook 'kogiku-minibuffer-prompt))
493 shirai 1.15
494     (add-hook 'minibuffer-exit-hook 'kogiku-uninstall-key)
495 jet 1.1
496     (provide 'kogiku)
497     ;; kogiku.el ends here

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26