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.30 - (hide annotations) (download)
Fri Feb 25 09:24:15 2005 UTC (19 years, 1 month ago) by shirai
Branch: MAIN
Changes since 1.29: +17 -10 lines
*** empty log message ***

1 jet 1.1 ;;; kogiku.el - reading file and directory names with migemo service
2    
3 jet 1.25 ;; Copyright (C) 2004 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     ;; `kogiku-read-file-name-internal' are
52 shirai 1.13 ;; translated from emacs/src/fileio.c::read-file-name-internal
53 jet 1.1 ;; in elisp.
54    
55     ;;; Version:
56     ;; 2.0.2.
57    
58     ;;; History:
59     ;; 2.0.2
60     ;; -- inlucde shirai's patch
61     ;; -- introduce custom
62     ;;
63     ;; 2.0.1 -- update `Acknowledgments'.
64     ;;
65     ;; 2.0 -- rewrite.
66    
67     ;;; Code:
68    
69 shirai 1.13 (eval-when-compile
70 jet 1.1 (require 'cl)
71     (require 'migemo))
72    
73     (defgroup kogiku nil
74     "reading file and directory name with migemo service"
75     :group 'convenience)
76    
77 shirai 1.27 (defcustom kogiku-enable-once t
78 jet 1.12 "*If non-nil, kogiku effects a one time when call with a prefix argument.
79     If nil, kogiku toggle with a prefix argument."
80     :group 'kogiku
81     :type 'boolean)
82 jet 1.1
83 shirai 1.15 (defcustom kogiku-mode-change-key "\M-k"
84     "*Key of change `kogiku-enable-once'."
85     :group 'kogiku
86     :type 'sexp)
87    
88 shirai 1.23 (defcustom kogiku-take-over-targets '(read-file-name-internal
89     ffap-read-file-or-url-internal)
90     "*小菊がのっとる`minibuffer-completion-table'の種類。
91     minibufferに制御が移ったときに`minibuffer-completion-table'の値が
92     `kogiku-take-over-targets'の要素であれば、小菊による補完の準備を行なう。"
93     :group 'kogiku
94     :type '(repeat symbol))
95    
96     (defcustom kogiku-minibuffer-prompt-string "kogiku"
97     "*Kogiku indicator in minibuffer."
98     :group 'kogiku
99     :type 'string)
100    
101 shirai 1.27 (defcustom kogiku-minibuffer-indicator-strings '("ON" "Fire")
102 shirai 1.23 "*Indicators in minibuffer prpmpt."
103     :group 'kogiku
104 shirai 1.27 :type '(list (string :tag "Kogiku-mode")
105 shirai 1.23 (string :tag "Oneshot-mode")))
106    
107 shirai 1.27 (defcustom kogiku-use-advocate t
108     "*Use kogiku `advocate' mode."
109     :group 'kogiku
110     :type 'boolean)
111    
112 shirai 1.15 (defface kogiku-indicator-face
113     '((((class color) (type tty)) (:foreground "blue" :bold t))
114     (((class color) (background light)) (:foreground "dark blue" :bold t))
115     (((class color) (background dark)) (:foreground "cyan" :bold t))
116     (t (:bold t)))
117     "*Face of kogiku indicator."
118     :group 'kogiku)
119    
120 shirai 1.27 (defface kogiku-indicator-advocate-face
121     '((((class color) (type tty)) (:foreground "red" :bold t))
122     (((class color) (background light))
123 shirai 1.29 (:foreground "firebrick" :background "wheat" :bold t))
124 shirai 1.27 (((class color) (background dark))
125     (:foreground "pink" :background "firebrick" :bold t))
126     (t (:inverse-video t :bold t)))
127     "*Face of kogiku indicator."
128     :group 'kogiku)
129    
130 jet 1.14 (defvar kogiku-original-functions nil)
131 shirai 1.23 (defvar kogiku-original-completion-tables nil)
132 jet 1.14
133 jet 1.12 (defvar kogiku-completion-key "\t")
134 shirai 1.13 (defvar kogiku-minibuffer-prompt-overlay nil)
135 shirai 1.15 (defvar kogiku-mode-change-original-functions nil)
136 jet 1.1
137 shirai 1.23 (defvar kogiku-emacs21-p (fboundp 'field-beginning))
138 shirai 1.27 (defvar kogiku-minibuffer-prompt-advocate-files nil)
139     (defvar kogiku-migemo-pattern-alist nil)
140     (defvar kogiku-migemo-pattern-alist-length 128)
141 shirai 1.10
142 shirai 1.23 (defvar kogiku-minibuffer-prompt-map nil
143     "kogiku prompt map for mode change.")
144    
145     (let ((map (make-sparse-keymap)))
146     (define-key map [mouse-2] 'kogiku-mode-change-at-mouse)
147     (setq kogiku-minibuffer-prompt-map map))
148    
149 shirai 1.27 (if kogiku-emacs21-p
150     (defalias 'kogiku-field-beginning 'field-beginning)
151     (defalias 'kogiku-field-beginning 'point-min))
152    
153     (defun kogiku-complete (&optional arg)
154     (interactive "P")
155     (let ((minibuffer-completion-table minibuffer-completion-table))
156     (when (or (and kogiku-enable-once arg)
157     (not (or kogiku-enable-once arg)))
158     (setq minibuffer-completion-table 'kogiku-read-file-name-internal))
159     (funcall (car kogiku-original-functions))))
160 shirai 1.13
161 jet 1.1 (if (fboundp 'compare-strings)
162     (defalias 'kogiku-compare-strings 'compare-strings)
163     (defun kogiku-compare-strings (string1 start1 end1 string2 start2 end2)
164     "Convenience `compare-strings' for XEmacs."
165     (let* ((str1 (substring string1 start1 end1))
166     (str2 (substring string2 start2 end2))
167     (len (min (length str1) (length str2)))
168     (i 0))
169     (if (string= str1 str2)
170     t
171     (setq i (catch 'ignore
172     (while (< i len)
173     (when (not (eq (aref str1 i) (aref str2 i)))
174     (throw 'ignore i))
175     (setq i (1+ i)))
176     i))
177     (1+ i)))))
178    
179     (defun kogiku-try-completion-regexp (regexp all-list)
180 shirai 1.13 (if (= (length regexp) 0)
181 jet 1.1 ""
182 jet 1.22 (substring
183 shirai 1.13 (car all-list)
184 jet 1.1 0
185 shirai 1.13 (apply 'min
186 jet 1.1 (mapcar
187     (lambda (a)
188 shirai 1.13 (apply 'min
189     (mapcar
190 jet 1.1 (lambda (b)
191 shirai 1.13 (- (abs
192 jet 1.1 (kogiku-compare-strings a 0 nil
193     b 0 nil))
194     1))
195     (delete a all-list))))
196 jet 1.22 all-list)))))
197 jet 1.1
198     (defun kogiku-migemo-get-pattern (string)
199 shirai 1.2 (let ((migemo-pattern-alist migemo-pattern-alist)
200 shirai 1.27 (migemo-white-space-regexp " *")
201     pattern)
202 jet 1.1 (let ((case-fold-search nil))
203     (while (string-match "[^a-zA-Z]\\([a-z]+\\)" string)
204     (setq string
205 shirai 1.7 (replace-match (capitalize (match-string 1 string)) nil nil string 1))))
206 shirai 1.27 (if (setq pattern (assoc string kogiku-migemo-pattern-alist))
207     (prog1
208     (cdr pattern)
209     (setq kogiku-migemo-pattern-alist
210     (cons pattern
211     (delete pattern kogiku-migemo-pattern-alist))))
212     (prog1
213     (setq pattern (migemo-get-pattern string))
214     (setq kogiku-migemo-pattern-alist
215     (cons (cons string pattern) kogiku-migemo-pattern-alist))
216     (when (> (length kogiku-migemo-pattern-alist)
217     kogiku-migemo-pattern-alist-length)
218     (setcdr
219     (nthcdr (1- kogiku-migemo-pattern-alist-length) kogiku-migemo-pattern-alist)
220     nil))))))
221 jet 1.1
222     (defun kogiku-file-name-completion (string dir &optional all)
223     (let* ((expanded-string (expand-file-name string dir))
224     (files (directory-files dir))
225     (pattern
226     (if (string-match "/$" expanded-string)
227     ""
228     (concat "^\\("
229     (cond
230     ((string-match "\\cj$" string)
231     string)
232 shirai 1.6 ((string-match "^\\(\\(\\Cj*\\)?\\cj+\\)\\(\\Cj+\\)$" string)
233 jet 1.1 (concat (match-string 1 string)
234     "\\("
235 shirai 1.6 (kogiku-migemo-get-pattern (match-string 3 string))
236 jet 1.1 "\\)"))
237     (t
238     (kogiku-migemo-get-pattern (file-name-nondirectory string))))
239     "\\)")))
240 shirai 1.30 (ignore-pattern (format "\\(%s\\)$"
241     (mapconcat 'regexp-quote completion-ignored-extensions "\\|")))
242 jet 1.3 (candidates (delete nil
243 shirai 1.30 (mapcar
244     (lambda (f)
245     (when (string-match pattern f)
246     (when (file-directory-p (expand-file-name f dir))
247     ;; ディレクトリは / で終わるように
248     (setq f (file-name-as-directory f)))
249     (and (not (string-match ignore-pattern f)) f)))
250     files)))
251     count common)
252 jet 1.1 (if all
253 jet 1.3 candidates
254 shirai 1.30 (when (and (string= string "")
255     (= (length files) 3))
256     (setq candidates
257     (delete-if (lambda (f) (string-match "\\.\\.?/" f))
258     candidates)))
259     (setq count (length candidates))
260 jet 1.1 (cond
261     ((eq count 0) nil)
262 jet 1.3 ((eq count 1) (let ((candidate (car candidates)))
263 jet 1.1 (if (file-directory-p candidate)
264     (file-name-as-directory candidate)
265     candidate)))
266     (t
267 jet 1.3 (if (null (delete nil (mapcar (lambda (candidate)
268     (string-match "\\cj" candidate))
269     candidates)))
270     ;; 全ての候補が日本語を含んでいない場合、通常通り
271     ;; `try-completion' を呼んでまかせる。
272 shirai 1.4 (try-completion string (mapcar 'list candidates))
273 jet 1.3 (setq common (kogiku-try-completion-regexp pattern candidates))
274     (if (eq (length common) 0) string common)))))))
275 jet 1.1
276     (defun kogiku-file-name-all-completions (string dir)
277     (kogiku-file-name-completion string dir t))
278    
279 jet 1.3 (defun kogiku-double-dollars (input)
280 shirai 1.8 (let ((ret ""))
281     (while (string-match "\\$" input)
282     (setq ret (concat ret
283     (substring input 0 (match-beginning 0))
284     "$$"))
285     (setq input (substring input (match-end 0))))
286     (concat ret input)))
287 jet 1.3
288 jet 1.1 (defun kogiku-read-file-name-internal (string dir action)
289     (block nil
290     (unless (boundp 'read-file-name-predicate)
291     (setq read-file-name-predicate nil))
292     (let ((realdir dir)
293     (name string)
294     (orig-string)
295     (changed 0)
296     (val)
297     (specdir))
298     (if (eq 0 (length string))
299     (if (eq action 'lambda)
300     (return nil))
301     (setq orig-string string)
302     (setq string (substitute-in-file-name string))
303     (setq changed (null (string-equal string orig-string)))
304     (setq name (file-name-nondirectory string))
305     (setq val (file-name-directory string))
306     (if (not (null val))
307     (setq realdir (expand-file-name val realdir))))
308     (cond
309     ((null action)
310     (setq specdir (file-name-directory string))
311     (setq val (kogiku-file-name-completion name realdir))
312     (return (if (not (stringp val))
313 shirai 1.13 (if changed
314 jet 1.3 (kogiku-double-dollars string)
315 jet 1.1 val)
316 shirai 1.13 (if (not (null specdir))
317     (setq val (concat specdir val)))
318     (kogiku-double-dollars val))))
319 jet 1.1 ((eq action t)
320     (let ((all (kogiku-file-name-all-completions name realdir)))
321     (unless (or (null read-file-name-predicate)
322     (eq read-file-name-predicate 'file-exists-p))
323 shirai 1.13 (delete-if (lambda (x)
324 jet 1.24 (not (funcall read-file-name-predicate x)))
325     all))
326 jet 1.1 (return all)))
327     ((eq action 'lambda)
328     (return (if read-file-name-predicate
329     (funcall read-file-name-predicate string)
330     (file-exists-p string))))))))
331 jet 1.12
332 shirai 1.23 (defun kogiku-mode-change-at-mouse (event)
333     (interactive "e")
334     (save-window-excursion
335     (save-excursion
336     (set-buffer (window-buffer (posn-window (event-end event))))
337     (kogiku-mode-change))))
338    
339 shirai 1.15 (defun kogiku-mode-change ()
340     (interactive)
341 shirai 1.27 (setq kogiku-enable-once (not kogiku-enable-once)))
342    
343     (defun kogiku-minibuffer-prompt ()
344     (when (and (window-minibuffer-p (selected-window))
345     (not (input-pending-p)))
346     (let* ((advocate (and kogiku-use-advocate
347     (kogiku-minibuffer-prompt-advocate)))
348     (mode (if kogiku-enable-once
349     (nth 1 kogiku-minibuffer-indicator-strings)
350     (nth 0 kogiku-minibuffer-indicator-strings)))
351     (indicator
352     (cond
353     ((and kogiku-emacs21-p advocate)
354     (format "<%s:%s> " kogiku-minibuffer-prompt-string mode))
355     (kogiku-emacs21-p
356     (format "[%s:%s] " kogiku-minibuffer-prompt-string mode))
357     (advocate
358     (format "%s<%s>: " kogiku-minibuffer-prompt-string mode))
359     (t
360     (format "%s(%s): " kogiku-minibuffer-prompt-string mode))))
361     (max (if kogiku-emacs21-p (1+ (point-min)) (point-max)))
362     (force (and (not kogiku-emacs21-p) (eq (point-min) max))))
363     (when force
364     (insert " ")
365     (goto-char (point-min))
366     (setq max (point-max)))
367     (when kogiku-emacs21-p
368     (add-text-properties 0 (1- (length indicator))
369     `(face ,(if advocate
370     'kogiku-indicator-advocate-face
371     'kogiku-indicator-face))
372     indicator)
373     (add-text-properties 0 (length indicator)
374     `(local-map
375     ,kogiku-minibuffer-prompt-map
376     mouse-face
377     highlight)
378     indicator))
379     (if kogiku-minibuffer-prompt-overlay
380     (move-overlay kogiku-minibuffer-prompt-overlay
381     (point-min) max)
382     (setq kogiku-minibuffer-prompt-overlay
383     (make-overlay (point-min) max)))
384     (overlay-put kogiku-minibuffer-prompt-overlay
385     'before-string indicator)
386 shirai 1.29 (when (not kogiku-emacs21-p)
387     (overlay-put kogiku-minibuffer-prompt-overlay
388     'face (when advocate 'kogiku-indicator-advocate-face)))
389 shirai 1.27 (overlay-put kogiku-minibuffer-prompt-overlay 'evaporate t)
390     (when force
391     (let ((inhibit-quit t))
392     (sit-for 60)
393     (delete-region (point-min) (point-max))))
394     indicator)))
395    
396     (defun kogiku-minibuffer-prompt-advocate ()
397     (when (and (window-minibuffer-p (selected-window))
398     (not (input-pending-p)))
399     (let* ((full (buffer-substring-no-properties
400     (kogiku-field-beginning) (point-max)))
401     (dir (or (file-name-directory full) default-directory))
402 shirai 1.28 (file (or (file-name-nondirectory full) ""))
403 shirai 1.27 (files (cdr (assoc dir kogiku-minibuffer-prompt-advocate-files)))
404     (count 0)
405     (kcount 0)
406     (case-fold-search completion-ignore-case)
407     fileregex tmpfiles host)
408     (catch 'advocate
409     (unless (and (not files)
410     (or (not (eq (point) (point-max)))
411 shirai 1.28 (not dir)
412 shirai 1.27 (and (string-match "^\\(/[^/]+:\\)\\|\\(//[^/]+/[^/]+\\)" dir)
413     (setq host (concat "^" (regexp-quote (match-string 0 dir))))
414     (not (string-match host default-directory)))))
415     (unless (or (input-pending-p)
416     (not (and (file-exists-p dir) (file-directory-p dir))))
417     (unless files
418     (setq files (directory-files dir nil nil 'nosort))
419     (setq kogiku-minibuffer-prompt-advocate-files
420     (cons (cons dir files) kogiku-minibuffer-prompt-advocate-files)))
421     (if (or (and (string= file "") (setq fileregex "^\\cj"))
422     (and (string-match "\\cj$" file)
423     (setq fileregex (concat "^" (regexp-quote file) "\\cj"))))
424     (while (and files (not (input-pending-p)))
425     (when (string-match fileregex (car files))
426     (throw 'advocate t))
427     (setq files (cdr files)))
428     (unless (input-pending-p)
429     (setq tmpfiles files)
430     (setq fileregex (concat "^" (regexp-quote file) "\\Cj"
431     "\\|^" (regexp-quote file) "$"))
432     (while (and tmpfiles (not (input-pending-p)))
433     (when (string-match fileregex (car tmpfiles))
434     (setq count (1+ count)))
435     (setq tmpfiles (cdr tmpfiles)))
436     (unless (input-pending-p)
437     (setq fileregex
438     (concat "^\\("
439     (if (string-match "^\\(\\(\\Cj*\\)?\\cj+\\)\\(\\Cj+\\)$" file)
440     (concat (match-string 1 file)
441     "\\("
442     (kogiku-migemo-get-pattern (match-string 3 file))
443     "\\)")
444     (kogiku-migemo-get-pattern file))
445     "\\)"))
446     (while (and (<= kcount count)
447     files (not (input-pending-p)))
448     (when (string-match fileregex (car files))
449     (setq kcount (1+ kcount)))
450     (setq files (cdr files)))
451     (> kcount count))))))))))
452 shirai 1.15
453 jet 1.12 (defun kogiku-install-key ()
454 shirai 1.15 (when (memq minibuffer-completion-table kogiku-take-over-targets)
455 shirai 1.26 (let ((table (car kogiku-original-completion-tables))
456     (func (lookup-key (current-local-map) kogiku-completion-key))
457     (cfunc (lookup-key (current-local-map) kogiku-mode-change-key)))
458     (if (eq func 'kogiku-complete)
459     (progn
460     (push table kogiku-original-completion-tables)
461     (push (car kogiku-original-functions)
462     kogiku-original-functions)
463     (push (car kogiku-mode-change-original-functions)
464     kogiku-mode-change-original-functions))
465     (push minibuffer-completion-table kogiku-original-completion-tables)
466     (push func kogiku-original-functions)
467     (push cfunc kogiku-mode-change-original-functions))
468     (define-key (current-local-map) kogiku-completion-key 'kogiku-complete)
469     (define-key (current-local-map) kogiku-mode-change-key 'kogiku-mode-change)
470 shirai 1.27 (setq kogiku-minibuffer-prompt-advocate-files nil)
471     (add-hook 'post-command-hook 'kogiku-minibuffer-prompt)
472 shirai 1.26 (kogiku-minibuffer-prompt))))
473 shirai 1.13
474 jet 1.12 (add-hook 'minibuffer-setup-hook 'kogiku-install-key)
475    
476     (defun kogiku-uninstall-key ()
477 jet 1.14 (when (and (or (eq minibuffer-completion-table 'kogiku-read-file-name-internal)
478     (memq minibuffer-completion-table kogiku-take-over-targets))
479 jet 1.12 (eq (lookup-key (current-local-map) kogiku-completion-key)
480 shirai 1.13 'kogiku-complete))
481 shirai 1.23 (pop kogiku-original-completion-tables)
482 shirai 1.15 (define-key (current-local-map) kogiku-completion-key (pop kogiku-original-functions))
483     (when (eq (lookup-key (current-local-map) kogiku-mode-change-key)
484     'kogiku-mode-change)
485     (define-key (current-local-map) kogiku-mode-change-key
486 shirai 1.27 (pop kogiku-mode-change-original-functions))))
487     (setq kogiku-minibuffer-prompt-advocate-files nil)
488     (remove-hook 'post-command-hook 'kogiku-minibuffer-prompt))
489 shirai 1.15
490     (add-hook 'minibuffer-exit-hook 'kogiku-uninstall-key)
491 jet 1.1
492     (provide 'kogiku)
493     ;; kogiku.el ends here

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