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.28 - (hide annotations) (download)
Mon Feb 16 11:20:09 2004 UTC (20 years, 1 month ago) by shirai
Branch: MAIN
Changes since 1.27: +2 -1 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     (:foreground "firebrick" :background "pink" :bold t))
124     (((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 jet 1.3 (candidates (delete nil
241 jet 1.1 (mapcar
242     (lambda (f)
243     (if (string-match pattern f)
244     (if (file-directory-p (expand-file-name f dir))
245     ;; ディレクトリは / で終わるように
246     (file-name-as-directory f)
247     f)))
248     files)))
249 jet 1.3 (count (length candidates))
250 jet 1.1 common)
251     (if all
252 jet 1.3 candidates
253 jet 1.1 (cond
254     ((eq count 0) nil)
255 jet 1.3 ((eq count 1) (let ((candidate (car candidates)))
256 jet 1.1 (if (file-directory-p candidate)
257     (file-name-as-directory candidate)
258     candidate)))
259     (t
260 jet 1.3 (if (null (delete nil (mapcar (lambda (candidate)
261     (string-match "\\cj" candidate))
262     candidates)))
263     ;; 全ての候補が日本語を含んでいない場合、通常通り
264     ;; `try-completion' を呼んでまかせる。
265 shirai 1.4 (try-completion string (mapcar 'list candidates))
266 jet 1.3 (setq common (kogiku-try-completion-regexp pattern candidates))
267     (if (eq (length common) 0) string common)))))))
268 jet 1.1
269     (defun kogiku-file-name-all-completions (string dir)
270     (kogiku-file-name-completion string dir t))
271    
272 jet 1.3 (defun kogiku-double-dollars (input)
273 shirai 1.8 (let ((ret ""))
274     (while (string-match "\\$" input)
275     (setq ret (concat ret
276     (substring input 0 (match-beginning 0))
277     "$$"))
278     (setq input (substring input (match-end 0))))
279     (concat ret input)))
280 jet 1.3
281 jet 1.1 (defun kogiku-read-file-name-internal (string dir action)
282     (block nil
283     (unless (boundp 'read-file-name-predicate)
284     (setq read-file-name-predicate nil))
285     (let ((realdir dir)
286     (name string)
287     (orig-string)
288     (changed 0)
289     (val)
290     (specdir))
291     (if (eq 0 (length string))
292     (if (eq action 'lambda)
293     (return nil))
294     (setq orig-string string)
295     (setq string (substitute-in-file-name string))
296     (setq changed (null (string-equal string orig-string)))
297     (setq name (file-name-nondirectory string))
298     (setq val (file-name-directory string))
299     (if (not (null val))
300     (setq realdir (expand-file-name val realdir))))
301     (cond
302     ((null action)
303     (setq specdir (file-name-directory string))
304     (setq val (kogiku-file-name-completion name realdir))
305     (return (if (not (stringp val))
306 shirai 1.13 (if changed
307 jet 1.3 (kogiku-double-dollars string)
308 jet 1.1 val)
309 shirai 1.13 (if (not (null specdir))
310     (setq val (concat specdir val)))
311     (kogiku-double-dollars val))))
312 jet 1.1 ((eq action t)
313     (let ((all (kogiku-file-name-all-completions name realdir)))
314     (unless (or (null read-file-name-predicate)
315     (eq read-file-name-predicate 'file-exists-p))
316 shirai 1.13 (delete-if (lambda (x)
317 jet 1.24 (not (funcall read-file-name-predicate x)))
318     all))
319 jet 1.1 (return all)))
320     ((eq action 'lambda)
321     (return (if read-file-name-predicate
322     (funcall read-file-name-predicate string)
323     (file-exists-p string))))))))
324 jet 1.12
325 shirai 1.23 (defun kogiku-mode-change-at-mouse (event)
326     (interactive "e")
327     (save-window-excursion
328     (save-excursion
329     (set-buffer (window-buffer (posn-window (event-end event))))
330     (kogiku-mode-change))))
331    
332 shirai 1.15 (defun kogiku-mode-change ()
333     (interactive)
334 shirai 1.27 (setq kogiku-enable-once (not kogiku-enable-once)))
335    
336     (defun kogiku-minibuffer-prompt ()
337     (when (and (window-minibuffer-p (selected-window))
338     (not (input-pending-p)))
339     (let* ((advocate (and kogiku-use-advocate
340     (kogiku-minibuffer-prompt-advocate)))
341     (mode (if kogiku-enable-once
342     (nth 1 kogiku-minibuffer-indicator-strings)
343     (nth 0 kogiku-minibuffer-indicator-strings)))
344     (indicator
345     (cond
346     ((and kogiku-emacs21-p advocate)
347     (format "<%s:%s> " kogiku-minibuffer-prompt-string mode))
348     (kogiku-emacs21-p
349     (format "[%s:%s] " kogiku-minibuffer-prompt-string mode))
350     (advocate
351     (format "%s<%s>: " kogiku-minibuffer-prompt-string mode))
352     (t
353     (format "%s(%s): " kogiku-minibuffer-prompt-string mode))))
354     (max (if kogiku-emacs21-p (1+ (point-min)) (point-max)))
355     (force (and (not kogiku-emacs21-p) (eq (point-min) max))))
356     (when force
357     (insert " ")
358     (goto-char (point-min))
359     (setq max (point-max)))
360     (when kogiku-emacs21-p
361     (add-text-properties 0 (1- (length indicator))
362     `(face ,(if advocate
363     'kogiku-indicator-advocate-face
364     'kogiku-indicator-face))
365     indicator)
366     (add-text-properties 0 (length indicator)
367     `(local-map
368     ,kogiku-minibuffer-prompt-map
369     mouse-face
370     highlight)
371     indicator))
372     (if kogiku-minibuffer-prompt-overlay
373     (move-overlay kogiku-minibuffer-prompt-overlay
374     (point-min) max)
375     (setq kogiku-minibuffer-prompt-overlay
376     (make-overlay (point-min) max)))
377     (overlay-put kogiku-minibuffer-prompt-overlay
378     'before-string indicator)
379     (overlay-put kogiku-minibuffer-prompt-overlay 'evaporate t)
380     (when force
381     (let ((inhibit-quit t))
382     (sit-for 60)
383     (delete-region (point-min) (point-max))))
384     indicator)))
385    
386     (defun kogiku-minibuffer-prompt-advocate ()
387     (when (and (window-minibuffer-p (selected-window))
388     (not (input-pending-p)))
389     (let* ((full (buffer-substring-no-properties
390     (kogiku-field-beginning) (point-max)))
391     (dir (or (file-name-directory full) default-directory))
392 shirai 1.28 (file (or (file-name-nondirectory full) ""))
393 shirai 1.27 (files (cdr (assoc dir kogiku-minibuffer-prompt-advocate-files)))
394     (count 0)
395     (kcount 0)
396     (case-fold-search completion-ignore-case)
397     fileregex tmpfiles host)
398     (catch 'advocate
399     (unless (and (not files)
400     (or (not (eq (point) (point-max)))
401 shirai 1.28 (not dir)
402 shirai 1.27 (and (string-match "^\\(/[^/]+:\\)\\|\\(//[^/]+/[^/]+\\)" dir)
403     (setq host (concat "^" (regexp-quote (match-string 0 dir))))
404     (not (string-match host default-directory)))))
405     (unless (or (input-pending-p)
406     (not (and (file-exists-p dir) (file-directory-p dir))))
407     (unless files
408     (setq files (directory-files dir nil nil 'nosort))
409     (setq kogiku-minibuffer-prompt-advocate-files
410     (cons (cons dir files) kogiku-minibuffer-prompt-advocate-files)))
411     (if (or (and (string= file "") (setq fileregex "^\\cj"))
412     (and (string-match "\\cj$" file)
413     (setq fileregex (concat "^" (regexp-quote file) "\\cj"))))
414     (while (and files (not (input-pending-p)))
415     (when (string-match fileregex (car files))
416     (throw 'advocate t))
417     (setq files (cdr files)))
418     (unless (input-pending-p)
419     (setq tmpfiles files)
420     (setq fileregex (concat "^" (regexp-quote file) "\\Cj"
421     "\\|^" (regexp-quote file) "$"))
422     (while (and tmpfiles (not (input-pending-p)))
423     (when (string-match fileregex (car tmpfiles))
424     (setq count (1+ count)))
425     (setq tmpfiles (cdr tmpfiles)))
426     (unless (input-pending-p)
427     (setq fileregex
428     (concat "^\\("
429     (if (string-match "^\\(\\(\\Cj*\\)?\\cj+\\)\\(\\Cj+\\)$" file)
430     (concat (match-string 1 file)
431     "\\("
432     (kogiku-migemo-get-pattern (match-string 3 file))
433     "\\)")
434     (kogiku-migemo-get-pattern file))
435     "\\)"))
436     (while (and (<= kcount count)
437     files (not (input-pending-p)))
438     (when (string-match fileregex (car files))
439     (setq kcount (1+ kcount)))
440     (setq files (cdr files)))
441     (> kcount count))))))))))
442 shirai 1.15
443 jet 1.12 (defun kogiku-install-key ()
444 shirai 1.15 (when (memq minibuffer-completion-table kogiku-take-over-targets)
445 shirai 1.26 (let ((table (car kogiku-original-completion-tables))
446     (func (lookup-key (current-local-map) kogiku-completion-key))
447     (cfunc (lookup-key (current-local-map) kogiku-mode-change-key)))
448     (if (eq func 'kogiku-complete)
449     (progn
450     (push table kogiku-original-completion-tables)
451     (push (car kogiku-original-functions)
452     kogiku-original-functions)
453     (push (car kogiku-mode-change-original-functions)
454     kogiku-mode-change-original-functions))
455     (push minibuffer-completion-table kogiku-original-completion-tables)
456     (push func kogiku-original-functions)
457     (push cfunc kogiku-mode-change-original-functions))
458     (define-key (current-local-map) kogiku-completion-key 'kogiku-complete)
459     (define-key (current-local-map) kogiku-mode-change-key 'kogiku-mode-change)
460 shirai 1.27 (setq kogiku-minibuffer-prompt-advocate-files nil)
461     (add-hook 'post-command-hook 'kogiku-minibuffer-prompt)
462 shirai 1.26 (kogiku-minibuffer-prompt))))
463 shirai 1.13
464 jet 1.12 (add-hook 'minibuffer-setup-hook 'kogiku-install-key)
465    
466     (defun kogiku-uninstall-key ()
467 jet 1.14 (when (and (or (eq minibuffer-completion-table 'kogiku-read-file-name-internal)
468     (memq minibuffer-completion-table kogiku-take-over-targets))
469 jet 1.12 (eq (lookup-key (current-local-map) kogiku-completion-key)
470 shirai 1.13 'kogiku-complete))
471 shirai 1.23 (pop kogiku-original-completion-tables)
472 shirai 1.15 (define-key (current-local-map) kogiku-completion-key (pop kogiku-original-functions))
473     (when (eq (lookup-key (current-local-map) kogiku-mode-change-key)
474     'kogiku-mode-change)
475     (define-key (current-local-map) kogiku-mode-change-key
476 shirai 1.27 (pop kogiku-mode-change-original-functions))))
477     (setq kogiku-minibuffer-prompt-advocate-files nil)
478     (remove-hook 'post-command-hook 'kogiku-minibuffer-prompt))
479 shirai 1.15
480     (add-hook 'minibuffer-exit-hook 'kogiku-uninstall-key)
481 jet 1.1
482     (provide 'kogiku)
483     ;; kogiku.el ends here

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