Show
Ignore:
Timestamp:
06/26/08 10:54:06 (6 years ago)
Author:
imakado
Message:

コードの見直し、いくつかの動作の改善、defcustom化

Files:
1 modified

Legend:

Unmodified
Added
Removed
  • lang/elisp/perl-completion/trunk/perl-completion.el

    r13971 r14626  
    11;;;  -*- coding: utf-8; mode: emacs-lisp; -*- 
    2 ;;; perl-completion.el ---  
     2;;; perl-completion.el 
    33 
    44;; Author: Kenji.Imakado <ken.imakaado@gmail.com> 
    5 ;; Version: 0.2 
     5;; Version: 0.3 
    66;; Keywords: perl 
    77 
     
    2222 
    2323;;; Commentary: 
     24;; Tested on Emacs 22 
     25 
     26;; to customize 
     27;; M-x customize-group RET perl-completion RET 
     28 
     29;;;code: 
    2430 
    2531(require 'cl) 
    2632(require 'cperl-mode) 
    27  
    28  
    29 ;;; prefix: plcmp- 
     33(require 'dabbrev) 
     34(require 'rx) 
    3035 
    3136;;; provide 
    3237(provide 'perl-completion) 
    3338 
     39;;; group 
     40(defgroup perl-completion nil 
     41  "" 
     42  :group 'perl-completion) 
     43 
    3444;;; customizable variables 
    35 (defcustom plcmp-anything-candidate-number-limit 1000 "") 
    36 (defcustom plcmp-delete-duplicates-candidates-flag nil "") 
    37 (defcustom plcmp-get-words-other-perl-buf-flag t "") 
    38 (defcustom plcmp-buffer-dabbrev-expansions-number 2 "initial-input >= value then dabbrev") ; TODO name and doc 
    39 (defcustom plcmp-get-words-other-perl-buf-limit-number 30 "") 
     45(defcustom plcmp-anything-candidate-number-limit 1000 
     46  "補完候補の最大表示数 
     47`anything-candidate-number-limit'と同じ" 
     48  :type 'number 
     49  :group 'perl-completion) 
     50 
     51(defcustom plcmp-buffer-dabbrev-expansions-number 2 
     52  "バッファ内のdabbrevを候補に入れる文字数 
     53initial-inputのlengthがこの数値より小さいと補完を行わない 
     54注意、0(常に補完)に設定する事も可能ですが動作が遅くなる可能性があります" 
     55  :type 'number 
     56  :group 'perl-completion) ; TODO name and doc 
     57 
     58(defcustom plcmp-get-words-other-perl-buf-limit-number 30 
     59  "補完対象にする他のperlバッファの最大数" 
     60  :type 'number 
     61  :group 'perl-completion) 
     62 
    4063(defcustom plcmp-config-modules-filter-list 
    4164  '("strict" "warning") 
    42   "補完対象に含めないモジュール名のリスト") 
     65  "補完対象に含めないモジュール名のリスト 
     66このリストに含まれているモジュールのメソッドは補完対象にならない" 
     67  :type '(repeat (string :tag "Module name")) 
     68  :group 'perl-completion) 
     69 
     70(defcustom plcmp-dabbrev-abbrev-char-regexp "\\sw\\|\\s_\\|[:_]" 
     71  "dabbrevの候補になるcharを決めるregexp 
     72`dabbrev-abbrev-char-regexp'にダイナミックにバインドされて使用される" 
     73  :type 'regexp 
     74  :group 'perl-completion) 
     75 
     76(defcustom plcmp-match-only-real-candidate nil 
     77  "この変数がnon-nilだとパターンが実際の補完候補のみにマッチするようになる 
     78例: nil(デフォルト)の場合、パターン\"agent\"は以下の両方の補完候補にマッチする 
     79なぜなら\"UserAgent\"の部分に\"agent\"がマッチするからである 
     80[LWP::UserAgent] | agent 
     81[LWP::UserAgent] | clone 
     82non-nilの場合は\"|\"以降の文字列のみにマッチする" 
     83  :type 'boolean 
     84  :group 'perl-completion) 
    4385 
    4486;;; const 
    45 (defconst plcmp-version 0.2) 
     87(defconst plcmp-version 0.3) 
    4688(defconst plcmp-lang (cond ((string-match "japanese" (format "%s" locale-coding-system)) 'ja) 
    4789                           (t 'english))) 
     
    58100(defconst plcmp-display-format-using-modules "using module") 
    59101(defconst plcmp-display-format-installed-modules "installed module") 
     102(defconst plcmp-get-installed-modules-command "find `perl -e 'pop @INC; print join(q{ }, @INC);'` -name '*.pm' -type f | xargs egrep -h -o 'package [a-zA-Z0-9:]+;' | perl -nle 's/package\s+(.+);/$1/; print' | sort | uniq ") ; 
     103(defconst plcmp-get-installed-modules-async-command 
     104  (concat plcmp-get-installed-modules-command " &")) 
    60105(defconst plcmp-builtin-functions 
    61106  '("abs" "exec" "glob" "order" "seek" "symlink" "accept" "exists" "gmtime" 
     
    85130    "open" "rmdir" "study" "eof" "getsockname" "opendir" "s" "sub" "eval" "getsockopt" 
    86131    "ord" "scalar" "substr")) 
     132 
    87133(defconst plcmp-builtin-variables 
    88134  '("$SIG{expr}" "%SIG" "$ENV{expr}" "%ENV" "%INC" "@_" "@INC" "@F" "ARGVOUT" 
     
    111157    "$PREMATCH" "$&" "$MATCH" "$<digits>" "$b" "$a" "$_" "$ARG")) 
    112158 
     159;;; face 
     160(defface plcmp-search-match 
     161  '((t (:background "grey15" :foreground "magenta" :underline t))) 
     162  "" 
     163  :group 'perl-completion 
     164  :tag "Plcmp Search Match Face") 
     165 
     166;;; struct 
     167(defstruct (plcmp-completion-data (:constructor plcmp-make-completion-data)) 
     168  (initial-input "") 
     169  state 
     170  using-modules 
     171  current-buffer 
     172  current-object 
     173  current-package 
     174  cache-installed-modules 
     175  cache-using-modules 
     176  other-perl-buffers 
     177  obj-instance-of-module-maybe-alist 
     178  installed-modules) 
     179 
    113180;;; variables 
    114 (defvar plcmp-cache-using-modules nil) ;last 
    115 (make-variable-buffer-local 'plcmp-cache-using-modules) 
    116  
     181(defvar plcmp-data (plcmp-make-completion-data) "strunct") 
     182(defvar plcmp-search-match-face 'plcmp-search-match) 
     183(defvar plcmp-overlay nil) 
     184(defvar plcmp-metadata-matcher-re (rx bol (* (not (any "|"))) "|" space (*? not-newline))) 
     185(defvar plcmp-metadata-matcher "") 
     186 
     187;;; buffer local variables 
     188(defvar plcmp-last-using-modules nil) 
     189(make-variable-buffer-local 'plcmp-last-using-modules) 
    117190(defvar plcmp-modules-methods-alist nil) 
    118191(make-variable-buffer-local 'plcmp-modules-methods-alist) 
    119192 
    120 (defvar plcmp-cache-installed-modules nil) 
    121 (defvar plcmp-get-installed-modules-command "find `perl -e 'pop @INC; print join(q{ }, @INC);'` -name '*.pm' -type f | xargs egrep -h -o 'package [a-zA-Z0-9:]+;' | perl -nle 's/package\s+(.+);/$1/; print' | sort | uniq ") 
    122 (defvar plcmp-get-installed-modules-async-command 
    123   (concat plcmp-get-installed-modules-command " &")) 
     193;;; anything's variables 
     194(defvar plcmp-anything-sources nil) 
     195(defvar plcmp-anything-enable-digit-shortcuts nil ) 
     196(defvar plcmp-anything-candidate-number-limit plcmp-anything-candidate-number-limit ) 
     197(defvar plcmp-anything-idle-delay 0.5 ) 
     198(defvar plcmp-anything-samewindow nil ) 
     199(defvar plcmp-anything-source-filter nil ) 
     200(defvar plcmp-anything-isearch-map 
     201  (let ((map (copy-keymap (current-global-map)))) 
     202    (define-key map (kbd "<return>") 'plcmp-anything-isearch-default-action) 
     203    (define-key map (kbd "C-i") 'plcmp-anything-isearch-select-action) 
     204    (define-key map (kbd "C-g") 'plcmp-anything-isearch-cancel) 
     205    (define-key map (kbd "M-s") 'plcmp-anything-isearch-again) 
     206    (define-key map (kbd "<backspace>") 'plcmp-anything-isearch-delete) 
     207    (let ((i 32)) 
     208      (while (< i 256) 
     209        (define-key map (vector i) 'plcmp-anything-isearch-printing-char) 
     210        (setq i (1+ i)))) 
     211    map)) 
     212(defgroup plcmp-anything nil 
     213  "Open plcmp-anything." :prefix "plcmp-anything-" :group 'convenience) 
     214(if (facep 'header-line) 
     215    (copy-face 'header-line 'plcmp-anything-header) 
     216  (defface plcmp-anything-header 
     217    '((t (:bold t :underline t))) 
     218    "Face for header lines in the plcmp-anything buffer." :group 'plcmp-anything)) 
     219(defvar plcmp-anything-header-face 'plcmp-anything-header ) 
     220(defface plcmp-anything-isearch-match '((t (:background "Yellow"))) 
     221  "Face for isearch in the plcmp-anything buffer." :group 'plcmp-anything) 
     222(defvar plcmp-anything-isearch-match-face 'plcmp-anything-isearch-match ) 
     223(defvar plcmp-anything-iswitchb-idle-delay 1 ) 
     224(defvar plcmp-anything-iswitchb-dont-touch-iswithcb-keys nil ) 
     225(defconst plcmp-anything-buffer "*perl-completion anything*" ) 
     226(defvar plcmp-anything-selection-overlay nil ) 
     227(defvar plcmp-anything-isearch-overlay nil ) 
     228(defvar plcmp-anything-digit-overlays nil ) 
     229(defvar plcmp-anything-candidate-cache nil ) 
     230(defvar plcmp-anything-pattern "") 
     231(defvar plcmp-anything-input "") 
     232(defvar plcmp-anything-async-processes nil ) 
     233(defvar plcmp-anything-digit-shortcut-count 0 ) 
     234(defvar plcmp-anything-update-hook nil ) 
     235(defvar plcmp-anything-saved-sources nil ) 
     236(defvar plcmp-anything-saved-selection nil ) 
     237(defvar plcmp-anything-original-source-filter nil ) 
     238 
     239;;; hack variables 
     240;; idea: http://www.emacswiki.org/cgi-bin/wiki/RubikitchAnythingConfiguration 
     241(defvar plcmp-anything-saved-action nil 
     242  "Saved value of the currently selected action by key.") 
     243 
     244(defvar plcmp-anything-matched-candidate-cache nil 
     245  "(name . ((pattern . (list of string)) 
     246            (pattern . (list of string)))) ") 
     247 
    124248;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    125 ;;; Modules 
     249;;; Utilities 
    126250;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
     251 
     252(defmacro plcmp-with-slots (struct conc-name slots &rest body) 
     253  `(symbol-macrolet ,(loop for slot in slots 
     254                           collect `(,slot (,(intern (concat (symbol-name conc-name) (symbol-name slot))) ,struct))) 
     255     ,@body)) 
     256(def-edebug-spec plcmp-with-slots (symbolp symbolp (&rest symbolp) body)) ;TODO 
     257   
     258(defmacro plcmp-with-completion-data-slots (struct slots &rest body) 
     259  (declare (indent 2)) 
     260  `(plcmp-with-slots ,struct plcmp-completion-data- ,slots ,@body)) 
     261(def-edebug-spec plcmp-with-completion-data-slots (symbolp (&rest symbolp) body)) 
     262   
     263(defmacro plcmp-with-gensyms (symbols &rest body) 
     264  (declare (indent 1)) 
     265  `(let ,(mapcar (lambda (sym) 
     266                   `(,sym (gensym))) 
     267                 symbols) 
     268     ,@body)) 
     269 
     270(defmacro plcmp-my (var val &rest body) 
     271  (declare (indent 2)) 
     272  `(lexical-let ((,var ,val)) 
     273     ,@body)) 
     274 
     275(put 'plcmp-acond 'lisp-indent-function 'defun) ;TODO 
     276(defmacro plcmp-acond (&rest clauses) 
     277  (unless (null clauses) 
     278    (plcmp-with-gensyms (sym) 
     279      (plcmp-my clause (car clauses) 
     280        `(plcmp-my ,sym ,(car clause) 
     281           (if ,sym 
     282               (plcmp-my it ,sym 
     283                 ,@(cdr clause))        ;expr 
     284             (plcmp-acond ,@(cdr clauses)))))))) 
     285(def-edebug-spec plcmp-acond cond) 
     286 
     287(defsubst plcmp-trim (s) 
     288  "strip space and newline" 
     289  (replace-regexp-in-string 
     290   "[ \t\n]*$" "" (replace-regexp-in-string "^[ \t\n]*" "" s))) 
     291 
     292(defun plcmp-get-preceding-string (&optional count) 
     293  "現在の位置からcount文字前方位置までの文字列を返す 
     294例外を出さない" 
     295  (let ((count (or count 1))) 
     296    (buffer-substring-no-properties 
     297     (point) 
     298     (condition-case nil 
     299         (save-excursion (backward-char count) (point)) 
     300       (error (point)))))) 
     301 
     302(defsubst plcmp-module-p (s) 
     303  (string-match "^[a-zA-Z:_]+$" s)) 
     304 
     305(defsubst plcmp-perl-identifier-p (s) 
     306  (string-match (concat "^" plcmp-perl-ident-re "$") s)) 
     307 
     308(defun plcmp-notfound-p (s) 
     309  (string-match "^Can't locate [^ \t]+ in" s)) 
     310 
     311(defmacro plcmp-ignore-errors (&rest body) 
     312  `(condition-case e (progn ,@body) 
     313     (error (plcmp-log "Error plcmp-ignore-errors :  %s" (error-message-string e))))) 
     314 
     315;;; log 
     316(defvar plcmp-debug nil) 
     317(defvar plcmp-log-buf-name "*plcmp debug*") 
     318(defun plcmp-log-buf () 
     319  (get-buffer-create plcmp-log-buf-name)) 
     320(defun plcmp-log (&rest messages) 
     321  (ignore-errors 
     322    (let* ((str (or (ignore-errors (apply 'format messages)) 
     323                    (prin1-to-string messages))) 
     324           (strn (concat str "\n"))) 
     325      (when plcmp-debug 
     326        (with-current-buffer (plcmp-log-buf) 
     327          (goto-char (point-max)) 
     328          (insert strn))) 
     329      str))) 
     330 
     331 
     332;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
     333;;;; Initialize 
     334;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
     335 
     336;; idea: http://subtech.g.hatena.ne.jp/antipop/20070917/1190009355 
     337(defun plcmp-get-installed-modules-synchronously () 
     338  (message "fetching installed modules...") 
     339  (let ((modules (split-string (shell-command-to-string plcmp-get-installed-modules-command) "\n"))) 
     340    (message "fetching installed modules done") 
     341    (remove-if (lambda (module) 
     342                 (string-match "No such file or directory$" module)) 
     343               modules))) 
     344 
     345(defun plcmp-get-installed-modules-from-buf (buf) 
     346  (with-current-buffer buf 
     347    (let ((modules (split-string (buffer-substring-no-properties (point-min) (point-max)) "\n"))) 
     348      (remove-if (lambda (module) 
     349                   (string-match "No such file or directory$" module)) 
     350                 modules)))) 
     351 
     352(defun plcmp-send-command-get-installed-modules () 
     353  (message "send command to get installed modules") 
     354  (save-window-excursion 
     355    (shell-command plcmp-get-installed-modules-async-command plcmp-installed-modules-buf-name)) 
     356  (with-current-buffer plcmp-installed-modules-buf-name 
     357    (setq buffer-read-only t))) 
     358 
     359(defun plcmp-fetch-installed-modules (struct) 
     360  (plcmp-with-completion-data-slots struct 
     361      (cache-installed-modules) 
     362    (let ((buf (get-buffer plcmp-installed-modules-buf-name))) 
     363      (cond 
     364       ((null cache-installed-modules) 
     365        (if (and (buffer-live-p buf) 
     366                 (not (processp (get-buffer-process buf)))) ;finished 
     367            (setf cache-installed-modules (plcmp-get-installed-modules-from-buf buf)) 
     368          (unless (buffer-live-p buf) 
     369            (plcmp-send-command-get-installed-modules)) 
     370          (plcmp-get-installed-modules-synchronously))) 
     371       ;; return cache 
     372       (t 
     373        cache-installed-modules))))) 
     374 
     375(defun plcmp-get-current-package () 
     376  "nil or string" 
     377  (let ((re (concat "^[ \t]*package\\s *" "\\([a-zA-Z:]+\\)" ".*;$")) 
     378        (limit 500)) 
     379    (save-excursion 
     380      (goto-char (point-min)) 
     381      (when (re-search-forward re limit t) 
     382        (match-string-no-properties 1))))) 
     383 
    127384(defun plcmp-get-using-modules () 
    128   (let ((re "^[ \t]*use[ \t]+\\([a-zA-Z:_]+\\)\\s *[^;\n]*;");todo 
     385  (let ((re "^[ \t]*use[ \t]+\\([a-zA-Z:_]+\\)\\s *[^;\n]*;") ;todo 
    129386        (ret nil)) 
    130387    (save-excursion 
     
    138395    ret)) 
    139396 
    140 (defun plcmp-clear-cache-using-modules () 
    141   (interactive) 
    142   (setq plcmp-cache-using-modules nil)) 
    143  
    144  
    145 (defun plcmp-modules-filter (mods) 
    146   (let ((ret nil) ) 
    147     (dolist (filter-mod plcmp-config-modules-filter-list ret) 
    148       (setq ret (delete filter-mod mods))))) 
    149  
    150  
    151 (defun plcmp-get-modules-methods-alist (using-modules) 
    152   (let ((ret nil)) 
    153     (cond 
    154      ((and (equal using-modules plcmp-cache-using-modules) 
    155            (not (null plcmp-modules-methods-alist))) 
    156       (setq ret plcmp-modules-methods-alist)) 
    157      ((null plcmp-modules-methods-alist) 
    158       (dolist (mod using-modules) 
    159         (message "getting methods of %s ..." mod) 
    160         (push `(,mod . ,(plcmp-get-methods mod)) plcmp-modules-methods-alist) 
    161         (message "getting methods of %s done" mod)) 
    162       (setq ret plcmp-modules-methods-alist)) 
    163      (t 
    164       (let ((new-mods (delete-dups 
    165                        (set-difference using-modules plcmp-cache-using-modules :test 'string-equal))) 
    166             (removed-mods (delete-dups 
    167                            (set-difference plcmp-cache-using-modules using-modules :test 'string-equal)))) 
    168         (plcmp-log "new-mods: %S\nremoved-mods: %S" new-mods removed-mods) 
    169         ;; add new 
    170         (when new-mods 
    171           (dolist (mod new-mods) 
    172             (message "getting methods of %s ..." mod) 
    173             (push `(,mod . ,(plcmp-get-methods mod)) plcmp-modules-methods-alist) 
    174             (message "getting methods of %s done" mod))) 
    175         ;; remove 
    176         (when removed-mods 
    177           (dolist (mod removed-mods) 
    178             (setq plcmp-modules-methods-alist 
    179                   (remove (assoc mod plcmp-modules-methods-alist) plcmp-modules-methods-alist)))) 
    180         (setq ret plcmp-modules-methods-alist)))) 
    181     ;; set last 
    182     (setq plcmp-cache-using-modules using-modules) 
    183     ret 
    184     )) 
    185  
    186 (defun plcmp-clear-cache-modules-methods-alist () 
    187   (setq plcmp-modules-methods-alist nil)) 
    188  
    189 (defun plcmp-get-methods (module) 
     397;;(plcmp-sort-methods '("_asdf" "asdf" "bsd" "_bsd" "ASDF")) 
     398;; => ("ASDF" "asdf" "bsd" "_asdf" "_bsd") 
     399(defun plcmp-sort-methods (los) 
     400  (loop for s in los 
     401        if (string-match (rx bol "_") s) 
     402        collect s into unders 
     403        else 
     404        collect s into methods 
     405        finally return (nconc methods unders 
     406                        ;; (sort methods 'string<) 
     407                        ;;                               (sort unders 'string<) 
     408                              ))) 
     409 
     410(defsubst plcmp-inspect-methods (module) 
    190411  "Class::Inspectorを使用してモジュールのメソッド調べる。 
    191412モジュール名に使用できる文字以外が含まれていた場合はnilを返す 
     
    195416      (error "invild modulename")) 
    196417    (let ((mods (shell-command-to-string 
    197                  (concat 
    198                   "perl" " -MClass::Inspector" " -e" "'use " module "; print join \"\n\"=>@{Class::Inspector->methods(" module ")} '" )))) 
     418                 (concat "perl -MClass::Inspector -e'use " module "; print join \"\n\"=>@{Class::Inspector->methods(" module ")} '")))) 
    199419      (cond 
    200420       ((plcmp-notfound-p mods) 
    201421        (error "cant locate %s" module)) 
    202422       (t 
    203         (split-string mods "\n")))))) 
    204  
    205 (defsubst plcmp-get-modules-re () 
    206   (regexp-opt plcmp-using-modules t)) 
    207  
    208 ;; example 
    209 ;; my $cpan = Parse::CPAN::Authors->new( $authors_file ); 
    210 ;; => var = "$cpan", mod = Parse::CPAN::Authors 
    211 (defun plcmp-get-obj-instance-of-module-maybe-alist () 
    212   (let* ((re (plcmp-get-modules-re)) 
    213          (re (concat "\\(\\$[A-Za-z_][A-Za-z_0-9]*\\)\\s *=\\s *" re)) ;perliden + usingmodule 
    214          (ret nil)) 
     423        (plcmp-sort-methods (split-string mods "\n"))))))) 
     424 
     425(defun plcmp-get-modules-methods (modules) 
     426  "return alist" 
     427  (let ((ret nil)) 
     428    (dolist (mod modules ret) 
     429      (message "getting methods of %s ..." mod) 
     430      (push `(,mod . ,(plcmp-inspect-methods mod)) ret) 
     431      (message "getting methods of %s done" mod)))) 
     432 
     433;; TODO 
     434(defun plcmp-get-modules-methods-alist (struct) 
     435  (plcmp-with-completion-data-slots struct 
     436      (using-modules current-buffer) 
     437    ;;`plcmp-modules-methods-alist' and `plcmp-last-using-modules' are buffer local variables 
     438    (with-current-buffer current-buffer 
     439      (let ((ret nil)) 
     440        (cond 
     441         ((and (equal using-modules plcmp-last-using-modules) 
     442               (not (null plcmp-modules-methods-alist))) 
     443          (setq ret plcmp-modules-methods-alist)) 
     444         ;; cache not ready 
     445         ((null plcmp-modules-methods-alist) 
     446          (setf ret 
     447                (setf plcmp-modules-methods-alist 
     448                      (plcmp-get-modules-methods using-modules)))) 
     449         (t 
     450          (let ((new-mods (delete-dups (set-difference using-modules plcmp-last-using-modules :test 'string-equal))) 
     451                (removed-mods (delete-dups (set-difference plcmp-last-using-modules using-modules :test 'string-equal)))) 
     452            (plcmp-log "new-mods: %S\nremoved-mods: %S" new-mods removed-mods) 
     453            ;; add new 
     454            (when new-mods 
     455              (setq plcmp-modules-methods-alist 
     456                    (append plcmp-modules-methods-alist 
     457                            (plcmp-get-modules-methods new-mods)))) 
     458            ;; remove 
     459            (when removed-mods 
     460              (setq plcmp-modules-methods-alist 
     461                    (remove-if (lambda (mod) (assoc mod plcmp-modules-methods-alist)) removed-mods))) 
     462            (setq ret plcmp-modules-methods-alist)))) 
     463        ;; set last 
     464        (setq plcmp-last-using-modules using-modules) 
     465        ret 
     466        )))) 
     467 
     468(defun plcmp-get-obj-instance-of-module-maybe-alist (struct) 
     469  (plcmp-with-completion-data-slots struct 
     470      (using-modules) 
     471    (let* ((re (regexp-opt using-modules t)) 
     472           (re (concat "\\(\\$" plcmp-perl-ident-re "\\)\\s *=\\s *" re)) ;perliden + usingmodule 
     473           (ret nil)) 
     474      (save-excursion 
     475        (goto-char (point-min)) 
     476        (loop always (re-search-forward re nil t) 
     477              do (let ((var (match-string-no-properties 1)) 
     478                       (mod (match-string-no-properties 2))) 
     479                   (add-to-list 'ret `(,var . ,mod))))) 
     480      ret))) 
     481 
     482(defun plcmp-get-other-perl-buffers (struct) 
     483  (plcmp-with-completion-data-slots struct 
     484      (current-buffer) 
     485    (remove current-buffer 
     486            (remove-if-not (lambda (buf) 
     487                             (string-match "\\.p[lm]$" (buffer-name buf))) 
     488                           (buffer-list))))) 
     489 
     490(defun plcmp-initialize (struct) 
     491  (plcmp-with-completion-data-slots struct 
     492      (using-modules installed-modules current-package 
     493                     current-buffer obj-instance-of-module-maybe-alist 
     494                     current-object other-perl-buffers) 
     495    ;; initialize slots 
     496    (setf installed-modules (plcmp-fetch-installed-modules struct) 
     497          current-buffer (current-buffer) 
     498          current-package (plcmp-get-current-package) 
     499          using-modules (plcmp-get-using-modules) 
     500          plcmp-modules-methods-alist (plcmp-get-modules-methods-alist struct) ;buffer local variable 
     501          obj-instance-of-module-maybe-alist (plcmp-get-obj-instance-of-module-maybe-alist struct) 
     502          other-perl-buffers (plcmp-get-other-perl-buffers struct) 
     503          current-object "") 
     504 
     505    ;; initialize variable 
     506    (setq plcmp-metadata-matcher 
     507          (if plcmp-match-only-real-candidate 
     508              plcmp-metadata-matcher-re 
     509            "")) 
     510 
     511    ;; get context 
     512    (plcmp-get-context struct))) 
     513 
     514(defun plcmp-method-p () 
     515  (let ((s (plcmp-get-preceding-string 2))) 
     516    (string-equal s "->"))) 
     517 
     518(defun plcmp-get-context (struct) 
     519  (plcmp-with-completion-data-slots struct 
     520      (initial-input state current-object) 
    215521    (save-excursion 
    216       (goto-char (point-min)) 
    217       (loop always (re-search-forward re nil t)             
    218             do (let ((var (match-string-no-properties 1)) 
    219                      (mod (match-string-no-properties 2))) 
    220                  (add-to-list 'ret `(,var . ,mod))))) 
    221       ret)) 
    222  
    223  
    224 ;; idea: http://subtech.g.hatena.ne.jp/antipop/20070917/1190009355 
    225 (defun plcmp-send-command-get-installed-modules () 
    226   (save-window-excursion 
    227     (shell-command plcmp-get-installed-modules-async-command plcmp-installed-modules-buf-name)) 
    228   (with-current-buffer plcmp-installed-modules-buf-name 
    229     (setq buffer-read-only t))) 
    230  
    231 (defun plcmp-get-installed-modules () 
    232   (let ((buf (get-buffer plcmp-installed-modules-buf-name))) 
    233     (cond 
    234      ((null plcmp-cache-installed-modules) 
    235       (cond 
    236        ;; コマンドの結果のバッファがある場合 
    237        ((buffer-live-p buf) 
    238         (with-current-buffer buf 
    239           (let* ((modules (split-string (buffer-substring-no-properties (point-min) (point-max)) "\n")) 
    240                  (modules (remove-if (lambda (module) 
    241                                        (string-match "No such file or directory$" module)) 
    242                                      modules))) 
    243             ;; when process finished 
    244             (unless (processp (get-buffer-process plcmp-installed-modules-buf-name)) 
    245               (setq plcmp-cache-installed-modules modules)) 
    246             modules))) 
    247        ;; 事前にコマンドが走っていない場合はその場で同期的に習得する 
    248        (t 
    249         (let* ((modules (split-string (shell-command-to-string plcmp-get-installed-modules-command) "\n")) 
    250                (modules (remove-if (lambda (module) 
    251                                      (string-match "No such file or directory$" module)) 
    252                                    modules))) 
    253           (plcmp-send-command-get-installed-modules))))) 
    254      ;; return cache 
    255      (t 
    256       plcmp-cache-installed-modules)))) 
    257  
    258 (defun plcmp-clear-cache-installed-modules () 
    259   (ignore-errors 
    260    (setq plcmp-cache-installed-modules nil) 
    261     (let ((process (get-buffer-process plcmp-installed-modules-buf-name))) 
    262       (when (processp process) 
    263         (kill-process (process-name process))) 
    264       (plcmp-send-command-get-installed-modules)))) 
    265  
    266 (defun plcmp-get-current-package () 
    267   (let ((re (concat "^[ \t]*package" "\\([a-zA-Z:]+\\)" "\\s *[^;\n]*;")) 
    268         (limit 500) 
    269         (ret nil)) 
    270     (save-excursion 
    271       (goto-char (point-min)) 
    272       (loop always (re-search-forward re limit t) 
    273             do (add-to-list 'ret (match-string-no-properties 1)))) 
    274     (plcmp-log "get-current-package: %S" ret) 
    275     ret)) 
    276  
    277  
    278 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    279 ;;; Smart dabbrev 
    280 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    281  
    282 (defsubst plcmp-check-face (facename) 
    283   "preceding-charの位置のフェイスを調べる(前の文字)" 
    284   (let ((face (get-text-property (if (bobp) (point) (- (point) 1)) 'face))) 
    285     ;;(plcmp-log "check-face-at-point: %s" face) 
    286     (cond 
    287      ((listp face) 
    288       (memq facename face)) 
    289      (t 
    290       (eq facename face))))) 
    291  
    292 (defsubst plcmp-check-face-at-point-p (facename) 
    293   (let ((face (get-text-property (point) 'face))) 
    294     ;;(plcmp-log "check-face-at-point: %s" face) 
    295     (cond 
    296      ((listp face) 
    297       (memq facename face)) 
    298      (t 
    299       (eq facename face))))) 
    300  
    301 (defsubst plcmp-bit-regep-p (s) 
    302   (string-match "^[/$@%(),.?<>+!|^*';\"\\]+$" s)) 
     522      (let* ((start (point)) 
     523             (start-input (progn (skip-syntax-backward "w_") ;move point 
     524                                 (buffer-substring-no-properties (point) start))) 
     525             (obj-str (buffer-substring-no-properties 
     526                       (or (ignore-errors (save-excursion (forward-char -2) (point))) 
     527                           (point)) 
     528                       (save-excursion (or (ignore-errors (backward-sexp) 
     529                                                          (point)) 
     530                                           (point)))))) 
     531        (cond 
     532         ;; $self->`!!' 
     533         ((and (plcmp-method-p)         ; TODO 
     534               (string-match "^\\(\\$self\\|__PACKAGE__\\)$" obj-str)) 
     535          (setf initial-input start-input 
     536                state 'setf 
     537                current-object obj-str)) 
     538         ;; methods 
     539         ;; Foo->`!!' 
     540         ((plcmp-method-p) 
     541          (setf initial-input start-input 
     542                state 'methods 
     543                current-object obj-str)) 
     544         ;; $foo`!!' 
     545         ((string-match "[$@%&]" (plcmp-get-preceding-string 1)) 
     546          (save-excursion 
     547            (forward-char -1) 
     548            (setf initial-input (buffer-substring-no-properties start (point)) 
     549                  state 'globals))) 
     550         ;; installed-modules 
     551         ;; use Foo::Ba`!!' 
     552         ((string-match "^\\s *use\\s *" (buffer-substring-no-properties (point-at-bol) (point))) 
     553          (setf initial-input start-input 
     554                state 'installed-modules)) 
     555         ;; globals 
     556         ((or (bolp) 
     557              (string-match "[ \t]" (plcmp-get-preceding-string 1))) 
     558          (setf initial-input start-input 
     559                state 'globals)) 
     560         ;; otherwise 
     561         (t 
     562          (setf initial-input start-input 
     563                state 'globals)) 
     564         ))))) 
     565 
     566;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
     567;;;; Candidates 
     568;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
     569(defsubst plcmp-build-display-candidate (metadata str) 
     570  (concat "[" metadata "]" " | " str)) 
     571 
     572(defsubst plcmp-get-real-candidate (display-candidate) 
     573  "return string" 
     574  (if (string-match (concat "^\\[[^\]\n]*\\] | " 
     575                            "\\(.*\\)") 
     576                    display-candidate) 
     577      (match-string 1 display-candidate) 
     578    display-candidate)) 
     579 
     580(defsubst plcmp-get-metadate-candidate (display-candidate) 
     581  "return string" 
     582  (if (string-match "^\\[\\([^\]\n]*\\)\\] | " display-candidate) 
     583      (match-string 1 display-candidate) 
     584    "")) 
     585 
     586(defun plcmp-get-modulename-candidate (struct display-candidate) 
     587  (let ((metadata (plcmp-get-metadate-candidate display-candidate))) 
     588    (plcmp-acond 
     589      ((plcmp-get-module-and-method-by-candidate struct display-candidate) 
     590       (multiple-value-bind (module method) it ;when bind, IT must be list of string '(module method) 
     591         module)) 
     592      (t 
     593       (plcmp-get-real-candidate display-candidate))))) 
     594 
     595(defsubst plcmp-start-initial-input-p (initial-input candidate) 
     596  (let ((re (concat "^" (regexp-quote initial-input)))) 
     597    (string-match re candidate))) 
     598 
     599(defsubst plcmp-fillter-and-add-metadata (los initial-input metadata-format) ;TODO: funcname 
     600  "return los" 
     601  (loop for str in los 
     602        with ret 
     603        do (when (plcmp-start-initial-input-p initial-input str) 
     604             (push (plcmp-build-display-candidate metadata-format str) ret)) 
     605        finally return (nreverse ret))) 
     606 
     607;;; buffer dabbrev, functions, variables 
     608(defsubst plcmp-check-face (facename &optional point) 
     609  "POINTの位置のフェイスを調べる(前の文字)" 
     610  (let* ((p (or point (point))) 
     611         (face (get-text-property p 'face))) 
     612    (if (listp face) 
     613        (memq facename face) 
     614      (eq facename face)))) 
     615 
     616(defsubst plcmp-bit-regexp-p (s) 
     617  (string-match "^[/:$@&%(),.?<>+!|^*';\"\\]+$" s)) 
    303618 
    304619(defun plcmp-get-words-by-face (face) 
     
    308623        (goto-char (point-min)) 
    309624        ;;最初のfaceへ移動 
    310         (loop always (not (plcmp-check-face face)) 
     625        (loop always (not (plcmp-check-face face (if (bobp) (point) (- (point) 1)))) 
    311626              do (unless (forward-word) 
    312627                   (error "no variables"))) 
     
    317632              always (not (eobp)) 
    318633              do (progn 
    319                    (when (plcmp-check-face-at-point-p face) 
     634                   (when (plcmp-check-face face) 
    320635                     (let ((str (or (cperl-word-at-point) ""))) 
    321636                       ;; fillter 
    322                        (unless (plcmp-bit-regep-p str) 
     637                       (unless (plcmp-bit-regexp-p str) 
    323638                         (push str ret)))) ;must be string 
    324639                   (goto-char next-change))) 
    325640        (delete-dups ret))))) 
    326641 
    327 (defun plcmp-get-variables () 
    328   (plcmp-get-words-by-face 'font-lock-variable-name-face)) 
    329  
    330 (defun plcmp-get-functions () 
    331   (remove-if (lambda (s) (member s plcmp-using-modules)) 
    332              (plcmp-get-words-by-face 'font-lock-function-name-face))) 
    333  
    334 (defun plcmp-get-hashes () 
    335   (plcmp-get-words-by-face 'cperl-hash-face)) 
    336  
    337 (defun plcmp-get-arrays () 
    338   (plcmp-get-words-by-face 'cperl-array-face)) 
    339  
    340 ;;; this code Stolen from anything-dabbrev-expand.el 
    341 ;;; written by rubikitch 
    342 (defun plcmp-get-buffer-dabbrev-expansions (initial-input &optional all) 
     642(defun plcmp-get-words-by-face-internal (struct face &optional buffer) 
     643  (plcmp-with-completion-data-slots struct 
     644      (current-buffer) 
     645    (let ((buffer (or buffer current-buffer))) 
     646      (with-current-buffer buffer 
     647        (plcmp-get-words-by-face face))))) 
     648 
     649(defun plcmp-get-buffer-variables (struct) 
     650  (plcmp-with-completion-data-slots struct 
     651      (current-buffer initial-input) 
     652    (with-current-buffer current-buffer 
     653      (plcmp-fillter-and-add-metadata 
     654       (plcmp-get-words-by-face-internal struct 'font-lock-variable-name-face) 
     655       initial-input 
     656       plcmp-display-format-variables)))) 
     657 
     658(defun plcmp-get-buffer-functions (struct &optional buffer) 
     659  (plcmp-with-completion-data-slots struct 
     660      (current-buffer using-modules initial-input) 
     661    (let ((buffer (or buffer current-buffer))) 
     662      (with-current-buffer buffer 
     663        (let ((los (remove-if (lambda (s) (member s using-modules)) 
     664                              (plcmp-get-words-by-face-internal struct 'font-lock-function-name-face)))) 
     665          (plcmp-fillter-and-add-metadata los initial-input plcmp-display-format-functions)))))) 
     666 
     667;; this code Stolen from anything-dabbrev-expand.el 
     668;; written by rubikitch 
     669(defun plcmp-buffer-dabbrev-expansions (initial-input &optional all) 
    343670  (let ((dabbrev-check-other-buffers all)) 
    344     (when (>= (length initial-input) plcmp-buffer-dabbrev-expansions-number) 
    345       (dabbrev--reset-global-variables) 
    346       (dabbrev--find-all-expansions initial-input nil)))) 
     671    (dabbrev--reset-global-variables) 
     672    (dabbrev--find-all-expansions initial-input nil))) 
     673 
     674(defun plcmp-get-buffer-dabbrevs (struct) 
     675  (plcmp-with-completion-data-slots struct 
     676      (initial-input current-buffer) 
     677    (let ((dabbrevs (with-current-buffer current-buffer 
     678                      (when (>= (length initial-input) plcmp-buffer-dabbrev-expansions-number) 
     679                        (let ((dabbrev-abbrev-char-regexp (if  (and (not (null plcmp-dabbrev-abbrev-char-regexp)) 
     680                                                                    (not (string-equal "" plcmp-dabbrev-abbrev-char-regexp))) 
     681                                                              plcmp-dabbrev-abbrev-char-regexp 
     682                                                            dabbrev-abbrev-char-regexp)) 
     683                              (initial-input (if (equal "" initial-input) "" (substring initial-input 0 -1)))) ;include initial-input 
     684                          (plcmp-buffer-dabbrev-expansions initial-input)))))) 
     685      (plcmp-fillter-and-add-metadata dabbrevs initial-input plcmp-display-format-dabbrev-expansions)))) 
     686 
     687;;; other buffer's functions, variables 
     688(defun plcmp-get-other-perl-buffer-internal (struct face display-format) 
     689  (plcmp-with-completion-data-slots struct 
     690      (current-buffer other-perl-buffers initial-input) 
     691    (let ((perl-bufs other-perl-buffers ) 
     692          (ret nil) 
     693          (count 0)) 
     694      (dolist (buffer perl-bufs) 
     695        (if (= count plcmp-get-words-other-perl-buf-limit-number) 
     696            (return) 
     697          (let* ((display (concat display-format " *" (buffer-name buffer) "*")) 
     698                 (los (plcmp-get-words-by-face-internal struct face buffer)) 
     699                 (los (plcmp-fillter-and-add-metadata los initial-input display))) 
     700            (setq ret (nconc los ret)) 
     701            (incf count)))) 
     702      ret))) 
     703 
     704(defun plcmp-get-other-perl-buffer-functions (struct) 
     705  (plcmp-get-other-perl-buffer-internal struct 'font-lock-function-name-face plcmp-display-format-functions)) 
     706 
     707(defun plcmp-get-other-perl-buffer-variables (struct) 
     708  (plcmp-get-other-perl-buffer-internal struct 'font-lock-variable-name-face plcmp-display-format-variables)) 
     709 
     710;;; module 
     711(defun plcmp-get-installed-modules (struct) 
     712  (plcmp-with-completion-data-slots struct 
     713      (installed-modules initial-input) 
     714    (plcmp-fillter-and-add-metadata installed-modules initial-input plcmp-display-format-installed-modules))) 
     715 
     716(defun plcmp-get-methods (struct modulename) 
     717  (plcmp-with-completion-data-slots struct 
     718      (current-buffer initial-input) 
     719    (let* ((modules-methods-alist (plcmp-get-modules-methods-alist struct)) 
     720           (methods (assoc-default modulename modules-methods-alist))) 
     721      (plcmp-fillter-and-add-metadata methods initial-input modulename)))) 
     722 
     723(defun plcmp-get-all-methods (struct) 
     724  (plcmp-with-completion-data-slots struct 
     725      (initial-input) 
     726    (let ((modules-methods-alist (plcmp-get-modules-methods-alist struct))) 
     727      (loop for (module-name . methods) in modules-methods-alist 
     728            nconc (plcmp-fillter-and-add-metadata methods initial-input module-name))))) 
     729 
     730;; TODO fname 
     731(defun plcmp-get-cands-using-modules (struct) 
     732  (plcmp-with-completion-data-slots struct 
     733      (using-modules initial-input) 
     734    (plcmp-fillter-and-add-metadata using-modules initial-input plcmp-display-format-using-modules))) 
     735 
     736(defun plcmp-get-builtin-functions (struct) 
     737  (plcmp-with-completion-data-slots struct 
     738      (initial-input) 
     739    (plcmp-fillter-and-add-metadata plcmp-builtin-functions initial-input plcmp-display-format-builtin-functions))) 
     740 
     741(defun plcmp-get-builtin-variables (struct) 
     742  (plcmp-with-completion-data-slots struct 
     743      (initial-input) 
     744    (plcmp-fillter-and-add-metadata plcmp-builtin-variables initial-input plcmp-display-format-builtin-variables))) 
     745 
     746(defun plcmp-build-candidates (struct) 
     747  (plcmp-with-completion-data-slots struct 
     748      (state current-object obj-instance-of-module-maybe-alist 
     749             using-modules) 
     750    (let* ((module-name (or (assoc-default current-object obj-instance-of-module-maybe-alist) ;e.x, $ua = LWP::UserAgent->new(); $ua->`!!' 
     751                            (find current-object using-modules :test 'string-equal)))) ; e.x, LWP::UserAgent->`!!' 
     752      (cond 
     753       ;; methods 
     754       ((and (eq state 'methods) 
     755             module-name) 
     756        ;; match only method name 
     757        (setq plcmp-metadata-matcher plcmp-metadata-matcher-re) 
     758        (plcmp-get-methods struct module-name)) 
     759       ;; $self 
     760       ((eq state 'self) 
     761        (nconc 
     762         (plcmp-get-buffer-functions struct) ; dabbrev functions 
     763         (plcmp-get-all-methods struct)      ; methods 
     764         (plcmp-get-buffer-dabbrevs struct)  ;dabbrev-expansions 
     765         )) 
     766       ;; all methods 
     767       ;; モジュールが特定できなかったケース 
     768       ((eq state 'methods) 
     769        (nconc 
     770         (plcmp-get-all-methods struct)       ; all methods 
     771         (plcmp-get-buffer-dabbrevs struct))) ; dabbrev-expansions 
     772       ;; installed-modules 
     773       ((eq state 'installed-modules) 
     774        (plcmp-get-installed-modules struct)) 
     775       ;; using-modules ;TODO 
     776       ((eq state 'using-modules) 
     777        (plcmp-get-cands-using-modules struct)) 
     778       ;; dabbrev variables 
     779       ((eq state 'dabbrev-variables) 
     780        (plcmp-get-buffer-variables struct)) 
     781       ;; dabbrev functions 
     782       ((eq state 'dabbrev-functions) 
     783        (plcmp-get-buffer-functions struct)) 
     784       ;; builtin-functions 
     785       ((eq state 'builtin-functions) 
     786        (plcmp-get-builtin-functions struct)) 
     787       ;; builtin-variables 
     788       ((eq state 'builtin-variables) 
     789        (plcmp-get-builtin-variables struct)) 
     790       ;; globals 
     791       ((eq state 'globals) 
     792        (nconc 
     793         (plcmp-get-buffer-functions struct)    ; dabbrev-functions 
     794         (plcmp-get-buffer-variables struct)    ; dabbrev-variables 
     795         (plcmp-get-buffer-dabbrevs struct)     ; dabbrev-expansions 
     796         (plcmp-get-builtin-functions struct)   ; builtin-functions 
     797         (plcmp-get-builtin-variables struct)   ; builtin-variables 
     798         (plcmp-get-cands-using-modules struct) ; using-modules 
     799         (plcmp-get-other-perl-buffer-functions struct) ; dabbrev-functions other perl buffer 
     800         (plcmp-get-other-perl-buffer-variables struct) ; dabbrev-variables other perl buffer 
     801         )) 
     802       ;; all 
     803       (t 
     804        (nconc 
     805         (plcmp-get-cands-using-modules struct) ; using-modules 
     806         (plcmp-get-all-methods struct) 
     807         (plcmp-get-buffer-functions struct)  ; dabbrev-functions 
     808         (plcmp-get-buffer-variables struct)  ; dabbrev-variables 
     809         (plcmp-get-buffer-dabbrevs struct)   ; dabbrev-expansions 
     810         (plcmp-get-builtin-functions struct) ; builtin-functions 
     811         (plcmp-get-builtin-variables struct) ; builtin-variables 
     812         (plcmp-get-other-perl-buffer-functions struct) ; dabbrev-functions other perl buffer 
     813         (plcmp-get-other-perl-buffer-variables struct) ; dabbrev-variables other perl buffer 
     814         )) 
     815       )))) 
     816 
     817 
     818;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
     819;;;; anything 
     820;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
     821;;; actions 
     822(defun plcmp-insert (candidate) 
     823  (plcmp-with-completion-data-slots plcmp-data 
     824      (initial-input) 
     825    (delete-backward-char (length initial-input)) 
     826    (insert (plcmp-get-real-candidate candidate)))) 
     827 
     828(defun plcmp-insert-modulename (candidate) 
     829  (plcmp-with-completion-data-slots plcmp-data 
     830      (initial-input) 
     831    (delete-backward-char (length initial-input)) 
     832    (insert (plcmp-get-metadate-candidate candidate)))) 
     833 
     834(defun plcmp-get-builtin-by-candidate-internal (candidate display-format) 
     835  (let ((metadata (plcmp-get-metadate-candidate candidate))) 
     836    (when (string-equal metadata display-format) 
     837      (plcmp-get-real-candidate candidate)))) 
     838 
     839(defun plcmp-get-builtin-variable-by-candidate (candidate) 
     840  (plcmp-get-builtin-by-candidate-internal candidate plcmp-display-format-builtin-variables)) 
     841 
     842(defun plcmp-get-builtin-function-by-candidate (candidate) 
     843  (plcmp-get-builtin-by-candidate-internal candidate plcmp-display-format-builtin-functions)) 
     844 
     845(defun plcmp-dabbrev-variables-p (candidate) 
     846  (let ((metadata (plcmp-get-metadate-candidate candidate))) 
     847    (string-equal metadata plcmp-display-format-variables))) 
     848 
     849(defun plcmp-get-buffer-dabbrev-word-by-candidate (struct candidate) 
     850  (plcmp-with-completion-data-slots struct 
     851      (current-buffer) 
     852    (let ((metadata (plcmp-get-metadate-candidate candidate))) 
     853      (when (string-equal metadata plcmp-display-format-dabbrev-expansions) 
     854        (values current-buffer 
     855                (plcmp-get-real-candidate candidate)))))) 
     856 
     857(defun plcmp-get-buffer-face-word-internal (candidate display-format) 
     858  (let ((metadata (plcmp-get-metadate-candidate candidate))) 
     859    (when (string-equal metadata display-format) 
     860      (plcmp-get-real-candidate candidate)))) 
     861 
     862(defun plcmp-get-buffer-function-by-candidate (candidate) 
     863  (plcmp-get-buffer-face-word-internal candidate plcmp-display-format-functions)) 
     864 
     865(defun plcmp-get-buffer-variable-by-candidate (candidate) 
     866  (plcmp-get-buffer-face-word-internal candidate plcmp-display-format-variables)) 
     867 
     868(defun plcmp-get-dabbrev-other-perl-buffer-internal (candidate display-format) 
     869  "return values '(buffer word) or nil" 
     870  (let ((metadata (plcmp-get-metadate-candidate candidate)) 
     871        (re (rx-to-string `(and ,display-format 
     872                                space 
     873                                "*" 
     874                                (group (0+ not-newline)) 
     875                                "*" 
     876                                line-end)))) 
     877    (when (string-match re metadata) 
     878      (values (match-string-no-properties 1 metadata) ;buffer 
     879              (plcmp-get-real-candidate candidate))))) 
     880 
     881(defun plcmp-get-dabbrev-function-other-perl-buffer-by-candidate (candidate) 
     882  (plcmp-get-dabbrev-other-perl-buffer-internal candidate 
     883                                                plcmp-display-format-functions)) 
     884 
     885(defun plcmp-get-dabbrev-variable-other-perl-buffer-by-candidate (candidate) 
     886  (plcmp-get-dabbrev-other-perl-buffer-internal candidate 
     887                                                plcmp-display-format-variables)) 
     888 
     889(defun plcmp-get-module-and-method-by-candidate (struct candidate) 
     890  "return values (list module method) or nil" 
     891  (plcmp-with-completion-data-slots struct 
     892      (using-modules) 
     893    (let ((module (plcmp-get-metadate-candidate candidate)) 
     894          (method (plcmp-get-real-candidate candidate))) 
     895      (when (and (plcmp-module-p module) 
     896                 (member module using-modules) 
     897                 (plcmp-perl-identifier-p method)) 
     898        (values module method))))) 
     899 
     900(defun plcmp-fontify-re-search-forward (regexp) 
     901  (when (re-search-forward regexp nil t) 
     902    (let ((beg (match-beginning 1)) 
     903          (end (match-end 1))) 
     904      (when (and beg end) 
     905        (if (overlayp plcmp-overlay) 
     906            (move-overlay plcmp-overlay beg end (current-buffer)) 
     907          (setq plcmp-overlay (make-overlay beg end))) 
     908        (overlay-put plcmp-overlay 'face plcmp-search-match-face))))) 
     909 
     910(defun plcmp-visit-and-re-search-forward (regexp buffer-name) 
     911  (pop-to-buffer buffer-name) 
     912  (with-current-buffer (get-buffer buffer-name) 
     913    (if (plcmp-fontify-re-search-forward regexp) 
     914        (recenter 2) 
     915      (goto-char (point-min)) 
     916      (plcmp-fontify-re-search-forward regexp) 
     917      (recenter 2)))) 
     918 
     919(defun plcmp-re-search-forward-as-cperl-mode (regexp buffer-name) 
     920  (let ((saved-major-mode major-mode)) 
     921    (unwind-protect 
     922        (progn 
     923          (cperl-mode) 
     924          (plcmp-visit-and-re-search-forward regexp buffer-name)) 
     925      (when (functionp saved-major-mode) 
     926        (funcall saved-major-mode))))) 
     927 
     928(defun plcmp-open-perldoc (arg type &optional pop-to-buffer) 
     929  "open perldoc. 
     930return buffer" 
     931  (let* ((process-environment (copy-sequence process-environment)) 
     932         (coding-system-for-read (if default-enable-multibyte-characters 
     933                                     locale-coding-system 
     934                                   'raw-text-unix)) 
     935         (program (case type 
     936                    (var "perldoc perlvar") 
     937                    (func "perldoc -f") 
     938                    (module "perldoc"))) 
     939         (command (if (eq type 'var) 
     940                      program 
     941                    (concat program " " (shell-quote-argument arg))))) 
     942    (require 'env) 
     943    (setenv "TERM" "dumb") ; problem when (equal (getenv "TERM") "xterm-color") 
     944 
     945    (save-window-excursion 
     946      (unless (eq real-last-command 'plcmp-anything-execute-persistent-action) 
     947        (shell-command command plcmp-perldoc-output-buf-name))) 
     948    (let ((buf (get-buffer plcmp-perldoc-output-buf-name))) 
     949      (if pop-to-buffer 
     950          (pop-to-buffer buf) 
     951        (switch-to-buffer buf)) 
     952      ;; return buffer 
     953      buf))) 
     954 
     955;; TODO 
     956(defun plcmp-perldoc (struct candidate &optional pop-to-buffer) 
     957  (plcmp-acond 
     958    ;; builtin-variables 
     959    ((plcmp-get-builtin-variable-by-candidate candidate) 
     960     (let ((buffer (plcmp-open-perldoc it 'var)) 
     961           (re (rx-to-string `(and bol (= 4 space) 
     962                                   (group (eval ,it)) 
     963                                   (syntax whitespace))))) 
     964       (plcmp-visit-and-re-search-forward re buffer))) 
     965    ;; builtin-function 
     966    ((plcmp-get-builtin-function-by-candidate candidate) 
     967     (plcmp-open-perldoc it 'func)) 
     968    ;; buffer dabbrev 
     969    ((plcmp-get-buffer-dabbrev-word-by-candidate struct candidate) 
     970     (multiple-value-bind (buffer-name word) it 
     971       (let ((re (rx-to-string `(and symbol-start (group (eval ,word)) symbol-end)))) 
     972         (plcmp-visit-and-re-search-forward re buffer-name)))) 
     973    ;; dabbrev function current buffer 
     974    ((plcmp-get-buffer-function-by-candidate candidate) 
     975     (plcmp-with-completion-data-slots struct 
     976         (current-buffer) 
     977       (let ((re (rx-to-string `(and symbol-start (group (eval ,it)) symbol-end)))) 
     978         (plcmp-visit-and-re-search-forward re current-buffer)))) 
     979    ;; dabbrev variable current buffer 
     980    ((plcmp-get-buffer-variable-by-candidate candidate) 
     981     (plcmp-with-completion-data-slots struct 
     982         (current-buffer) 
     983       (let ((re (rx-to-string `(and (group (eval ,it)) symbol-end)))) 
     984         (plcmp-visit-and-re-search-forward re current-buffer)))) 
     985    ;; dabbrev function other perl buffer 
     986    ((plcmp-get-dabbrev-function-other-perl-buffer-by-candidate candidate) 
     987     (multiple-value-bind (buffer-name func-name) it 
     988       (let ((re (rx-to-string `(and symbol-start (group (eval ,func-name)) symbol-end)))) 
     989         (plcmp-visit-and-re-search-forward re buffer-name)))) 
     990    ;; dabbrev variable other perl buffer 
     991    ((plcmp-get-dabbrev-variable-other-perl-buffer-by-candidate candidate) 
     992     (multiple-value-bind (buffer-name var-name) it 
     993       (let ((re (rx-to-string `(and (group (eval ,var-name)) symbol-end)))) 
     994         (plcmp-visit-and-re-search-forward re buffer-name)))) 
     995    ;; method 
     996    ((plcmp-get-module-and-method-by-candidate struct candidate) 
     997     (multiple-value-bind (module method) it ;when bind, IT must be list of string '(module method) 
     998       (let ((buffer (plcmp-open-perldoc module 'module)) 
     999             (re (rx-to-string `(and symbol-start (group (eval ,method)) symbol-end)))) 
     1000         (plcmp-re-search-forward-as-cperl-mode re buffer)))) 
     1001    ;; otherwise 
     1002    (t 
     1003     (let* ((modname (if (plcmp-module-p (plcmp-get-metadate-candidate candidate)) 
     1004                         (plcmp-get-metadate-candidate candidate) 
     1005                       (plcmp-get-real-candidate candidate)))) 
     1006       (plcmp-open-perldoc modname 'module pop-to-buffer))))) 
     1007 
     1008 
     1009(defun plcmp-open-module-file (struct candidate) 
     1010  (condition-case e 
     1011      (let ((modulename (plcmp-get-modulename-candidate struct candidate))) 
     1012        (unless (plcmp-module-p modulename) 
     1013          (error "invild format: %s" modulename)) 
     1014        (let* ((path (shell-command-to-string (concat "perldoc -l " modulename))) 
     1015               (path (plcmp-trim path))) 
     1016          (if (file-exists-p path) 
     1017              (find-file path) 
     1018            (error "can't find module %s" path)))) 
     1019    (message "%s" (plcmp-log "%s" (error-message-string e))))) 
     1020 
     1021;;; match 
     1022(defcustom plcmp-match-any-greedy t 
     1023  "non-nilだとパターンをスペースで区切って候補を絞り込めるようになる" 
     1024  :type 'boolean 
     1025  :group 'perl-completion) ;TODO: varname 
     1026(defvar plcmp-match-last-re "") 
     1027(defvar plcmp-match-last-anything-pattern "") 
     1028 
     1029(defun plcmp-match (candidate) 
     1030  (cond 
     1031   ((string-equal plcmp-anything-pattern 
     1032                  plcmp-match-last-anything-pattern) 
     1033    (string-match plcmp-match-last-re candidate)) 
     1034   (t 
     1035    (let* ((re (replace-regexp-in-string 
     1036               "[ \t]+" ".*?" 
     1037               (plcmp-trim plcmp-anything-pattern))) 
     1038           (re (concat plcmp-metadata-matcher re))) 
     1039      (setq plcmp-match-last-re re 
     1040            plcmp-match-last-anything-pattern plcmp-anything-pattern) 
     1041      (string-match re candidate))))) 
     1042 
     1043;;; keymap 
     1044(defvar plcmp-anything-map 
     1045  (let ((map (copy-keymap minibuffer-local-map))) 
     1046    ;; persistent-action 
     1047    (define-key map (kbd "C-z")  'plcmp-anything-execute-persistent-action) 
     1048 
     1049    ;; call action with selection 
     1050    ;;(define-key map (kbd "M") 'plcmp-action-insert-modulename) 
     1051    (define-key map (kbd "D") 'plcmp-action-perldoc) 
     1052    (define-key map (kbd "O") 'plcmp-action-open-module-file) 
     1053 
     1054    ;; JKL, for reading document 
     1055    (define-key map (kbd "J") 'scroll-other-window) 
     1056    (define-key map (kbd "K") 'scroll-other-window-down) 
     1057    (define-key map (kbd "L") 'plcmp-anything-execute-persistent-action) 
     1058 
     1059    (define-key map (kbd "M-C-v") 'scroll-other-window) 
     1060    (define-key map (kbd "M-C-S-v") 'scroll-other-window-down) 
     1061     
     1062    ;; Stolen from anything-config.el 
     1063    (define-key map (kbd "<down>")  'plcmp-anything-next-line) 
     1064    (define-key map (kbd "<up>")    'plcmp-anything-previous-line) 
     1065    (define-key map (kbd "C-n")     'plcmp-anything-next-line) 
     1066    (define-key map (kbd "C-p")     'plcmp-anything-previous-line) 
     1067    (define-key map (kbd "<prior>") 'plcmp-anything-previous-page) 
     1068    (define-key map (kbd "<next>")  'plcmp-anything-next-page) 
     1069    (define-key map (kbd "M-v")     'plcmp-anything-previous-page) 
     1070    (define-key map (kbd "C-v")     'plcmp-anything-next-page) 
     1071    ;;(define-key map (kbd "<right>") 'plcmp-anything-next-source) 
     1072    (define-key map "\M-\C-f" 'plcmp-anything-next-source) 
     1073    (define-key map "\M-\C-b"  'plcmp-anything-previous-source) 
     1074    (define-key map (kbd "<RET>")   'plcmp-anything-exit-minibuffer) 
     1075    (define-key map (kbd "C-1")     'plcmp-anything-select-with-digit-shortcut) 
     1076    (define-key map (kbd "C-2")     'plcmp-anything-select-with-digit-shortcut) 
     1077    (define-key map (kbd "C-3")     'plcmp-anything-select-with-digit-shortcut) 
     1078    (define-key map (kbd "C-4")     'plcmp-anything-select-with-digit-shortcut) 
     1079    (define-key map (kbd "C-5")     'plcmp-anything-select-with-digit-shortcut) 
     1080    (define-key map (kbd "C-6")     'plcmp-anything-select-with-digit-shortcut) 
     1081    (define-key map (kbd "C-7")     'plcmp-anything-select-with-digit-shortcut) 
     1082    (define-key map (kbd "C-8")     'plcmp-anything-select-with-digit-shortcut) 
     1083    (define-key map (kbd "C-9")     'plcmp-anything-select-with-digit-shortcut) 
     1084    (define-key map (kbd "<tab>")   'plcmp-anything-select-action) 
     1085    (defalias 'plcmp-anything-next-history-element     'next-history-element) 
     1086    (defalias 'plcmp-anything-previous-history-element 'previous-history-element) 
     1087    (define-key map (kbd "M-p")     'plcmp-anything-previous-history-element) 
     1088    (define-key map (kbd "M-n")     'plcmp-anything-next-history-element) 
     1089    (define-key map (kbd "C-s")     'plcmp-anything-isearch) 
     1090    (define-key map (kbd "C-r")     'undefined) 
     1091    map)) 
     1092 
     1093(defvar plcmp-anything-isearch-map 
     1094  (let ((map (copy-keymap (current-global-map)))) 
     1095    (define-key map (kbd "<return>")    'plcmp-anything-isearch-default-action) 
     1096    (define-key map (kbd "<tab>")       'plcmp-anything-isearch-select-action) 
     1097    (define-key map (kbd "C-g")         'plcmp-anything-isearch-cancel) 
     1098    (define-key map (kbd "C-s")         'plcmp-anything-isearch-again) 
     1099    (define-key map (kbd "C-r")         'undefined) 
     1100    (define-key map (kbd "<backspace>") 'plcmp-anything-isearch-delete) 
     1101    ;; add printing chars 
     1102    (let ((i ?\s)) 
     1103      (while (< i 256) 
     1104        (define-key map (vector i) 'plcmp-anything-isearch-printing-char) 
     1105        (setq i (1+ i)))) 
     1106    map)) 
     1107 
     1108;;; sources 
     1109 
     1110 
     1111(defvar plcmp-anything-type-attributes 
     1112  `((plcmp 
     1113     (action . (("Insert" . plcmp-insert) 
     1114                ("Open module file" . (lambda (candidate) 
     1115                                        (plcmp-open-module-file plcmp-data candidate))) 
     1116                ("Perldoc" . (lambda (candidate) 
     1117                               (plcmp-perldoc plcmp-data candidate))) 
     1118                )) 
     1119     (persistent-action . (lambda (candidate) 
     1120                            (plcmp-perldoc plcmp-data candidate)))))) 
     1121 
     1122(defvar plcmp-anything-c-source-smart-complete 
     1123  `((name . "perl completion") 
     1124    (type . plcmp) 
     1125    (init . (lambda () 
     1126              (plcmp-initialize plcmp-data))) 
     1127    (candidates . (lambda () 
     1128                    (plcmp-build-candidates plcmp-data))) 
     1129    (cache) 
     1130    (match . (plcmp-match)))) 
     1131 
     1132(defvar plcmp-anything-source-builtin-functions 
     1133  `((name . "builtin-functions") 
     1134    (type . plcmp) 
     1135    (init . (lambda () 
     1136              (plcmp-initialize plcmp-data) 
     1137              (plcmp-with-completion-data-slots plcmp-data 
     1138                  (initial-input state) 
     1139                (setf initial-input "" 
     1140                      state 'builtin-functions)))) 
     1141    (candidates . (lambda () 
     1142                    (plcmp-build-candidates plcmp-data))) 
     1143    (match . (plcmp-match)))) 
     1144 
     1145(defvar plcmp-anything-source-builtin-variables 
     1146  `((name . "builtin-variables") 
     1147    (type . plcmp) 
     1148    (init . (lambda () 
     1149              (plcmp-initialize plcmp-data) 
     1150              (plcmp-with-completion-data-slots plcmp-data 
     1151                  (initial-input state) 
     1152                (setf initial-input "" 
     1153                      state 'builtin-variables)))) 
     1154    (candidates . (lambda () 
     1155                    (plcmp-build-candidates plcmp-data))) 
     1156    (match . (plcmp-match)))) 
     1157 
     1158(defvar plcmp-anything-source-using-modules 
     1159  `((name . "using-modules") 
     1160    (type . plcmp) 
     1161    (init . (lambda () 
     1162              (plcmp-initialize plcmp-data) 
     1163              (plcmp-with-completion-data-slots plcmp-data 
     1164                  (initial-input state) 
     1165                (setf initial-input "" 
     1166                      state 'using-modules)))) 
     1167    (candidates . (lambda () 
     1168                    (plcmp-build-candidates plcmp-data))) 
     1169    (match . (plcmp-match)))) 
     1170 
     1171(defvar plcmp-anything-source-installed-modules 
     1172  `((name . "installed-modules") 
     1173    (type . plcmp) 
     1174    (init . (lambda () 
     1175              (plcmp-initialize plcmp-data) 
     1176              (plcmp-with-completion-data-slots plcmp-data 
     1177                  (initial-input state) 
     1178                (setf state 'installed-modules 
     1179                      initial-input "")))) 
     1180    (candidates . (lambda () 
     1181                    (plcmp-build-candidates plcmp-data))) 
     1182    (match . (plcmp-match)))) 
     1183 
     1184(defvar plcmp-anything-source-all 
     1185  `((name . "installed-modules") 
     1186    (type . plcmp) 
     1187    (init . (lambda () 
     1188              (plcmp-initialize plcmp-data) 
     1189              (plcmp-with-completion-data-slots plcmp-data 
     1190                  (initial-input state) 
     1191                (setf state 'all 
     1192                      initial-input "")))) 
     1193    (candidates . (lambda () 
     1194                    (plcmp-build-candidates plcmp-data))) 
     1195    (match . (plcmp-match)))) 
     1196 
     1197(defun plcmp-smart-complete () 
     1198  (interactive) 
     1199  (let ((plcmp-anything-sources (list plcmp-anything-c-source-smart-complete))) 
     1200    (condition-case e 
     1201        (plcmp-anything) 
     1202      (message "%s" (error-message-string e))))) 
     1203 
     1204(defun plcmp-installed-modules-complete () 
     1205  (interactive) 
     1206  (let ((plcmp-anything-sources (list plcmp-anything-source-installed-modules))) 
     1207    (plcmp-anything))) 
     1208 
     1209(defun plcmp-builtin-function-complete () 
     1210  (interactive) 
     1211  (let ((plcmp-anything-sources (list plcmp-anything-source-builtin-functions))) 
     1212    (plcmp-anything))) 
     1213 
     1214(defun plcmp-builtin-variables-complete () 
     1215  (interactive) 
     1216  (let ((plcmp-anything-sources (list plcmp-anything-source-builtin-variables))) 
     1217    (plcmp-anything))) 
     1218 
     1219(defun plcmp-search-word-at-point () 
     1220  (interactive) 
     1221  (let ((plcmp-anything-sources (list plcmp-anything-source-all)) 
     1222        (word (concat (or (cperl-word-at-point) "") " ")) 
     1223        (plcmp-metadata-matcher-re "")) 
     1224    (plcmp-anything word))) 
     1225 
     1226(defun plcmp-using-modules-complete () 
     1227  (interactive) 
     1228  (let ((plcmp-anything-sources (list plcmp-anything-source-using-modules))) 
     1229    (plcmp-anything))) 
     1230 
     1231(defun plcmp-reset () 
     1232  (interactive) 
     1233  (unload-feature 'perl-completion t) 
     1234  (require 'perl-completion nil t)) 
     1235 
     1236(defun plcmp-clear-all-cache () 
     1237  (interactive) 
     1238  (ignore-errors 
     1239    (plcmp-with-completion-data-slots plcmp-data 
     1240        (cache-installed-modules) 
     1241      (setf plcmp-last-using-modules nil 
     1242            plcmp-modules-methods-alist nil 
     1243            cache-installed-modules nil) 
     1244      (kill-buffer plcmp-installed-modules-buf-name) 
     1245      (plcmp-send-command-get-installed-modules)))) 
     1246       
     1247 
     1248;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
     1249;;;; Commands 
     1250;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
     1251 
     1252;;; anything 
     1253(defun plcmp-call-action-by-action-name (action-name) 
     1254  (setq plcmp-anything-saved-selection (plcmp-anything-get-selection)) 
     1255  (unless plcmp-anything-saved-selection 
     1256    (error "Nothing is selected.")) 
     1257  (let ((action (cdr (assoc action-name (plcmp-anything-get-action))))) 
     1258    (if action 
     1259        (setq plcmp-anything-saved-action action 
     1260              plcmp-anything-saved-sources plcmp-anything-sources) 
     1261      (error "no action %s" action-name)) 
     1262    (plcmp-anything-exit-minibuffer))) 
     1263 
     1264(defun plcmp-action-insert-modulename () 
     1265  (interactive) 
     1266  (plcmp-call-action-by-action-name "Insert modulename")) 
     1267 
     1268(defun plcmp-action-open-module-file () 
     1269  (interactive) 
     1270  (plcmp-call-action-by-action-name "Open module file")) 
     1271 
     1272(defun plcmp-action-perldoc () 
     1273  (interactive) 
     1274  (plcmp-call-action-by-action-name "Perldoc")) 
     1275 
     1276 
     1277;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
     1278;;;; Mode 
     1279;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
     1280(defmacro plcmp-set-key (key binding) 
     1281  `(define-key plcmp-mode-map ,key ,binding)) 
     1282 
     1283(defvar plcmp-mode-map (make-keymap)) 
     1284;;; setup 
     1285(plcmp-set-key (kbd "M-TAB") 'plcmp-smart-complete) 
     1286(plcmp-set-key (kbd "C-RET") 'plcmp-smart-complete) 
     1287(plcmp-set-key (kbd "C-<return>") 'plcmp-smart-complete) 
     1288(plcmp-set-key (kbd "C-c f") 'plcmp-builtin-function-complete) 
     1289(plcmp-set-key (kbd "C-c v") 'plcmp-builtin-variables-complete) 
     1290(plcmp-set-key (kbd "C-c i") 'plcmp-installed-modules-complete) 
     1291(plcmp-set-key (kbd "C-c u") 'plcmp-using-modules-complete) 
     1292(plcmp-set-key (kbd "C-c c") 'plcmp-clear-all-cache) 
     1293(plcmp-set-key (kbd "C-c s") 'plcmp-search-word-at-point) 
     1294 
     1295 
     1296(defun plcmp-mode-init () 
     1297  ;;初回起動時 
     1298  (unless (buffer-live-p (get-buffer plcmp-installed-modules-buf-name)) 
     1299    (plcmp-send-command-get-installed-modules))) 
     1300 
     1301(define-minor-mode perl-completion-mode "" nil " PLCompletion" plcmp-mode-map (plcmp-mode-init)) 
     1302 
    3471303 
    3481304;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    349 ;;; Candidates 
     1305;;; compatibility anything 
    3501306;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    351 (defsubst plcmp-build-display-candidate (metadata str) 
    352   (concat "[" metadata "]" " | " str)) 
    353  
    354 (defsubst plcmp-get-real-candidate (display-candidate) 
    355   "return string" 
    356   (if (string-match (concat "^\\[[^\]\n]*\\] | " 
    357                               "\\(.*\\)") 
    358                     display-candidate) 
    359       (match-string 1 display-candidate) 
    360     display-candidate)) ;TODO? 
    361  
    362 (defsubst plcmp-get-metadate-candidate (display-candidate) 
    363   "return string" 
    364   (if (string-match "^\\[\\([^\]\n]*\\)\\] | " display-candidate) 
    365       (match-string 1 display-candidate) 
    366     "")) 
    367  
    368 (defun plcmp-get-modulename-candidate (display-candidate) 
    369   (let ((metadata (plcmp-get-metadate-candidate display-candidate))) 
    370     (cond 
    371      ((string-equal metadata plcmp-display-format-installed-modules) 
    372       (plcmp-get-real-candidate display-candidate)) 
    373      ((string-equal metadata plcmp-display-format-using-modules) 
    374       (plcmp-get-real-candidate display-candidate)) 
    375      (t 
    376       (plcmp-get-real-candidate display-candidate))))) 
    377  
    378 (defsubst plcmp-start-initial-input-p (initial-input candidate) 
    379   (let ((re (concat "^" (regexp-quote initial-input)))) 
    380     (string-match re candidate))) 
    381  
    382 (defsubst plcmp-fillter-and-add-metadata (los initial-input metadata-format) ;TODO: funcname 
    383   "return los" 
    384   (loop for str in los 
    385         with ret 
    386         do (when (and (plcmp-start-initial-input-p initial-input str) 
    387                       (not (string-equal initial-input str))) ;TODO: include initial-input? 
    388              (push (plcmp-build-display-candidate metadata-format str) ret)) 
    389         finally return ret)) 
    390  
    391 ;; was (remove-duplicates candidates :test 'string-equal :key 'plcmp-get-real-candidate) 
    392 ;; for keep order TODO: english 
    393 ;; 現在パフォーマンスの関係で使用していない TODO 
    394 (defun plcmp-remove-duplicates (candidates) 
    395   (let ((ret nil)) 
    396     (loop for candidate = (substring-no-properties (first candidates)) 
    397           for rest = (rest candidates) 
    398           always rest 
    399           do (progn 
    400                (when (not (member* candidate rest :test 'string-equal :key 'plcmp-get-real-candidate)) 
    401                  (push candidate ret)) 
    402                (setq candidates (rest candidates)))) 
    403     ret)) 
    404  
    405 (defun plcmp-build-candidates (state initial-input cur-obj cur-buf alist) 
    406   (let* ((var plcmp-cur-obj) 
    407          (modname (or (assoc-default var plcmp-obj-instance-of-module-maybe-alist) ;e.x, $ua = LWP::UserAgent->new(); $ua->`!!' 
    408                       (find var plcmp-using-modules :test 'string-equal)))) ; e.x, LWP::UserAgent->`!!' 
    409     (cond 
    410      ;; methods 
    411      ((and (eq state 'methods) 
    412            modname) 
    413       (let ((methods (assoc-default modname alist))) 
    414         (loop for method in methods 
    415               with ret 
    416               do (when (plcmp-start-initial-input-p initial-input method) 
    417                    (push (plcmp-build-display-candidate modname method) ret)) 
    418               finally return ret))) 
    419  
    420      ;; $self 
    421      ((eq state 'self) 
    422       (let ((ret nil)) 
    423         ;; dabbrev functions 
    424         (with-current-buffer cur-buf 
    425           (let* ((los (plcmp-get-functions)) 
    426                  (filtered (plcmp-fillter-and-add-metadata los initial-input plcmp-display-format-functions))) 
    427             (setq ret (append filtered ret)))) 
    428         ;; methods 
    429         (let ((all-methods (loop for lst in alist 
    430                                  for modname = (first lst) 
    431                                  for los = (rest lst) 
    432                                  with ret 
    433                                  do (loop for s in los 
    434                                           do (when (plcmp-start-initial-input-p initial-input s) 
    435                                                (push (plcmp-build-display-candidate modname s) ret))) 
    436                                  finally return ret))) 
    437           (setq ret (append ret all-methods))) 
    438         ;;dabbrev-expansions 
    439         (with-current-buffer cur-buf 
    440           (let* ((los (plcmp-get-buffer-dabbrev-expansions initial-input)) 
    441                  (los (plcmp-fillter-and-add-metadata los "" plcmp-display-format-dabbrev-expansions))) 
    442             (setq ret (nconc ret los)))) 
    443         )) 
    444          
    445      ;; all methods 
    446      ;; モジュールが特定できなかったケース 
    447      ((eq state 'methods) 
    448       (let ((ret nil)) 
    449         (loop for lst in alist 
    450               for modname = (first lst) 
    451               for los = (rest lst) 
    452               do (loop for s in los 
    453                        do (when (plcmp-start-initial-input-p initial-input s) 
    454                             (push (plcmp-build-display-candidate modname s) ret))) 
    455               finally return ret) 
    456         ;; dabbrev-expansions 
    457         (with-current-buffer cur-buf 
    458           (let* ((los (plcmp-get-buffer-dabbrev-expansions initial-input)) 
    459                  (los (plcmp-fillter-and-add-metadata los "" plcmp-display-format-dabbrev-expansions))) 
    460             (setq ret (nconc ret los)))))) 
    461  
    462      ;; installed-modules 
    463      ((eq state 'installed-modules) 
    464       (plcmp-fillter-and-add-metadata (plcmp-get-installed-modules) initial-input plcmp-display-format-installed-modules)) 
    465  
    466      ;; using-modules 
    467      ((eq state 'using-modules) 
    468       (plcmp-fillter-and-add-metadata plcmp-using-modules initial-input plcmp-display-format-using-modules)) 
    469  
    470      ;; dabbrev variables 
    471      ((eq state 'dabbrev-variables) 
    472       (with-current-buffer cur-buf 
    473         (let ((los (plcmp-get-variables))) 
    474           (plcmp-fillter-and-add-metadata los initial-input plcmp-display-format-variables)))) 
    475  
    476      ;; dabbrev functions 
    477      ((eq state 'dabbrev-functions) 
    478       (with-current-buffer cur-buf 
    479         (let ((los (plcmp-get-functions))) 
    480           ;;(delete-if-not (lambda (s) (plcmp-start-initial-input-p initial-input s)) los) 
    481           (plcmp-fillter-and-add-metadata los initial-input plcmp-display-format-functions) 
    482           ))) 
    483  
    484      ;; builtin-functions 
    485      ((eq state 'builtin-functions) 
    486       (plcmp-fillter-and-add-metadata plcmp-builtin-functions initial-input plcmp-display-format-builtin-functions)) 
    487  
    488      ;; builtin-variables 
    489      ((eq state 'builtin-variables) 
    490       (plcmp-fillter-and-add-metadata plcmp-builtin-variables initial-input plcmp-display-format-builtin-variables)) 
    491  
    492      ;; globals 
    493      ((eq state 'globals) 
    494       (let ((candidates nil)) 
    495         ;; dabbrev-functions 
    496         (with-current-buffer cur-buf 
    497           (let* ((los (plcmp-get-functions)) 
    498                  (los (plcmp-fillter-and-add-metadata los initial-input plcmp-display-format-functions))) 
    499             (setq candidates (nconc candidates los)))) 
    500         ;; dabbrev-variables 
    501         (with-current-buffer cur-buf 
    502           (let* ((los (plcmp-get-variables)) 
    503                  (los (plcmp-fillter-and-add-metadata los initial-input plcmp-display-format-variables))) 
    504             (setq candidates (nconc candidates los)))) 
    505         ;; dabbrev-expansions 
    506         (with-current-buffer cur-buf 
    507           (let* ((los (plcmp-get-buffer-dabbrev-expansions initial-input)) 
    508                  (los (plcmp-fillter-and-add-metadata los "" plcmp-display-format-dabbrev-expansions))) 
    509             (setq candidates (nconc candidates los)))) 
    510         ;; builtin-functions 
    511         (let ((los (plcmp-fillter-and-add-metadata plcmp-builtin-functions initial-input plcmp-display-format-builtin-functions))) 
    512           (setq candidates (append candidates los))) 
    513         ;; builtin-variables 
    514         (let ((los (plcmp-fillter-and-add-metadata plcmp-builtin-variables initial-input plcmp-display-format-builtin-variables))) 
    515           (setq candidates (append candidates los))) 
    516         ;; using-modules 
    517         (let ((los (plcmp-fillter-and-add-metadata plcmp-using-modules initial-input plcmp-display-format-using-modules))) 
    518           (setq candidates (append candidates los))) 
    519          
    520         ;; dabbrev-functions other perl buffer 
    521         (let* ((fn (lambda (buf) (string-match "\\.p[lm]$" (buffer-name buf)))) 
    522                (perl-bufs (remove-if-not fn (buffer-list))) 
    523                (perl-bufs (remove cur-buf perl-bufs)) 
    524                (count 0)) 
    525           (dolist (buffer perl-bufs) 
    526             (if (= count plcmp-get-words-other-perl-buf-limit-number) 
    527                 (return) 
    528               (with-current-buffer buffer 
    529                 (let* ((display (concat plcmp-display-format-functions " *" (buffer-name buffer) "*")) 
    530                        (los (plcmp-get-functions)) 
    531                        (los (plcmp-fillter-and-add-metadata los initial-input display))) 
    532                   (setq candidates (nconc candidates los)) 
    533                   (incf count)))))) 
    534  
    535         ;; dabbrev-variables other perl buffer 
    536         (let* ((fn (lambda (buf) (string-match "\\.p[lm]$" (buffer-name buf)))) 
    537                (perl-bufs (remove-if-not fn (buffer-list))) 
    538                (perl-bufs (remove cur-buf perl-bufs)) 
    539                (ret nil) 
    540                (count 0)) 
    541           (dolist (buffer perl-bufs ret) 
    542             (if (= count plcmp-get-words-other-perl-buf-limit-number) 
    543                 (return) 
    544               (with-current-buffer buffer 
    545                 (let* ((display (concat plcmp-display-format-variables " *" (buffer-name buffer) "*")) 
    546                        (los (plcmp-get-variables)) 
    547                        (los (plcmp-fillter-and-add-metadata los initial-input display))) 
    548                   (setq candidates (nconc candidates los)) 
    549                   (incf count)))))) 
    550  
    551         ;; Nothing 
    552         (unless candidates 
    553           (error "no completion found start: %s" initial-input)) 
    554  
    555         ;; delete-duplicates 
    556         (when plcmp-delete-duplicates-candidates-flag 
    557                                         ;(setq candidates (plcmp-remove-duplicates candidates)) 
    558           (setq candidates (nreverse (remove-duplicates (nreverse candidates) :test 'string-equal :key 'plcmp-get-real-candidate)))) 
    559          
    560         ;; return 
    561         candidates)) 
    562  
    563      ;; all 
    564      (t 
    565       (loop for lst in alist 
    566             for modname = (first lst) 
    567             for los = (rest lst) 
    568             with ret 
    569             do (loop for s in los 
    570                      do (when (plcmp-start-initial-input-p initial-input s) 
    571                           (push (plcmp-build-display-candidate modname s) ret))) 
    572             finally return ret))))) 
    573   
    574 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    575 ;;; Anything 
    576 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    577 (defvar plcmp-state nil 
    578   "補完対象を決めるシンボル、値は以下のいずれか 
    579 'all 
    580 'methods 
    581 'installed-modules 
    582 'using-modules 
    583 'builtin-functions 
    584 'builtin-variables 
    585 'dabbrev-functions 
    586 'dabbrev-variables 
    587 'globals") 
    588  
    589 (defvar plcmp-using-modules nil 
    590   "useされているモジュールのリスト") 
    591  
    592 (defvar plcmp-cur-obj "" 
    593   "補完対象のオブジェクト名、対象がない場合は空文字列 
    594 e.x, `!!'がマーカーの位置として 
    595 $foo->`!!' 
    596 の場合 $foo") 
    597  
    598 (defvar plcmp-initial-input "" 
    599   "補完中の文字列 
    600 e.x, `!!'がマーカーの位置として 
    601 $foo->ba`!!' 
    602 の場合 ba") 
    603  
    604 (defvar plcmp-obj-instance-of-module-maybe-alist nil 
    605   "モジュールのインスタンスと思われる変数名とモジュール名のalist") 
    606  
    607 (defvar plcmp-installed-modules nil 
    608   "インストールされているperlモジュール") 
    609  
    610 (defvar plcmp-current-buffer nil 
    611   "Anythingが起動されたバッファ") 
    612  
    613 (defvar plcmp-current-package nil 
    614   "バッファの丈夫でpackage宣言されている名前 
    615 {...}内のpackageは考慮していない 
    616 現在の実装ではバッファの先頭から500まで検索する") 
    617  
    618 (defvar plcmp-action-done nil 
    619   "non-nilだと`plcmp-anything'のデフォルトアクションを行わない 
    620 選択バッファからアクションを直接実行するために実装 
    621 plcmp-initialize 内で初期化される") 
    622 (defvar plcmp-frameconfig-action-done nil) 
    623  
    624 (defadvice plcmp-anything (around insert-initial-input-to-minibuf activate) 
     1307;; 名前空間がバッティングしないように全てのシンボルにprefixを付加し、ドキュメントと空行を削除したanything.elのソース 
     1308;;; perl-completion redefine anything core 
     1309 
     1310(defun plcmp-anything (&optional initial-pattern) 
    6251311  (interactive) 
    6261312  (let ((frameconfig (current-frame-configuration))) 
     
    6351321          (select-frame-set-input-focus (window-frame (minibuffer-window))) 
    6361322          (let ((minibuffer-local-map plcmp-anything-map)) 
    637             (read-string "pattern: ")  
     1323            (if (null initial-pattern) 
     1324                (read-string "pattern: ") 
     1325              (read-string "pattern: " initial-pattern) 
     1326              (plcmp-anything-check-minibuffer-input)) 
    6381327            )) 
    6391328      (plcmp-anything-cleanup) 
     
    6411330      (set-frame-configuration frameconfig))) 
    6421331   
    643   ;; `plcmp-action-done'がt(ショートカットから起動された場合)ならデフォルトアクションを起動しない 
    644   (unless plcmp-action-done 
    645     (plcmp-anything-execute-selection-action)) 
    646   ;; TODO 
    647   (when plcmp-frameconfig-action-done 
    648     (set-frame-configuration plcmp-frameconfig-action-done)) 
    649   (setq plcmp-action-done nil 
    650         plcmp-frameconfig-action-done nil)) 
     1332  (plcmp-anything-execute-selection-action)) 
    6511333 
    6521334;; マッチ部分の高速化(実験段階) 
    653 (defvar plcmp-anything-matched-candidate-cache nil 
    654   "(name . ((pattern . (list of string)) 
    655             (pattern . (list of string)))) ") 
     1335 
     1336 
     1337(defadvice plcmp-anything-initialize (after initialize-matched-candidate-cache activate) 
     1338  (setq plcmp-anything-matched-candidate-cache nil)) 
     1339 
     1340(defadvice plcmp-anything (around cleanup-overlay activate) 
     1341  (unwind-protect 
     1342      ad-do-it 
     1343    ;; overlay 
     1344    (when (overlayp plcmp-overlay) 
     1345      (delete-overlay plcmp-overlay)))) 
    6561346 
    6571347(defun plcmp-anything-get-cached-matched-candidates (source) 
     
    7391429        (plcmp-anything-insert-match match 'insert))))) 
    7401430 
    741 ;;redefined 
    7421431(defun plcmp-anything-execute-selection-action ()  
    7431432  (let* ((selection (if plcmp-anything-saved-sources 
     
    7551444        (funcall action selection)))) 
    7561445 
    757 (defvar plcmp-anything-type-attributes 
    758   `((plcmp 
    759      (action . (("Insert" . plcmp-insert) 
    760                 ("Insert modulename" . plcmp-insert-modulename) 
    761                 ("Open module file" . plcmp-open-module-file) 
    762                 ("Perldoc" . plcmp-perldoc) 
    763                 )) 
    764      (persistent-action . plcmp-perldoc)))) 
    765  
    766 ;; TODO: with-current-buffer 
    767 ;; to see buffer local variable 
    768 (defun plcmp-build-candidates-with-args () 
    769   (with-current-buffer plcmp-current-buffer 
    770     (plcmp-build-candidates plcmp-state plcmp-initial-input 
    771                          plcmp-cur-obj plcmp-current-buffer 
    772                          plcmp-modules-methods-alist))) 
    773 ;;; sources 
    774 (defvar plcmp-anything-source-dabbrev-variables 
    775   `((name . "variables") 
    776     (type . plcmp) 
    777     (init . (lambda () 
    778               (plcmp-initialize) 
    779               (setq plcmp-state 'dabbrev-variables))) 
    780     (candidates . plcmp-build-candidates-with-args) 
    781     (match . (plcmp-match)))) 
    782  
    783 (defvar plcmp-anything-source-dabbrev-functions 
    784   `((name . "functions") 
    785     (type . plcmp) 
    786     (init . (lambda () 
    787               (plcmp-initialize) 
    788               (setq plcmp-state 'dabbrev-functions))) 
    789     (candidates . plcmp-build-candidates-with-args) 
    790     (match . (plcmp-match)))) 
    791  
    792 (defvar plcmp-anything-source-builtin-functions 
    793   `((name . "builtin-functions") 
    794     (type . plcmp) 
    795     (init . (lambda () 
    796               (plcmp-initialize) 
    797               (setq plcmp-initial-input "" 
    798                     plcmp-state 'builtin-functions))) 
    799     (candidates . plcmp-build-candidates-with-args) 
    800     (match . (plcmp-match)))) 
    801  
    802 (defvar plcmp-anything-source-builtin-variables 
    803   `((name . "builtin-variables") 
    804     (type . plcmp) 
    805     (init . (lambda () 
    806               (plcmp-initialize) 
    807               (setq plcmp-initial-input "" 
    808                     plcmp-state 'builtin-variables))) 
    809     (candidates . plcmp-build-candidates-with-args) 
    810     (match . (plcmp-match)))) 
    811  
    812 (defvar plcmp-anything-source-methods 
    813   `((name . "methods") 
    814     (type . plcmp) 
    815     (init . (lambda () 
    816               (plcmp-initialize) 
    817               (setq plcmp-state 'methods))) 
    818     (candidates . plcmp-build-candidates-with-args) 
    819     (match . (plcmp-match)))) 
    820  
    821 (defvar plcmp-anything-source-using-modules 
    822   `((name . "using-modules") 
    823     (type . plcmp) 
    824     (init . (lambda () 
    825               (plcmp-initialize) 
    826               (setq plcmp-initial-input "" 
    827                     plcmp-state 'using-modules))) 
    828     (candidates . plcmp-build-candidates-with-args) 
    829     (match . (plcmp-match)))) 
    830  
    831 (defvar plcmp-anything-source-installed-modules 
    832   `((name . "installed-modules") 
    833     (type . plcmp) 
    834     (init . (lambda () 
    835               (plcmp-initialize) 
    836               (setq plcmp-state 'installed-modules 
    837                     plcmp-initial-input ""))) 
    838     (candidates . plcmp-build-candidates-with-args) 
    839     (match . (plcmp-match)))) 
    840  
    841 (defvar plcmp-anything-c-source-perlmodcmp 
    842   `((name . "perl completion") 
    843     (type . plcmp) 
    844     (candidates . plcmp-build-candidates-with-args) 
    845     (init . plcmp-initialize) 
    846     (cache) 
    847     (match . (plcmp-match)))) 
    848  
    849 ;; TODO: defstruct? 
    850 (defun plcmp-initialize () 
    851   ;; initialize variables 
    852   (setq plcmp-state nil 
    853         plcmp-installed-modules (plcmp-get-installed-modules) 
    854         plcmp-current-package (plcmp-get-current-package) 
    855         plcmp-using-modules (plcmp-get-using-modules) 
    856         plcmp-modules-methods-alist (plcmp-get-modules-methods-alist plcmp-using-modules) 
    857         plcmp-current-buffer (current-buffer) 
    858         plcmp-obj-instance-of-module-maybe-alist (plcmp-get-obj-instance-of-module-maybe-alist) 
    859         plcmp-action-done nil 
    860         plcmp-frameconfig-action-done nil 
    861         plcmp-initial-input "" 
    862         plcmp-cur-obj "" 
    863         plcmp-anything-matched-candidate-cache nil) 
    864   ;; get context 
    865   (plcmp-get-context)) 
    866  
    867 (defun plcmp-get-context () 
    868   (let ((start (point))) 
    869     (save-excursion 
    870       (skip-syntax-backward "w_") 
    871       (cond 
    872        ;; $self->`!!' 
    873        ((and (plcmp-method-p) 
    874              (string-equal "$self" (buffer-substring-no-properties 
    875                                     (or (ignore-errors (save-excursion (forward-char -2) (point))) 
    876                                         (point)) 
    877                                     (save-excursion (backward-sexp) (point))))) 
    878         (setq plcmp-initial-input 
    879               (buffer-substring-no-properties start (point))) 
    880         (setq plcmp-state 'self) 
    881         (setq plcmp-cur-obj (buffer-substring-no-properties 
    882                           (progn (forward-char -2) (point)) 
    883                           (progn (backward-sexp) (point))))) 
    884         
    885        ;; methods 
    886        ;; Foo->`!!' 
    887        ((plcmp-method-p) 
    888         (setq plcmp-initial-input 
    889               (buffer-substring-no-properties start (point))) 
    890         (setq plcmp-state 'methods) 
    891         (setq plcmp-cur-obj (buffer-substring-no-properties 
    892                           (progn (forward-char -2) (point)) 
    893                           (progn (backward-sexp) (point))))) 
    894         
    895        ;; TODO: globals? 
    896        ;; $foo`!!' 
    897        ((string-match "[$@%&]" (plcmp-get-preceding-string 1)) 
    898         (save-excursion 
    899           (forward-char -1) 
    900           (setq plcmp-initial-input 
    901                 (buffer-substring-no-properties start (point))) 
    902           (setq plcmp-state 'globals))) 
    903  
    904        ;; installed-modules 
    905        ;; use Foo::Ba`!!' 
    906        ((string-match "^\\s *use\\s *" (buffer-substring-no-properties (point-at-bol) (point))) 
    907         (setq plcmp-initial-input (buffer-substring-no-properties start (point))) 
    908         (setq plcmp-state 'installed-modules)) 
    909  
    910        ;; globals 
    911        ((or (bolp) 
    912             (string-equal (plcmp-get-preceding-string 1) " ")) 
    913         (setq plcmp-initial-input 
    914                 (buffer-substring-no-properties start (point))) 
    915         (setq plcmp-state 'globals)) 
    916         
    917        ;; otherwise 
    918        (t 
    919         (setq plcmp-initial-input 
    920               (buffer-substring-no-properties start (point))) 
    921         (setq plcmp-state 'globals)) 
    922        )))) 
    923  
    924 (defun plcmp-method-p () 
    925   (let ((s (plcmp-get-preceding-string 2))) 
    926     (string-equal s "->"))) 
    927  
    928 (defun plcmp-builtin-variable-p (candidate) 
    929   (let ((metadata (plcmp-get-metadate-candidate candidate))) 
    930     (string-equal metadata plcmp-display-format-builtin-variables))) 
    931  
    932 (defun plcmp-builtin-function-p (candidate) 
    933   (let ((metadata (plcmp-get-metadate-candidate candidate))) 
    934     (string-equal metadata plcmp-display-format-builtin-functions))) 
    935  
    936 (defun plcmp-dabbrev-variables-p (candidate) 
    937   (let ((metadata (plcmp-get-metadate-candidate candidate))) 
    938     (string-equal metadata plcmp-display-format-variables))) 
    939  
    940 (defun plcmp-dabbrev-function-other-perl-buf-p (candidate) 
    941   (let ((metadata (plcmp-get-metadate-candidate candidate)) 
    942         (re (concat plcmp-display-format-functions 
    943                     " " "\\*" "\\(" ".*" "\\)" "\\*$"))) 
    944     (string-match re metadata))) 
    945  
    946 (defun plcmp-get-dabbrev-function-other-perl-bufname (candidate) 
    947   "return buffer-name" 
    948   (let ((metadata (plcmp-get-metadate-candidate candidate)) 
    949         (re (concat plcmp-display-format-functions 
    950                     " " "\\*" "\\(" ".*" "\\)" "\\*$"))) 
    951     (when (string-match re metadata) 
    952       (match-string-no-properties 1 metadata)))) 
    953  
    954  
    955 ;;; actions 
    956 (defun plcmp-insert (candidate) 
    957   (delete-backward-char (length plcmp-initial-input)) 
    958   (insert (plcmp-get-real-candidate candidate))) 
    959  
    960 (defun plcmp-insert-modulename (candidate) 
    961   (delete-backward-char (length plcmp-initial-input)) 
    962   (insert (plcmp-get-metadate-candidate candidate))) 
    963  
    964 (defun plcmp-perldoc (candidate) 
    965   (cond 
    966    ((or (plcmp-builtin-variable-p candidate) 
    967         (plcmp-dabbrev-variables-p candidate)) 
    968     (shell-command "perldoc perlvar" plcmp-perlvar-output-buf-name) 
    969     (with-current-buffer plcmp-perlvar-output-buf-name 
    970       (let* ((var (plcmp-get-real-candidate candidate)) 
    971              (re (concat "^ \\{4\\}" (regexp-quote var) "\\s "))) 
    972         (re-search-forward re nil t) 
    973         (recenter 1)))) 
    974    ;; builtin-function 
    975    ((plcmp-builtin-function-p candidate) 
    976     (let ((funcname (plcmp-get-real-candidate candidate))) 
    977       (when (plcmp-perl-identifier-p funcname) 
    978         (shell-command (concat "perldoc -f " funcname) plcmp-perlfunc-output-buf-name)))) 
    979    ;; dabbrev-functions other buffer 
    980    ((plcmp-dabbrev-function-other-perl-buf-p candidate) 
    981     (let* ((bufname (plcmp-get-dabbrev-function-other-perl-bufname candidate)) 
    982            (funcname (plcmp-get-real-candidate candidate)) 
    983            (re (concat "\\_<" funcname "\\_>"))) 
    984       (pop-to-buffer bufname) 
    985       (with-current-buffer (get-buffer bufname) 
    986         (if (re-search-forward re nil t) 
    987             (recenter) 
    988           (goto-char (point-min)) 
    989           (re-search-forward re nil t) 
    990           (recenter))))) 
    991    ;; module 
    992    (t 
    993     (let ((modname (if (plcmp-module-p (plcmp-get-metadate-candidate candidate)) 
    994                        (plcmp-get-metadate-candidate candidate) 
    995                      (plcmp-get-real-candidate candidate)))) 
    996       (plcmp-open-perldoc modname))))) 
    997  
    998 (defun plcmp-open-perldoc (word) 
    999   "return buffer" 
    1000   (shell-command (concat "perldoc " word) plcmp-perldoc-output-buf-name) 
    1001   (get-buffer plcmp-perldoc-output-buf-name)) 
    1002  
    1003 (defun plcmp-open-module-file (candidate) 
    1004   (condition-case e 
    1005       (let ((modulename (plcmp-get-modulename-candidate candidate))) 
    1006         (unless (plcmp-module-p modulename) 
    1007           (error "invild format: %s" modulename)) 
    1008         (let* ((path (shell-command-to-string (concat "perldoc -l " modulename))) 
    1009                (path (plcmp-trim path))) 
    1010           (if (file-exists-p path) 
    1011               (find-file path) 
    1012             (error "can't find module %s" path)))) 
    1013     (message "%s" (plcmp-log "%s" (error-message-string e))))) 
    1014  
    1015 (defcustom plcmp-match-any-greedy t "") ;TODO: varname 
    1016 (defvar plcmp-match-last-re "") 
    1017 (defvar plcmp-match-last-anything-pattern "") 
    1018 (defsubst plcmp-match (candidate) 
    1019   (cond 
    1020    ((string-equal plcmp-anything-pattern 
    1021                   plcmp-match-last-anything-pattern) 
    1022     (string-match plcmp-match-last-re candidate)) 
    1023    (t 
    1024     (let ((re (replace-regexp-in-string 
    1025                "[ \t]+" ".*?" 
    1026                (plcmp-trim plcmp-anything-pattern)))) 
    1027       (setq plcmp-match-last-re re) 
    1028       (string-match re candidate))))) 
    1029  
    1030 (defvar plcmp-anything-map 
    1031   (let ((map (copy-keymap minibuffer-local-map))) 
    1032     ;; persistent-action 
    1033     (define-key map (kbd "C-z")  'plcmp-anything-execute-persistent-action) 
    1034  
    1035     ;; call action with selection 
    1036     (define-key map (kbd "M") 'plcmp-action-insert-modulename) 
    1037     (define-key map (kbd "D") 'plcmp-action-perldoc) 
    1038     (define-key map (kbd "O") 'plcmp-action-open-module-file) 
    1039  
    1040     ;; JKL, for reading document 
    1041     (define-key map (kbd "J") 'scroll-other-window) 
    1042     (define-key map (kbd "K") 'scroll-other-window-down) 
    1043     (define-key map (kbd "L") 'plcmp-anything-execute-persistent-action) 
    1044  
    1045     (define-key map (kbd "M-C-v") 'scroll-other-window) 
    1046     (define-key map (kbd "M-C-S-v") 'scroll-other-window-down) 
    1047      
    1048     ;; Stolen from anything-config.el 
    1049     (define-key map (kbd "<down>")  'plcmp-anything-next-line) 
    1050     (define-key map (kbd "<up>")    'plcmp-anything-previous-line) 
    1051     (define-key map (kbd "C-n")     'plcmp-anything-next-line) 
    1052     (define-key map (kbd "C-p")     'plcmp-anything-previous-line) 
    1053     (define-key map (kbd "<prior>") 'plcmp-anything-previous-page) 
    1054     (define-key map (kbd "<next>")  'plcmp-anything-next-page) 
    1055     (define-key map (kbd "M-v")     'plcmp-anything-previous-page) 
    1056     (define-key map (kbd "C-v")     'plcmp-anything-next-page) 
    1057     ;;(define-key map (kbd "<right>") 'plcmp-anything-next-source) 
    1058     (define-key map "\M-\C-f" 'plcmp-anything-next-source) 
    1059     (define-key map "\M-\C-b"  'plcmp-anything-previous-source) 
    1060     (define-key map (kbd "<RET>")   'plcmp-anything-exit-minibuffer) 
    1061     (define-key map (kbd "C-1")     'plcmp-anything-select-with-digit-shortcut) 
    1062     (define-key map (kbd "C-2")     'plcmp-anything-select-with-digit-shortcut) 
    1063     (define-key map (kbd "C-3")     'plcmp-anything-select-with-digit-shortcut) 
    1064     (define-key map (kbd "C-4")     'plcmp-anything-select-with-digit-shortcut) 
    1065     (define-key map (kbd "C-5")     'plcmp-anything-select-with-digit-shortcut) 
    1066     (define-key map (kbd "C-6")     'plcmp-anything-select-with-digit-shortcut) 
    1067     (define-key map (kbd "C-7")     'plcmp-anything-select-with-digit-shortcut) 
    1068     (define-key map (kbd "C-8")     'plcmp-anything-select-with-digit-shortcut) 
    1069     (define-key map (kbd "C-9")     'plcmp-anything-select-with-digit-shortcut) 
    1070     (define-key map (kbd "<tab>")   'plcmp-anything-select-action) 
    1071     (defalias 'plcmp-anything-next-history-element     'next-history-element) 
    1072     (defalias 'plcmp-anything-previous-history-element 'previous-history-element) 
    1073     (define-key map (kbd "M-p")     'plcmp-anything-previous-history-element) 
    1074     (define-key map (kbd "M-n")     'plcmp-anything-next-history-element) 
    1075     (define-key map (kbd "C-s")     'plcmp-anything-isearch) 
    1076     (define-key map (kbd "C-r")     'undefined) 
    1077     map)) 
    1078  
    1079 (defvar plcmp-anything-isearch-map 
    1080   (let ((map (copy-keymap (current-global-map)))) 
    1081     (define-key map (kbd "<return>")    'plcmp-anything-isearch-default-action) 
    1082     (define-key map (kbd "<tab>")       'plcmp-anything-isearch-select-action) 
    1083     (define-key map (kbd "C-g")         'plcmp-anything-isearch-cancel) 
    1084     (define-key map (kbd "C-s")         'plcmp-anything-isearch-again) 
    1085     (define-key map (kbd "C-r")         'undefined) 
    1086     (define-key map (kbd "<backspace>") 'plcmp-anything-isearch-delete) 
    1087     ;; add printing chars 
    1088     (let ((i ?\s)) 
    1089       (while (< i 256) 
    1090         (define-key map (vector i) 'plcmp-anything-isearch-printing-char) 
    1091         (setq i (1+ i)))) 
    1092     map)) 
    1093  
    1094   
    1095 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    1096 ;;; Anything commands 
    1097 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    1098  
    1099 (defun plcmp-call-action (action-name &optional save-frame-p);TODO 
    1100   "string ACTION-NAME" 
    1101   (let* ((selection (if plcmp-anything-saved-sources 
    1102                         plcmp-anything-saved-selection 
    1103                       (plcmp-anything-get-selection))) 
    1104          (action (if plcmp-anything-saved-sources 
    1105                      (plcmp-anything-get-selection) 
    1106                    (plcmp-anything-get-action)))) 
    1107     ;; get action by action-name 
    1108     (when (and (listp action) 
    1109                (not (functionp action))) ; lambda 
    1110       (setq action (assoc-default action-name action))) 
    1111  
    1112     ;; call action 
    1113     (when (and action 
    1114                selection) 
    1115       (with-current-buffer plcmp-current-buffer 
    1116         (funcall action selection)) 
    1117       (setq plcmp-action-done t)) 
    1118  
    1119     ;; exit with no default-action 
    1120     ;; test 
    1121     (plcmp-anything-exit-minibuffer))) 
    1122  
    1123 ;; TODO 
    1124 ;; code from anything-config-rubikitch.el 
    1125 (defvar plcmp-anything-saved-action nil 
    1126   "Saved value of the currently selected action by key.") 
    1127 (defun plcmp-call-action-by-action-name (action-name) 
    1128   (setq plcmp-anything-saved-selection (plcmp-anything-get-selection)) 
    1129   (unless plcmp-anything-saved-selection 
    1130     (error "Nothing is selected.")) 
    1131   (setq plcmp-anything-saved-action (cdr (assoc action-name (plcmp-anything-get-action)))) 
    1132   (plcmp-anything-exit-minibuffer)) 
    1133  
    1134 (defun plcmp-action-insert-modulename () 
    1135   (interactive) 
    1136   (plcmp-call-action "Insert modulename")) 
    1137  
    1138 (defun plcmp-action-open-module-file () 
    1139   (interactive) 
    1140   (plcmp-call-action "Open module file")) 
    1141  
    1142 (defun plcmp-action-perldoc () 
    1143   (interactive) 
    1144   (plcmp-call-action-by-action-name "Perldoc")) 
    1145  
    1146   
    1147 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    1148 ;;; Commands 
    1149 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    1150 (defun plcmp-smart-complete () 
    1151   (interactive) 
    1152   (let ((plcmp-anything-sources (list plcmp-anything-c-source-perlmodcmp))) 
    1153     (condition-case e 
    1154         (plcmp-anything) 
    1155       (message "%s" (error-message-string e))))) 
    1156  
    1157 (defun plcmp-dabbrev-variables () 
    1158   (interactive) 
    1159   (let ((plcmp-anything-sources (list plcmp-anything-source-dabbrev-variables))) 
    1160     (plcmp-anything))) 
    1161  
    1162 (defun plcmp-dabbrev-functions () 
    1163   (interactive) 
    1164   (let ((plcmp-anything-sources (list plcmp-anything-source-dabbrev-functions))) 
    1165     (plcmp-anything))) 
    1166  
    1167 (defun plcmp-clear-all-cache () 
    1168   (interactive) 
    1169   (plcmp-clear-cache-using-modules) 
    1170   (plcmp-clear-cache-modules-methods-alist) 
    1171   (plcmp-clear-cache-installed-modules)) 
    1172  
    1173 (defun plcmp-installed-modules-complete () 
    1174   (interactive) 
    1175   (let ((plcmp-anything-sources (list plcmp-anything-source-installed-modules))) 
    1176     (plcmp-anything))) 
    1177  
    1178 (defun plcmp-builtin-function-complete () 
    1179   (interactive) 
    1180   (let ((plcmp-anything-sources (list plcmp-anything-source-builtin-functions))) 
    1181     (plcmp-anything))) 
    1182  
    1183 (defun plcmp-builtin-variables-complete () 
    1184   (interactive) 
    1185   (let ((plcmp-anything-sources (list plcmp-anything-source-builtin-variables))) 
    1186     (plcmp-anything))) 
    1187  
    1188 (defun plcmp-using-modules-complete () 
    1189   (interactive) 
    1190   (let ((plcmp-anything-sources (list plcmp-anything-source-using-modules))) 
    1191     (plcmp-anything))) 
    1192  
    1193 (defun plcmp-reset () 
    1194   (interactive) 
    1195   (unload-feature 'perl-completion t) 
    1196   (require 'perl-completion nil t)) 
    1197  
    1198   
    1199 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    1200 ;;; Utilities 
    1201 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    1202 (defsubst plcmp-trim (s) 
    1203   "strip space and newline" 
    1204   (replace-regexp-in-string 
    1205    "[ \t\n]*$" "" (replace-regexp-in-string "^[ \t\n]*" "" s))) 
    1206  
    1207 (defun plcmp-get-preceding-string (&optional count) 
    1208   "現在の位置からcount文字前方位置までの文字列を返す 
    1209 例外を出さない" 
    1210   (let ((count (or count 1))) 
    1211     (buffer-substring-no-properties 
    1212      (point) 
    1213      (condition-case nil 
    1214          (save-excursion (backward-char count) (point)) 
    1215        (error (point)))))) 
    1216  
    1217 (defsubst plcmp-module-p (s) 
    1218   (string-match "^[a-zA-Z:_]+$" s)) 
    1219  
    1220 (defsubst plcmp-perl-identifier-p (s) 
    1221   (string-match (concat "^" plcmp-perl-ident-re "$") s)) 
    1222  
    1223 (defun plcmp-notfound-p (s) 
    1224   (string-match "^Can't locate [^ \t]+ in" s)) 
    1225  
    1226 (defmacro plcmp-ignore-errors (&rest body) 
    1227   `(condition-case e (progn ,@body) 
    1228      (error (plcmp-log "Error in plcmp-ignore-errors :  %s" (error-message-string e))))) 
    1229 ;; (put 'plcmp-ignore-errors 'lisp-indent-function 0) 
    1230 ;; (put 'plcmp-ignore-errors 'lisp-indent-hook 0) 
    1231 ;; (or (get 'plcmp-ignore-errors 'edebug-form-spec) 
    1232 ;;     (put 'func 'edebug-form-spec '(&rest body))) 
    1233  
    1234 ;;; log 
    1235 (defvar plcmp-debug nil) 
    1236 (defvar plcmp-log-buf-name "*plcmp debug*") 
    1237 (defun plcmp-log-buf () 
    1238   (get-buffer-create plcmp-log-buf-name)) 
    1239 (defun plcmp-log (&rest messages) 
    1240   (ignore-errors 
    1241     (let* ((str (or (ignore-errors (apply 'format messages)) 
    1242                     (prin1-to-string messages))) 
    1243            (strn (concat str "\n"))) 
    1244       (when plcmp-debug 
    1245         (with-current-buffer (plcmp-log-buf) 
    1246           (goto-char (point-max)) 
    1247           (insert str))) 
    1248       str))) 
    1249  
    1250   
    1251 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    1252 ;;; mode setup 
    1253 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    1254 (defmacro plcmp-set-key (key binding) 
    1255   `(define-key plcmp-mode-map ,key ,binding)) 
    1256  
    1257 (defvar plcmp-mode-map (make-keymap)) 
    1258 ;;; setup 
    1259 (plcmp-set-key (kbd "M-TAB") 'plcmp-smart-complete) 
    1260 (plcmp-set-key (kbd "C-RET") 'plcmp-smart-complete) 
    1261 (plcmp-set-key (kbd "C-<return>") 'plcmp-smart-complete) 
    1262 (plcmp-set-key (kbd "C-c f") 'plcmp-builtin-function-complete) 
    1263 (plcmp-set-key (kbd "C-c v") 'plcmp-builtin-variables-complete) 
    1264 (plcmp-set-key (kbd "C-c i") 'plcmp-installed-modules-complete) 
    1265 (plcmp-set-key (kbd "C-c u") 'plcmp-using-modules-complete) 
    1266 (plcmp-set-key (kbd "C-c c") 'plcmp-clear-all-cache) 
    1267  
    1268 (defun plcmp-mode-init () 
    1269   ;;初回起動時 
    1270   (unless (buffer-live-p (get-buffer plcmp-installed-modules-buf-name)) 
    1271     (plcmp-send-command-get-installed-modules))) 
    1272  
    1273 (define-minor-mode perl-completion-mode "" nil " PLCompletion" plcmp-mode-map (plcmp-mode-init)) 
    1274  
    1275 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    1276 ;;; compatibility anything 
    1277 ;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
    1278 ;; 名前空間がバッティングしないように全てのシンボルにprefixを付加し、ドキュメントと空行を削除したanything.elのソース 
    1279 (defvar plcmp-anything-sources 
    1280   `(((name . "Buffers") 
    1281      (candidates 
    1282       . (lambda () 
    1283           (remove-if (lambda (name) 
    1284                        (or (equal name plcmp-anything-buffer) 
    1285                            (eq ?\  (aref name 0)))) 
    1286                      (mapcar 'buffer-name (buffer-list))))) 
    1287      (type . buffer)) 
    1288     ((name . "File Name History") 
    1289      (candidates . file-name-history) 
    1290      (match (lambda (candidate) 
    1291               (string-match 
    1292                plcmp-anything-pattern 
    1293                (file-name-nondirectory candidate))) 
    1294             (lambda (candidate) 
    1295               (let ((dir (file-name-directory candidate))) 
    1296                 (if dir 
    1297                     (string-match plcmp-anything-pattern dir))))) 
    1298      (type . file)) 
    1299     ((name . "Files from Current Directory") 
    1300      (init . (lambda () 
    1301                (setq plcmp-anything-default-directory 
    1302                      default-directory))) 
    1303      (candidates . (lambda () 
    1304                      (directory-files 
    1305                       plcmp-anything-default-directory))) 
    1306      (type . file)) 
    1307     ((name . "Manual Pages") 
    1308      (candidates . ,(progn 
    1309                       (condition-case nil 
    1310                           (progn 
    1311                             (require 'woman) 
    1312                             (woman-file-name "") 
    1313                             (sort (mapcar 'car 
    1314                                           woman-topic-all-completions) 
    1315                                   'string-lessp)) 
    1316                         (error nil)))) 
    1317      (action . (("Open Manual Page" . woman))) 
    1318      (requires-pattern . 2)) 
    1319     ((name . "Complex Command History") 
    1320      (candidates . (lambda () 
    1321                      (mapcar 'prin1-to-string 
    1322                              command-history))) 
    1323      (action . (("Repeat Complex Command" . 
    1324                  (lambda (c) 
    1325                    (eval (read c)))))) 
    1326      (delayed))) 
    1327   ) 
    1328 ;;; defined  above 
    1329  
    1330 ;; (defvar plcmp-anything-type-attributes 
    1331 ;;   '((file (action . (("Find File" . find-file) 
    1332 ;;                      ("Delete File" . (lambda (file) 
    1333 ;;                                         (if (y-or-n-p (format "Really delete file %s? " 
    1334 ;;                                                               file)) 
    1335 ;;                                             (delete-file file))))))) 
    1336 ;;     (buffer (action . (("Switch to Buffer" . switch-to-buffer) 
    1337 ;;                        ("Pop to Buffer"    . pop-to-buffer) 
    1338 ;;                        ("Display Buffer"   . display-buffer) 
    1339 ;;                        ("Kill Buffer"      . kill-buffer)))))) 
     1446;;; aything core 
     1447(defvar plcmp-anything-sources nil) 
    13401448(defvar plcmp-anything-enable-digit-shortcuts nil ) 
    13411449(defvar plcmp-anything-candidate-number-limit plcmp-anything-candidate-number-limit ) 
     
    13431451(defvar plcmp-anything-samewindow nil ) 
    13441452(defvar plcmp-anything-source-filter nil ) 
    1345 ;;   (defvar plcmp-anything-map 
    1346 ;;     (let ((map (copy-keymap minibuffer-local-map))) 
    1347 ;;       (define-key map (kbd "<down>") 'plcmp-anything-next-line) 
    1348 ;;       (define-key map (kbd "<up>") 'plcmp-anything-previous-line) 
    1349 ;;       (define-key map (kbd "<prior>") 'plcmp-anything-previous-page) 
    1350 ;;       (define-key map (kbd "<next>") 'plcmp-anything-next-page) 
    1351 ;;       (define-key map (kbd "<right>") 'plcmp-anything-next-source) 
    1352 ;;       (define-key map (kbd "<left>") 'plcmp-anything-previous-source) 
    1353 ;;       (define-key map (kbd "<RET>") 'plcmp-anything-exit-minibuffer) 
    1354 ;;       (define-key map (kbd "C-1") 'plcmp-anything-select-with-digit-shortcut) 
    1355 ;;       (define-key map (kbd "C-2") 'plcmp-anything-select-with-digit-shortcut) 
    1356 ;;       (define-key map (kbd "C-3") 'plcmp-anything-select-with-digit-shortcut) 
    1357 ;;       (define-key map (kbd "C-4") 'plcmp-anything-select-with-digit-shortcut) 
    1358 ;;       (define-key map (kbd "C-5") 'plcmp-anything-select-with-digit-shortcut) 
    1359 ;;       (define-key map (kbd "C-6") 'plcmp-anything-select-with-digit-shortcut) 
    1360 ;;       (define-key map (kbd "C-7") 'plcmp-anything-select-with-digit-shortcut) 
    1361 ;;       (define-key map (kbd "C-8") 'plcmp-anything-select-with-digit-shortcut) 
    1362 ;;       (define-key map (kbd "C-9") 'plcmp-anything-select-with-digit-shortcut) 
    1363 ;;       (define-key map (kbd "C-i") 'plcmp-anything-select-action) 
    1364 ;;       (defalias 'plcmp-anything-previous-history-element 'previous-history-element) 
    1365 ;;       (define-key map (kbd "C-p") 'plcmp-anything-previous-history-element) 
    1366 ;;       (defalias 'plcmp-anything-next-history-element 'next-history-element) 
    1367 ;;       (define-key map (kbd "C-n") 'plcmp-anything-next-history-element) 
    1368 ;;       (define-key map (kbd "M-s") 'plcmp-anything-isearch) 
    1369 ;;       (define-key map (kbd "C-r") nil) 
    1370 ;;       map)) 
    13711453(defvar plcmp-anything-isearch-map 
    13721454  (let ((map (copy-keymap (current-global-map)))) 
     
    13991481(defvar plcmp-anything-digit-overlays nil ) 
    14001482(defvar plcmp-anything-candidate-cache nil ) 
    1401 (defvar plcmp-anything-pattern ) 
    1402 (defvar plcmp-anything-input ) 
     1483(defvar plcmp-anything-pattern "") 
     1484(defvar plcmp-anything-input "") 
    14031485(defvar plcmp-anything-async-processes nil ) 
    14041486(defvar plcmp-anything-digit-shortcut-count 0 ) 
     
    15251607            (plcmp-anything-next-line))) 
    15261608        (plcmp-anything-maybe-fit-frame)))) 
    1527 (defun plcmp-anything ()  
    1528   (interactive) 
    1529   (let ((frameconfig (current-frame-configuration))) 
    1530     (add-hook 'post-command-hook 'plcmp-anything-check-minibuffer-input) 
    1531     (plcmp-anything-initialize) 
    1532     (if plcmp-anything-samewindow 
    1533         (switch-to-buffer plcmp-anything-buffer) 
    1534       (pop-to-buffer plcmp-anything-buffer)) 
    1535     (unwind-protect 
    1536         (progn 
    1537           (plcmp-anything-update) 
    1538           (select-frame-set-input-focus (window-frame (minibuffer-window))) 
    1539           (let ((minibuffer-local-map plcmp-anything-map)) 
    1540             (read-string "pattern: " )  
    1541             )) 
    1542       (plcmp-anything-cleanup) 
    1543       (remove-hook 'post-command-hook 'plcmp-anything-check-minibuffer-input) 
    1544       (set-frame-configuration frameconfig))) 
    1545   (plcmp-anything-execute-selection-action)) 
     1609 
     1610;;define above 
     1611 
     1612;; (defun plcmp-anything ()  
     1613;;   (interactive) 
     1614;;   (let ((frameconfig (current-frame-configuration))) 
     1615;;     (add-hook 'post-command-hook 'plcmp-anything-check-minibuffer-input) 
     1616;;     (plcmp-anything-initialize) 
     1617;;     (if plcmp-anything-samewindow 
     1618;;         (switch-to-buffer plcmp-anything-buffer) 
     1619;;       (pop-to-buffer plcmp-anything-buffer)) 
     1620;;     (unwind-protect 
     1621;;         (progn 
     1622;;           (plcmp-anything-update) 
     1623;;           (select-frame-set-input-focus (window-frame (minibuffer-window))) 
     1624;;           (let ((minibuffer-local-map plcmp-anything-map)) 
     1625;;             (read-string "pattern: " )  
     1626;;             )) 
     1627;;       (plcmp-anything-cleanup) 
     1628;;       (remove-hook 'post-command-hook 'plcmp-anything-check-minibuffer-input) 
     1629;;       (set-frame-configuration frameconfig))) 
     1630;;   (plcmp-anything-execute-selection-action)) 
    15461631;; Redefined above 
    15471632;; (defun plcmp-anything-execute-selection-action ()  
     
    15881673    (setq plcmp-anything-saved-sources plcmp-anything-sources) 
    15891674    (setq plcmp-anything-sources `(((name . "Actions") 
    1590                                                (candidates . ,actions)))) 
     1675                                    (candidates . ,actions)))) 
    15911676    (with-selected-window (minibuffer-window) 
    15921677      (delete-minibuffer-contents)) 
     
    18351920  (setq plcmp-anything-source-filter sources) 
    18361921  (plcmp-anything-update)) 
    1837 (defun plcmp-anything-maybe-fit-frame ()  
     1922(defun plcmp-anything-maybe-fit-frame () 
    18381923  (when (and (require 'fit-frame nil t) 
    18391924             (boundp 'fit-frame-inhibit-fitting-flag)