kogiku/kogiku/kogiku.el

;;; kogiku.el - reading file and directory names with migemo service

;; Copyright (C) 2004 Masatake YAMATO

;; Author: Masatake YAMATO <jet@gyve.org>

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:
;; 日本語ファイル名の入力をmigemoを使って簡単にするプログラムです。

;; (今は使っていないのですが、)以前windowsでmeadowを使っていたときに、
;; 「デスクトップ(実際には半角)」にぶちまけてあるファイルをfind-fileし
;; ようとすると(仮名漢字変換が必要なため)ファイル名の指定が非常に面倒で
;; あると感じました。"desukutoxtupu"と打鍵してそれを「デスクトップ」へ変換
;; して[return]でやっと指定することができました。

;; 「デスクトップ」の指定をたとえば、"desktop"とか "de"[tab]とかで済めば
;; すばらしいと思いませんか？migemoを使えばこれを実現することができそう
;; です。"desktop"や"de"をmigemoで日本語に展開し、展開済みのパターンを
;; 現在のディレクトリにある全てのファイルの名前と照合すれば、ファイル名
;; を指定("desktop"と「デスクトップ」の一致)したり、補完候補を生成
;; ("de"と「デスクトップ」の一致)したりすることができます。

;; kogiku.elはmigemo.el及びGNU Emacs 21に依存しています。migemo.elの
;; 動作をまず確認して下さい。kogiku.elをロードパスが通って通っている
;; ディレクトリに置き.emacsに (require 'kogiku)と書き加えてemacsを再
;; 起動します。migemoは http://migemo.namazu.rog から入手できます。

;;; Acknowledgments:

;; Some code used in `kogiku-file-name-completion' 
;; and `kogiku-try-completion-regexp' are copied from 
;; http://www.bookshelf.jp/cgi-bin/goto.cgi?file=meadow&node=kogiku
;; (MeadowMemo maintained by Akihisa Matsushita <akihisa@mail.ne.jp>).

;; `kogiku-read-file-name-internal' are
;; translated from emacs/src/fileio.c::read-file-name-internal 
;; in elisp.

;;; Version:
;; 2.0.2.

;;; History:
;; 2.0.2
;; -- inlucde shirai's patch
;; -- introduce custom
;;
;; 2.0.1 -- update `Acknowledgments'.
;;
;; 2.0 -- rewrite.

;;; Code:

(eval-when-compile 
  (require 'cl)
  (require 'migemo))

(defgroup kogiku nil
  "reading file and directory name with migemo service"
  :group 'convenience)

(defcustom kogiku-completion-key "\t"
  ""
  :group 'kogiku
  :type 'sexp
  :options '("\t" "\e\t")
  :set (lambda (symbol value)
         (set-default symbol value)
         (setq kogiku-original-function-for-minibuffer-local-completion-map
               (let ((tmp (lookup-key minibuffer-local-completion-map value)))
                 (if (or (null tmp) (eq tmp 'kogiku-completion-complete))
                     'minibuffer-complete
                   tmp))
               kogiku-original-function-for-minibuffer-local-must-match-map
               (let ((tmp (lookup-key minibuffer-local-must-match-map value)))
                 (if (or (null tmp) (eq tmp 'kogiku-must-match-complete))
                      'minibuffer-complete
                     tmp)))
         (define-key 
           minibuffer-local-completion-map 
           value
           'kogiku-completion-complete)
         (define-key 
           minibuffer-local-must-match-map 
           value
           'kogiku-must-match-complete)))

(defcustom kogiku-busetsu-regexp ":"
  ""
  :group 'kogiku
  :type  'regexp)

(defvar kogiku-original-function-for-minibuffer-local-completion-map
  nil)

(defvar kogiku-original-function-for-minibuffer-local-must-match-map
  nil)

(defun kogiku-completion-complete ()
  (interactive)
  (if (eq minibuffer-completion-table 'read-file-name-internal)
      (setq minibuffer-completion-table
            'kogiku-read-file-name-internal))
  (funcall 
   kogiku-original-function-for-minibuffer-local-completion-map))

(defun kogiku-must-match-complete ()
  (interactive)
  (if (eq minibuffer-completion-table 'read-file-name-internal)
      (setq minibuffer-completion-table 
            'kogiku-read-file-name-internal))
  (funcall
   kogiku-original-function-for-minibuffer-local-must-match-map))

(if (fboundp 'compare-strings)
    (defalias 'kogiku-compare-strings 'compare-strings)
  (defun kogiku-compare-strings (string1 start1 end1 string2 start2 end2)
    "Convenience `compare-strings' for XEmacs."
    (let* ((str1 (substring string1 start1 end1))
           (str2 (substring string2 start2 end2))
           (len (min (length str1) (length str2)))
           (i 0))
      (if (string= str1 str2)
          t
        (setq i (catch 'ignore
                  (while (< i len)
                    (when (not (eq (aref str1 i) (aref str2 i)))
                      (throw 'ignore i))
                    (setq i (1+ i)))
                  i))
        (1+ i)))))

(defun kogiku-try-completion-regexp (regexp all-list)
  (if (= (length regexp) 0) 
      ""
    (let (common)
      (setq common
            (substring
             (car all-list) 
             0
             (apply 'min 
                    (mapcar
                     (lambda (a)
                       (apply 'min 
                              (mapcar 
                               (lambda (b)
                                 (- (abs 
                                     (kogiku-compare-strings a 0 nil
                                                      b 0 nil))
                                    1))
                               (delete a all-list))))
                     all-list))))
      common)))

(defun kogiku-migemo-get-pattern (string)
  (let ((migemo-pattern-alist migemo-pattern-alist)
        (migemo-pre-conv-function nil)
        (migemo-after-conv-function nil)
        (migemo-white-space-regexp " *"))
    (setq string (downcase string))
    (let ((case-fold-search nil))
      (while (string-match "[^a-zA-Z]\\([a-z]+\\)" string)
        (setq string
              (replace-match (capitalize (match-string 1 string)) nil nil string 1)))
      (while (string-match kogiku-busetsu-regexp string)
        (setq string (replace-match "" nil nil string))))
    (migemo-get-pattern string)))

(defun kogiku-file-name-completion (string dir &optional all)
  (let* ((expanded-string (expand-file-name string dir))
         (files (directory-files dir))
         (pattern
          (if (string-match "/$" expanded-string)
              ""
            (concat "^\\("
                    (cond
                     ((string-match "\\cj$" string)
                      string)
                     ((string-match "^\\([^\\cj]*\\cj+\\)\\([^\\cj]+\\)$" string)
                      (concat (match-string 1 string)
                              "\\("
                              (kogiku-migemo-get-pattern (match-string 2 string))
                              "\\)"))
                     (t
                      (kogiku-migemo-get-pattern (file-name-nondirectory string))))
                    "\\)")))
         (candidates (delete nil
                            (mapcar
                             (lambda (f)
                               (if (string-match pattern f)
                                   (if (file-directory-p (expand-file-name f dir))
                                       ;; ディレクトリは / で終わるように
                                       (file-name-as-directory f)
                                     f)))
                             files)))
         (count (length candidates))
         common)
    (if all
        candidates
      (cond
       ((eq count 0) nil)
       ((eq count 1) (let ((candidate (car candidates)))
                       (if (file-directory-p candidate)
                           (file-name-as-directory candidate)
                         candidate)))
       (t
        (if (null (delete nil (mapcar (lambda (candidate)
                                        (string-match "\\cj" candidate))
                                      candidates)))
            ;; 全ての候補が日本語を含んでいない場合、通常通り
            ;; `try-completion' を呼んでまかせる。
            (try-completion string (mapcar 'list candidates))
          (setq common (kogiku-try-completion-regexp pattern candidates))
          (if (eq (length common) 0) string common)))))))

(defun kogiku-file-name-all-completions (string dir)
  (kogiku-file-name-completion string dir t))

(defun kogiku-double-dollars (input)
  (replace-regexp-in-string "\\$" "$$" input))

(defun kogiku-read-file-name-internal (string dir action)
  (block nil
    (unless (boundp 'read-file-name-predicate)
      (setq read-file-name-predicate nil))
    (let ((realdir dir)
          (name string)
          (orig-string)
          (changed 0)
          (val)
          (specdir))
      (if (eq 0 (length string))
          (if (eq action 'lambda)
              (return nil))
        (setq orig-string string)
        (setq string (substitute-in-file-name string))
        (setq changed (null (string-equal string orig-string)))
        (setq name (file-name-nondirectory string))
        (setq val  (file-name-directory string))
        (if (not (null val))
            (setq realdir (expand-file-name val realdir))))
      (cond
       ((null action)
        (setq specdir (file-name-directory string))
        (setq val     (kogiku-file-name-completion name realdir))
        (return (if (not (stringp val))
                    (if changed 
                        (kogiku-double-dollars string)
                      val)
                  (if (not (null specdir)) 
                      (concat specdir val)
                    (kogiku-double-dollars val)
                    ))))
       ((eq action t)
        (let ((all (kogiku-file-name-all-completions name realdir)))
          (unless (or (null read-file-name-predicate)
                      (eq read-file-name-predicate 'file-exists-p))
            (delete-if (lambda (x) 
                         (not (funcall read-file-name-predicate x))
                         all)))
          (return all)))
       ((eq action 'lambda)
        (return (if read-file-name-predicate
                    (funcall read-file-name-predicate string)
                  (file-exists-p string))))))))

(provide 'kogiku)
;; kogiku.el ends here