Context Navigation

perl-completion.el @ 14626

Revision 14626, 97.9 kB (checked in by imakado, 5 years ago)
コードの見直し、いくつかの動作の改善、defcustom化

Line
1	;;; -- coding: utf-8; mode: emacs-lisp; --
2	;;; perl-completion.el
3
4	;; Author: Kenji.Imakado <ken.imakaado@gmail.com>
5	;; Version: 0.3
6	;; Keywords: perl
7
8	;; This file is free software; you can redistribute it and/or modify
9	;; it under the terms of the GNU General Public License as published by
10	;; the Free Software Foundation; either version 2, or (at your option)
11	;; any later version.
12
13	;; This file is distributed in the hope that it will be useful,
14	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16	;; GNU General Public License for more details.
17
18	;; You should have received a copy of the GNU General Public License
19	;; along with GNU Emacs; see the file COPYING. If not, write to the
20	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21	;; Boston, MA 02110-1301, USA.
22
23	;;; Commentary:
24	;; Tested on Emacs 22
25
26	;; to customize
27	;; M-x customize-group RET perl-completion RET
28
29	;;;code:
30
31	(require 'cl)
32	(require 'cperl-mode)
33	(require 'dabbrev)
34	(require 'rx)
35
36	;;; provide
37	(provide 'perl-completion)
38
39	;;; group
40	(defgroup perl-completion nil
41	""
42	:group 'perl-completion)
43
44	;;; customizable variables
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を候補に入れる文字数
53	initial-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
63	(defcustom plcmp-config-modules-filter-list
64	'("strict" "warning")
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
82	non-nilの場合は\"\|\"以降の文字列のみにマッチする"
83	:type 'boolean
84	:group 'perl-completion)
85
86	;;; const
87	(defconst plcmp-version 0.3)
88	(defconst plcmp-lang (cond ((string-match "japanese" (format "%s" locale-coding-system)) 'ja)
89	(t 'english)))
90	(defconst plcmp-perlvar-output-buf-name "perlvar output")
91	(defconst plcmp-perlfunc-output-buf-name "perlfunc output")
92	(defconst plcmp-perldoc-output-buf-name "perldoc output")
93	(defconst plcmp-perl-ident-re "[a-zA-Z_][a-zA-Z_0-9]*")
94	(defconst plcmp-installed-modules-buf-name "perl installed modules")
95	(defconst plcmp-display-format-variables "buffer variable")
96	(defconst plcmp-display-format-functions "buffer function")
97	(defconst plcmp-display-format-dabbrev-expansions "buffer dabbrev")
98	(defconst plcmp-display-format-builtin-variables "builtin variable")
99	(defconst plcmp-display-format-builtin-functions "builtin function")
100	(defconst plcmp-display-format-using-modules "using module")
101	(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 " &"))
105	(defconst plcmp-builtin-functions
106	'("abs" "exec" "glob" "order" "seek" "symlink" "accept" "exists" "gmtime"
107	"our" "seekdir" "syscall" "alarm" "exit" "goto" "pack" "select" "sysopen"
108	"atan" "exp" "grep" "package" "semctl" "sysread" "bind" "fcntl" "hex"
109	"pipe" "semget" "sysseek" "binmode" "fileno" "import" "pop" "semop"
110	"system" "bless" "flags" "index" "pos" "send" "syswrite" "caller" "flock"
111	"int" "precision" "setgrent" "tell" "chdir" "fork" "ioctl" "print" "sethostent"
112	"telldir" "chmod" "format" "join" "printf" "setnetent" "tie" "chomp" "formline"
113	"keys" "prototype" "setpgrp" "tied" "chop" "getc" "kill" "push" "setpriority"
114	"time" "chown" "getgrent" "last" "q" "setprotoent" "times" "chr" "getgrgid"
115	"lc" "qq" "setpwent" "tr" "chroot" "getgrnam" "lcfirst" "qr" "setservent"
116	"truncate" "close" "gethostbyaddr" "length" "quotemeta" "setsockopt" "uc"
117	"closedir" "gethostbyname" "link" "qw" "shift" "ucfirst" "connect" "gethostent"
118	"listen" "qx" "shmctl" "umask" "continue" "getlogin" "local" "rand" "shmget"
119	"undef" "cos" "getnetbyaddr" "localtime" "read" "shmread" "unlink" "crypt"
120	"getnetbyname" "lock" "readdir" "shmwrite" "unpack" "dbmclose" "getnetent"
121	"log" "readline" "shutdown" "unshift" "dbmopen" "getpeername" "lstat" "readlink"
122	"sin" "untie" "defined" "getpgrp" "m" "readpipe" "size" "use" "delete" "getppid"
123	"map" "recv" "sleep" "utime" "die" "getpriority" "mkdir" "redo" "socket" "values"
124	"do" "getprotobyname" "msgctl" "ref" "socketpair" "vec" "dump" "getprotobynumber"
125	"msgget" "rename" "sort" "vector" "each" "getprotoent" "msgrcv" "require" "splice"
126	"wait" "endgrent" "getpwent" "msgsnd" "reset" "split" "waitpid" "endhostent"
127	"getpwnam" "my" "return" "sprintf" "wantarray" "endnetent" "getpwuid" "next"
128	"reverse" "sqrt" "warn" "endprotoent" "getservbyname" "no" "rewinddir" "srand"
129	"write" "endpwent" "getservbyport" "oct" "rindex" "stat" "y" "endservent" "getservent"
130	"open" "rmdir" "study" "eof" "getsockname" "opendir" "s" "sub" "eval" "getsockopt"
131	"ord" "scalar" "substr"))
132
133	(defconst plcmp-builtin-variables
134	'("$SIG{expr}" "%SIG" "$ENV{expr}" "%ENV" "%INC" "@_" "@INC" "@F" "ARGVOUT"
135	"@ARGV" "$ARGV" "ARGV" "$^X" "$EXECUTABLE_NAME" "${^WARNING_BITS}" "$^W"
136	"$WARNING" "$^V" "$PERL_VERSION" "${^UTF8LOCALE}" "${^UNICODE}" "${^TAINT}"
137	"$^T" "$BASETIME" "$^S" "$EXCEPTIONS_BEING_CAUGHT" "$^R"
138	"$LAST_REGEXP_CODE_RESULT" "$^P" "$PERLDB" "${^OPEN}" "$^O" "$OSNAME" "$^M" "$^I" "$INPLACE_EDIT"
139	"%^H" "$^H" "$^F" "$SYSTEM_FD_MAX" "$^D" "$DEBUGGING" "$^C" "$COMPILING" "$]"
140	"$[" "$0" "$PROGRAM_NAME" "$)" "$EGID" "$EFFECTIVE_GROUP_ID" "$(" "$GID" "$REAL_GROUP_ID"
141	"$>" "$EUID" "$EFFECTIVE_USER_ID" "$<" "$UID" "$REAL_USER_ID" "$$" "$PID" "$PROCESS_ID"
142	"$@" "$EVAL_ERROR" "$^E" "$EXTENDED_OS_ERROR" "%!" "$!" "$ERRNO" "$OS_ERROR" "${^ENCODING}"
143	"$?" "$CHILD_ERROR" "$^A" "$ACCUMULATOR" "$^L" "$FORMAT_FORMFEED" "IO::Handle->format_formfeed" "$:"
144	"$FORMAT_LINE_BREAK_CHARACTERS" "IO::Handle->format_line_break_characters" "$^"
145	"$FORMAT_TOP_NAME" "HANDLE->format_top_name(EXPR)" "$~"
146	"$FORMAT_NAME" "HANDLE->format_name(EXPR)" "@-" "@LAST_MATCH_START"
147	"$-" "$FORMAT_LINES_LEFT" "HANDLE->format_lines_left(EXPR)" "$="
148	"$FORMAT_LINES_PER_PAGE" "HANDLE->format_lines_per_page(EXPR)" "$%"
149	"$FORMAT_PAGE_NUMBER" "HANDLE->format_page_number(EXPR)" "$#" "$;"
150	"$SUBSEP" "$SUBSCRIPT_SEPARATOR" "$\"" "$LIST_SEPARATOR" "$\\" "$ORS"
151	"$OUTPUT_RECORD_SEPARATOR" "IO::Handle->output_record_separator" "$," "$OFS"
152	"$OUTPUT_FIELD_SEPARATOR" "IO::Handle->output_field_separator" "$\|"
153	"$OUTPUT_AUTOFLUSH" "HANDLE->autoflush(EXPR)" "$/" "$RS"
154	"$INPUT_RECORD_SEPARATOR" "IO::Handle->input_record_separator(EXPR)" "$."
155	"$NR" "$INPUT_LINE_NUMBER" "HANDLE->input_line_number(EXPR)" "$*" "@+"
156	"@LAST_MATCH_END" "$^N" "$+" "$LAST_PAREN_MATCH" "$'" "$POSTMATCH" "$`"
157	"$PREMATCH" "$&" "$MATCH" "$<digits>" "$b" "$a" "$_" "$ARG"))
158
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
180	;;; variables
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)
190	(defvar plcmp-modules-methods-alist nil)
191	(make-variable-buffer-local 'plcmp-modules-methods-alist)
192
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
248	;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
249	;;; Utilities
250	;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
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
384	(defun plcmp-get-using-modules ()
385	(let ((re "^[ \t]use[ \t]+\$[a-zA-Z:_]+\$\\s [^;\n]*;") ;todo
386	(ret nil))
387	(save-excursion
388	(goto-char (point-min))
389	(loop always (re-search-forward re nil t)
390	do (add-to-list 'ret (match-string-no-properties 1))))
391
392	;; filter plcmp-config-modules-filter-list
393	(setq ret (set-difference ret plcmp-config-modules-filter-list :test 'string-equal))
394	(plcmp-log "get-using-modules: %S" ret)
395	ret))
396
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)
411	"Class::Inspectorを使用してモジュールのメソッド調べる。
412	モジュール名に使用できる文字以外が含まれていた場合はnilを返す
413	return los"
414	(ignore-errors
415	(unless (string-match "^[a-zA-Z:_]+$" module)
416	(error "invild modulename"))
417	(let ((mods (shell-command-to-string
418	(concat "perl -MClass::Inspector -e'use " module "; print join \"\n\"=>@{Class::Inspector->methods(" module ")} '"))))
419	(cond
420	((plcmp-notfound-p mods)
421	(error "cant locate %s" module))
422	(t
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)
521	(save-excursion
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))
618
619	(defun plcmp-get-words-by-face (face)
620	(ignore-errors
621	(save-excursion
622	(let ((ret nil))
623	(goto-char (point-min))
624	;;最初のfaceへ移動
625	(loop always (not (plcmp-check-face face (if (bobp) (point) (- (point) 1))))
626	do (unless (forward-word)
627	(error "no variables")))
628	(forward-char -1)
629	;;プロパティが変わる部分を走査する
630	(loop for next-change = (or (next-property-change (point) (current-buffer))
631	(point-max))
632	always (not (eobp))
633	do (progn
634	(when (plcmp-check-face face)
635	(let ((str (or (cperl-word-at-point) "")))
636	;; fillter
637	(unless (plcmp-bit-regexp-p str)
638	(push str ret)))) ;must be string
639	(goto-char next-change)))
640	(delete-dups ret)))))
641
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)
670	(let ((dabbrev-check-other-buffers all))
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.
930	return 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
1303
1304	;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1305	;;; compatibility anything
1306	;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1307	;; 名前空間がバッティングしないように全てのシンボルにprefixを付加し、ドキュメントと空行を削除したanything.elのソース
1308	;;; perl-completion redefine anything core
1309
1310	(defun plcmp-anything (&optional initial-pattern)
1311	(interactive)
1312	(let ((frameconfig (current-frame-configuration)))
1313	(add-hook 'post-command-hook 'plcmp-anything-check-minibuffer-input)
1314	(plcmp-anything-initialize)
1315	(if plcmp-anything-samewindow
1316	(switch-to-buffer plcmp-anything-buffer)
1317	(pop-to-buffer plcmp-anything-buffer))
1318	(unwind-protect
1319	(progn
1320	(plcmp-anything-update)
1321	(select-frame-set-input-focus (window-frame (minibuffer-window)))
1322	(let ((minibuffer-local-map plcmp-anything-map))
1323	(if (null initial-pattern)
1324	(read-string "pattern: ")
1325	(read-string "pattern: " initial-pattern)
1326	(plcmp-anything-check-minibuffer-input))
1327	))
1328	(plcmp-anything-cleanup)
1329	(remove-hook 'post-command-hook 'plcmp-anything-check-minibuffer-input)
1330	(set-frame-configuration frameconfig)))
1331
1332	(plcmp-anything-execute-selection-action))
1333
1334	;; マッチ部分の高速化(実験段階)
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))))
1346
1347	(defun plcmp-anything-get-cached-matched-candidates (source)
1348	(let ((cache (assq 'cache source))
1349	(name (assoc-default 'name source))
1350	(alist (assoc-default name plcmp-anything-matched-candidate-cache))
1351	(pattern (or (ignore-errors (substring plcmp-anything-pattern
1352	0 (1- (length plcmp-anything-pattern))))
1353	""))
1354	(ret nil))
1355	(plcmp-log "pattern: %s" pattern)
1356	(cond
1357	((string-match "^\\w+\\s *\\w+" pattern)
1358	(assoc-default pattern alist))
1359	(t
1360	nil))))
1361
1362	(defun plcmp-anything-process-source (source)
1363	(let (matches)
1364	(if (equal plcmp-anything-pattern "")
1365	(progn
1366	(setq matches (plcmp-anything-get-cached-candidates source))
1367	(if (> (length matches) plcmp-anything-candidate-number-limit)
1368	(setq matches
1369	(subseq matches 0 plcmp-anything-candidate-number-limit))))
1370	(condition-case nil
1371	(let ((item-count 0)
1372	(functions (assoc-default 'match source))
1373	exit
1374	;; cache option
1375	(cache (assq 'cache source))
1376	(name (assoc-default 'name source))
1377	)
1378	(unless functions
1379	(setq functions
1380	(list (lambda (candidate)
1381	(string-match plcmp-anything-pattern candidate)))))
1382	(dolist (function functions)
1383	(let (newmatches)
1384	;; get cache
1385	(dolist (candidate (or (plcmp-anything-get-cached-matched-candidates source) ;match cache
1386	(plcmp-anything-get-cached-candidates source)))
1387	(when (and (not (member candidate matches))
1388	(funcall function (if (listp candidate)
1389	(car candidate)
1390	candidate)))
1391	(push candidate newmatches)
1392
1393	(when (and plcmp-anything-candidate-number-limit
1394	(not cache))
1395	(incf item-count)
1396	(when (= item-count plcmp-anything-candidate-number-limit)
1397	(setq exit t)
1398	(return)))))
1399
1400	(setq matches (append matches (reverse newmatches)))
1401	(if exit
1402	(return))))
1403	;; return cached
1404	(cond ((assoc name plcmp-anything-matched-candidate-cache)
1405	(let* ((lst (assoc name plcmp-anything-matched-candidate-cache))
1406	(alist (rest lst)))
1407	(setcdr lst
1408	(add-to-list 'alist `(,plcmp-anything-pattern . ,matches)))))
1409	(t
1410	(push `(,name . ((,plcmp-anything-pattern . ,matches)))
1411	plcmp-anything-matched-candidate-cache)))
1412
1413	(plcmp-log "input %S \nmatches: %S\n" plcmp-anything-pattern matches))
1414	(invalid-regexp (setq matches nil))))
1415
1416	(let* ((transformer (assoc-default 'filtered-candidate-transformer source)))
1417	(if transformer
1418	(setq matches (funcall transformer matches source))))
1419	(when matches
1420	(plcmp-anything-insert-header (assoc-default 'name source))
1421	(dolist (match matches)
1422	(when (and plcmp-anything-enable-digit-shortcuts
1423	(not (eq plcmp-anything-digit-shortcut-count 9)))
1424	(move-overlay (nth plcmp-anything-digit-shortcut-count
1425	plcmp-anything-digit-overlays)
1426	(line-beginning-position)
1427	(line-beginning-position))
1428	(incf plcmp-anything-digit-shortcut-count))
1429	(plcmp-anything-insert-match match 'insert)))))
1430
1431	(defun plcmp-anything-execute-selection-action ()
1432	(let* ((selection (if plcmp-anything-saved-sources
1433	plcmp-anything-saved-selection
1434	(plcmp-anything-get-selection)))
1435	(action (or plcmp-anything-saved-action
1436	(if plcmp-anything-saved-sources
1437	(plcmp-anything-get-selection)
1438	(plcmp-anything-get-action)))))
1439	(if (and (listp action)
1440	(not (functionp action)))
1441	(setq action (cdar action)))
1442	(setq plcmp-anything-saved-action nil)
1443	(if (and selection action)
1444	(funcall action selection))))
1445
1446	;;; aything core
1447	(defvar plcmp-anything-sources nil)
1448	(defvar plcmp-anything-enable-digit-shortcuts nil )
1449	(defvar plcmp-anything-candidate-number-limit plcmp-anything-candidate-number-limit )
1450	(defvar plcmp-anything-idle-delay 0.5 )
1451	(defvar plcmp-anything-samewindow nil )
1452	(defvar plcmp-anything-source-filter nil )
1453	(defvar plcmp-anything-isearch-map
1454	(let ((map (copy-keymap (current-global-map))))
1455	(define-key map (kbd "<return>") 'plcmp-anything-isearch-default-action)
1456	(define-key map (kbd "C-i") 'plcmp-anything-isearch-select-action)
1457	(define-key map (kbd "C-g") 'plcmp-anything-isearch-cancel)
1458	(define-key map (kbd "M-s") 'plcmp-anything-isearch-again)
1459	(define-key map (kbd "<backspace>") 'plcmp-anything-isearch-delete)
1460	(let ((i 32))
1461	(while (< i 256)
1462	(define-key map (vector i) 'plcmp-anything-isearch-printing-char)
1463	(setq i (1+ i))))
1464	map))
1465	(defgroup plcmp-anything nil
1466	"Open plcmp-anything." :prefix "plcmp-anything-" :group 'convenience)
1467	(if (facep 'header-line)
1468	(copy-face 'header-line 'plcmp-anything-header)
1469	(defface plcmp-anything-header
1470	'((t (:bold t :underline t)))
1471	"Face for header lines in the plcmp-anything buffer." :group 'plcmp-anything))
1472	(defvar plcmp-anything-header-face 'plcmp-anything-header )
1473	(defface plcmp-anything-isearch-match '((t (:background "Yellow")))
1474	"Face for isearch in the plcmp-anything buffer." :group 'plcmp-anything)
1475	(defvar plcmp-anything-isearch-match-face 'plcmp-anything-isearch-match )
1476	(defvar plcmp-anything-iswitchb-idle-delay 1 )
1477	(defvar plcmp-anything-iswitchb-dont-touch-iswithcb-keys nil )
1478	(defconst plcmp-anything-buffer "perl-completion anything" )
1479	(defvar plcmp-anything-selection-overlay nil )
1480	(defvar plcmp-anything-isearch-overlay nil )
1481	(defvar plcmp-anything-digit-overlays nil )
1482	(defvar plcmp-anything-candidate-cache nil )
1483	(defvar plcmp-anything-pattern "")
1484	(defvar plcmp-anything-input "")
1485	(defvar plcmp-anything-async-processes nil )
1486	(defvar plcmp-anything-digit-shortcut-count 0 )
1487	(defvar plcmp-anything-update-hook nil )
1488	(defvar plcmp-anything-saved-sources nil )
1489	(defvar plcmp-anything-saved-selection nil )
1490	(defvar plcmp-anything-original-source-filter nil )
1491	(put 'plcmp-anything 'timid-completion 'disabled)
1492	(defun plcmp-anything-check-minibuffer-input ()
1493	(with-selected-window (minibuffer-window)
1494	(plcmp-anything-check-new-input (minibuffer-contents))))
1495	(defun plcmp-anything-check-new-input (input)
1496	(unless (equal input plcmp-anything-pattern)
1497	(setq plcmp-anything-pattern input)
1498	(unless plcmp-anything-saved-sources
1499	(setq plcmp-anything-input plcmp-anything-pattern))
1500	(plcmp-anything-update)))
1501	(defun plcmp-anything-update ()
1502	(setq plcmp-anything-digit-shortcut-count 0)
1503	(plcmp-anything-kill-async-processes)
1504	(with-current-buffer plcmp-anything-buffer
1505	(erase-buffer)
1506	(if plcmp-anything-enable-digit-shortcuts
1507	(dolist (overlay plcmp-anything-digit-overlays)
1508	(delete-overlay overlay)))
1509	(let (delayed-sources)
1510	(dolist (source (plcmp-anything-get-sources))
1511	(if (or (not plcmp-anything-source-filter)
1512	(member (assoc-default 'name source) plcmp-anything-source-filter))
1513	(if (equal plcmp-anything-pattern "")
1514	(unless (assoc 'requires-pattern source)
1515	(if (assoc 'delayed source)
1516	(push source delayed-sources)
1517	(plcmp-anything-process-source source)))
1518	(let ((min-pattern-length (assoc-default 'requires-pattern source)))
1519	(unless (and min-pattern-length
1520	(< (length plcmp-anything-pattern) min-pattern-length))
1521	(if (assoc 'delayed source)
1522	(push source delayed-sources)
1523	(plcmp-anything-process-source source)))))))
1524	(goto-char (point-min))
1525	(run-hooks 'plcmp-anything-update-hook)
1526	(plcmp-anything-next-line)
1527	(plcmp-anything-maybe-fit-frame)
1528	(run-with-idle-timer (if (featurep 'xemacs)
1529	0.1
1530	0)
1531	nil
1532	'plcmp-anything-process-delayed-sources
1533	delayed-sources))))
1534	(defun plcmp-anything-get-sources ()
1535	(mapcar (lambda (source)
1536	(let ((type (assoc-default 'type source)))
1537	(if type
1538	(append source (assoc-default type plcmp-anything-type-attributes) nil)
1539	source)))
1540	plcmp-anything-sources))
1541	;; (defun plcmp-anything-process-source (source)
1542	;; (let (matches)
1543	;; (if (equal plcmp-anything-pattern "")
1544	;; (progn
1545	;; (setq matches (plcmp-anything-get-cached-candidates source))
1546	;; (if (> (length matches) plcmp-anything-candidate-number-limit)
1547	;; (setq matches
1548	;; (subseq matches 0 plcmp-anything-candidate-number-limit))))
1549	;; (condition-case nil
1550	;; (let ((item-count 0)
1551	;; (functions (assoc-default 'match source))
1552	;; exit)
1553	;; (unless functions
1554	;; (setq functions
1555	;; (list (lambda (candidate)
1556	;; (string-match plcmp-anything-pattern candidate)))))
1557	;; (dolist (function functions)
1558	;; (let (newmatches)
1559	;; (dolist (candidate (plcmp-anything-get-cached-candidates source))
1560	;; (when (and (not (member candidate matches))
1561	;; (funcall function (if (listp candidate)
1562	;; (car candidate)
1563	;; candidate)))
1564	;; (push candidate newmatches)
1565	;; (when plcmp-anything-candidate-number-limit
1566	;; (incf item-count)
1567	;; (when (= item-count plcmp-anything-candidate-number-limit)
1568	;; (setq exit t)
1569	;; (return)))))
1570	;; (setq matches (append matches (reverse newmatches)))
1571	;; (if exit
1572	;; (return)))))
1573	;; (invalid-regexp (setq matches nil))))
1574	;; (let* ((transformer (assoc-default 'filtered-candidate-transformer source)))
1575	;; (if transformer
1576	;; (setq matches (funcall transformer matches source))))
1577	;; (when matches
1578	;; (plcmp-anything-insert-header (assoc-default 'name source))
1579	;; (dolist (match matches)
1580	;; (when (and plcmp-anything-enable-digit-shortcuts
1581	;; (not (eq plcmp-anything-digit-shortcut-count 9)))
1582	;; (move-overlay (nth plcmp-anything-digit-shortcut-count
1583	;; plcmp-anything-digit-overlays)
1584	;; (line-beginning-position)
1585	;; (line-beginning-position))
1586	;; (incf plcmp-anything-digit-shortcut-count))
1587	;; (plcmp-anything-insert-match match 'insert)))))
1588	(defun plcmp-anything-insert-match (match insert-function)
1589	(if (not (listp match))
1590	(funcall insert-function match)
1591	(funcall insert-function (car match))
1592	(put-text-property (line-beginning-position) (line-end-position)
1593	'plcmp-anything-realvalue (cdr match)))
1594	(funcall insert-function "\n"))
1595	(defun plcmp-anything-process-delayed-sources (delayed-sources)
1596	(if (sit-for plcmp-anything-idle-delay)
1597	(with-current-buffer plcmp-anything-buffer
1598	(save-excursion
1599	(goto-char (point-max))
1600	(dolist (source delayed-sources)
1601	(plcmp-anything-process-source source))
1602	(when (and (not (equal (buffer-size) 0))
1603	(= (overlay-start plcmp-anything-selection-overlay)
1604	(overlay-end plcmp-anything-selection-overlay)))
1605	(goto-char (point-min))
1606	(run-hooks 'plcmp-anything-update-hook)
1607	(plcmp-anything-next-line)))
1608	(plcmp-anything-maybe-fit-frame))))
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))
1631	;; Redefined above
1632	;; (defun plcmp-anything-execute-selection-action ()
1633	;; (let* ((selection (if plcmp-anything-saved-sources
1634	;; plcmp-anything-saved-selection
1635	;; (plcmp-anything-get-selection)))
1636	;; (action (if plcmp-anything-saved-sources
1637	;; (plcmp-anything-get-selection)
1638	;; (plcmp-anything-get-action))))
1639	;; (if (and (listp action)
1640	;; (not (functionp action)))
1641	;; (setq action (cdar action)))
1642	;; (if (and selection action)
1643	;; (funcall action selection))))
1644	(defun plcmp-anything-get-selection ()
1645	(unless (= (buffer-size (get-buffer plcmp-anything-buffer)) 0)
1646	(with-current-buffer plcmp-anything-buffer
1647	(let ((selection
1648	(or (get-text-property (overlay-start
1649	plcmp-anything-selection-overlay)
1650	'plcmp-anything-realvalue)
1651	(buffer-substring-no-properties
1652	(overlay-start plcmp-anything-selection-overlay)
1653	(1- (overlay-end plcmp-anything-selection-overlay))))))
1654	(unless (equal selection "")
1655	selection)))))
1656	(defun plcmp-anything-get-action ()
1657	(unless (= (buffer-size (get-buffer plcmp-anything-buffer)) 0)
1658	(let* ((source (plcmp-anything-get-current-source))
1659	(actions (assoc-default 'action source)))
1660	(let* ((transformer (assoc-default 'action-transformer source)))
1661	(if transformer
1662	(funcall transformer actions (plcmp-anything-get-selection))
1663	actions)))))
1664	(defun plcmp-anything-select-action ()
1665	(interactive)
1666	(if plcmp-anything-saved-sources
1667	(error "Already showing the action list"))
1668	(setq plcmp-anything-saved-selection (plcmp-anything-get-selection))
1669	(unless plcmp-anything-saved-selection
1670	(error "Nothing is selected."))
1671	(let ((actions (plcmp-anything-get-action)))
1672	(setq plcmp-anything-source-filter nil)
1673	(setq plcmp-anything-saved-sources plcmp-anything-sources)
1674	(setq plcmp-anything-sources `(((name . "Actions")
1675	(candidates . ,actions))))
1676	(with-selected-window (minibuffer-window)
1677	(delete-minibuffer-contents))
1678	(setq plcmp-anything-pattern 'dummy)
1679	(plcmp-anything-check-minibuffer-input)))
1680	(defun plcmp-anything-initialize ()
1681	(dolist (source (plcmp-anything-get-sources))
1682	(let ((init (assoc-default 'init source)))
1683	(if init
1684	(funcall init))))
1685	(setq plcmp-anything-pattern "")
1686	(setq plcmp-anything-input "")
1687	(setq plcmp-anything-candidate-cache nil)
1688	(setq plcmp-anything-saved-sources nil)
1689	(setq plcmp-anything-original-source-filter plcmp-anything-source-filter)
1690	(with-current-buffer (get-buffer-create plcmp-anything-buffer)
1691	(setq cursor-type nil)
1692	(setq mode-name "plcmp Anything"))
1693	(if plcmp-anything-selection-overlay
1694	(move-overlay plcmp-anything-selection-overlay (point-min) (point-min)
1695	(get-buffer plcmp-anything-buffer))
1696	(setq plcmp-anything-selection-overlay
1697	(make-overlay (point-min) (point-min) (get-buffer plcmp-anything-buffer)))
1698	(overlay-put plcmp-anything-selection-overlay 'face 'highlight))
1699	(if plcmp-anything-enable-digit-shortcuts
1700	(unless plcmp-anything-digit-overlays
1701	(dotimes (i 9)
1702	(push (make-overlay (point-min) (point-min)
1703	(get-buffer plcmp-anything-buffer))
1704	plcmp-anything-digit-overlays)
1705	(overlay-put (car plcmp-anything-digit-overlays)
1706	'before-string (concat (int-to-string (1+ i)) " - ")))
1707	(setq plcmp-anything-digit-overlays (nreverse plcmp-anything-digit-overlays)))
1708	(when plcmp-anything-digit-overlays
1709	(dolist (overlay plcmp-anything-digit-overlays)
1710	(delete-overlay overlay))
1711	(setq plcmp-anything-digit-overlays nil))))
1712	(defun plcmp-anything-cleanup ()
1713	(setq plcmp-anything-source-filter plcmp-anything-original-source-filter)
1714	(if plcmp-anything-saved-sources
1715	(setq plcmp-anything-sources plcmp-anything-saved-sources))
1716	(with-current-buffer plcmp-anything-buffer
1717	(setq cursor-type t))
1718	(bury-buffer plcmp-anything-buffer)
1719	(plcmp-anything-kill-async-processes))
1720	(defun plcmp-anything-previous-line ()
1721	(interactive)
1722	(plcmp-anything-move-selection 'line 'previous))
1723	(defun plcmp-anything-next-line ()
1724	(interactive)
1725	(plcmp-anything-move-selection 'line 'next))
1726	(defun plcmp-anything-previous-page ()
1727	(interactive)
1728	(plcmp-anything-move-selection 'page 'previous))
1729	(defun plcmp-anything-next-page ()
1730	(interactive)
1731	(plcmp-anything-move-selection 'page 'next))
1732	(defun plcmp-anything-previous-source ()
1733	(interactive)
1734	(plcmp-anything-move-selection 'source 'previous))
1735	(defun plcmp-anything-next-source ()
1736	(interactive)
1737	(plcmp-anything-move-selection 'source 'next))
1738	(defun plcmp-anything-move-selection (unit direction)
1739	(unless (or (= (buffer-size (get-buffer plcmp-anything-buffer)) 0)
1740	(not (get-buffer-window plcmp-anything-buffer 'visible)))
1741	(save-selected-window
1742	(select-window (get-buffer-window plcmp-anything-buffer 'visible))
1743	(case unit
1744	(line (forward-line (case direction
1745	(next 1)
1746	(previous -1)
1747	(t (error "Invalid direction.")))))
1748	(page (case direction
1749	(next (condition-case nil
1750	(scroll-up)
1751	(end-of-buffer (goto-char (point-max)))))
1752	(previous (condition-case nil
1753	(scroll-down)
1754	(beginning-of-buffer (goto-char (point-min)))))
1755	(t (error "Invalid direction."))))
1756	(source (case direction
1757	(next (goto-char (or (plcmp-anything-get-next-header-pos)
1758	(point-min))))
1759	(previous (progn
1760	(forward-line -1)
1761	(if (bobp)
1762	(goto-char (point-max))
1763	(if (plcmp-anything-pos-header-line-p)
1764	(forward-line -1)
1765	(forward-line 1)))
1766	(goto-char (plcmp-anything-get-previous-header-pos))
1767	(forward-line 1)))
1768	(t (error "Invalid direction."))))
1769	(t (error "Invalid unit.")))
1770	(while (plcmp-anything-pos-header-line-p)
1771	(forward-line (if (and (eq direction 'previous)
1772	(not (eq (line-beginning-position)
1773	(point-min))))
1774	-1
1775	1)))
1776	(if (eobp)
1777	(forward-line -1))
1778	(plcmp-anything-mark-current-line))))
1779	(defun plcmp-anything-mark-current-line ()
1780	(move-overlay plcmp-anything-selection-overlay
1781	(line-beginning-position)
1782	(1+ (line-end-position))))
1783	(defun plcmp-anything-select-with-digit-shortcut ()
1784	(interactive)
1785	(if plcmp-anything-enable-digit-shortcuts
1786	(let* ((index (- (event-basic-type (elt (this-command-keys-vector) 0)) ?1))
1787	(overlay (nth index plcmp-anything-digit-overlays)))
1788	(if (overlay-buffer overlay)
1789	(save-selected-window
1790	(select-window (get-buffer-window plcmp-anything-buffer 'visible))
1791	(goto-char (overlay-start overlay))
1792	(plcmp-anything-mark-current-line)
1793	(plcmp-anything-exit-minibuffer))))))
1794	(defun plcmp-anything-exit-minibuffer ()
1795	(interactive)
1796	(setq plcmp-anything-iswitchb-candidate-selected (plcmp-anything-get-selection))
1797	(exit-minibuffer))
1798	(defun plcmp-anything-get-current-source ()
1799	(with-current-buffer plcmp-anything-buffer
1800	(goto-char (overlay-start plcmp-anything-selection-overlay))
1801	(let* ((header-pos (plcmp-anything-get-previous-header-pos))
1802	(source-name
1803	(save-excursion
1804	(assert header-pos)
1805	(goto-char header-pos)
1806	(buffer-substring-no-properties
1807	(line-beginning-position) (line-end-position)))))
1808	(some (lambda (source)
1809	(if (equal (assoc-default 'name source)
1810	source-name)
1811	source))
1812	(plcmp-anything-get-sources)))))
1813	(defun plcmp-anything-get-next-header-pos ()
1814	(next-single-property-change (point) 'plcmp-anything-header))
1815	(defun plcmp-anything-get-previous-header-pos ()
1816	(previous-single-property-change (point) 'plcmp-anything-header))
1817	(defun plcmp-anything-pos-header-line-p ()
1818	(or (get-text-property (line-beginning-position) 'plcmp-anything-header)
1819	(get-text-property (line-beginning-position) 'plcmp-anything-header-separator)))
1820	(defun plcmp-anything-get-candidates (source)
1821	(let* ((candidate-source (assoc-default 'candidates source))
1822	(candidates
1823	(if (functionp candidate-source)
1824	(funcall candidate-source)
1825	(if (listp candidate-source)
1826	candidate-source
1827	(if (and (symbolp candidate-source)
1828	(boundp candidate-source))
1829	(symbol-value candidate-source)
1830	(error (concat "Candidates must either be a function, "
1831	" a variable or a list: %s")
1832	candidate-source))))))
1833	(if (processp candidates)
1834	candidates
1835	(plcmp-anything-transform-candidates candidates source))))
1836	(defun plcmp-anything-transform-candidates (candidates source)
1837	(let* ((transformer (assoc-default 'candidate-transformer source)))
1838	(if transformer
1839	(funcall transformer candidates)
1840	candidates)))
1841	(defun plcmp-anything-get-cached-candidates (source)
1842	(let* ((name (assoc-default 'name source))
1843	(candidate-cache (assoc name plcmp-anything-candidate-cache))
1844	candidates)
1845	(if candidate-cache
1846	(setq candidates (cdr candidate-cache))
1847	(setq candidates (plcmp-anything-get-candidates source))
1848	(if (processp candidates)
1849	(progn
1850	(push (cons candidates
1851	(append source
1852	(list (cons 'item-count 0)
1853	(cons 'incomplete-line ""))))
1854	plcmp-anything-async-processes)
1855	(set-process-filter candidates 'plcmp-anything-output-filter)
1856	(setq candidates nil))
1857	(unless (assoc 'volatile source)
1858	(setq candidate-cache (cons name candidates))
1859	(push candidate-cache plcmp-anything-candidate-cache))))
1860	candidates))
1861	(defun plcmp-anything-output-filter (process string)
1862	(let* ((process-assoc (assoc process plcmp-anything-async-processes))
1863	(process-info (cdr process-assoc))
1864	(insertion-marker (assoc-default 'insertion-marker process-info))
1865	(incomplete-line-info (assoc 'incomplete-line process-info))
1866	(item-count-info (assoc 'item-count process-info)))
1867	(with-current-buffer plcmp-anything-buffer
1868	(save-excursion
1869	(if insertion-marker
1870	(goto-char insertion-marker)
1871	(goto-char (point-max))
1872	(plcmp-anything-insert-header (assoc-default 'name process-info))
1873	(setcdr process-assoc
1874	(append process-info `((insertion-marker . ,(point-marker))))))
1875	(let ((lines (split-string string "\n"))
1876	candidates)
1877	(while lines
1878	(if (not (cdr lines))
1879	(setcdr incomplete-line-info (car lines))
1880	(if (cdr incomplete-line-info)
1881	(progn
1882	(push (concat (cdr incomplete-line-info) (car lines))
1883	candidates)
1884	(setcdr incomplete-line-info nil))
1885	(push (car lines) candidates)))
1886	(pop lines))
1887	(setq candidates (reverse candidates))
1888	(dolist (candidate (plcmp-anything-transform-candidates candidates process-info))
1889	(plcmp-anything-insert-match candidate 'insert-before-markers)
1890	(incf (cdr item-count-info))
1891	(when (>= (cdr item-count-info) plcmp-anything-candidate-number-limit)
1892	(plcmp-anything-kill-async-process process)
1893	(return)))))
1894	(plcmp-anything-maybe-fit-frame)
1895	(run-hooks 'plcmp-anything-update-hook)
1896	(if (bobp)
1897	(plcmp-anything-next-line)
1898	(save-selected-window
1899	(select-window (get-buffer-window plcmp-anything-buffer 'visible))
1900	(plcmp-anything-mark-current-line))))))
1901	(defun plcmp-anything-kill-async-processes ()
1902	(dolist (process-info plcmp-anything-async-processes)
1903	(plcmp-anything-kill-async-process (car process-info)))
1904	(setq plcmp-anything-async-processes nil))
1905	(defun plcmp-anything-kill-async-process (process)
1906	(set-process-filter process nil)
1907	(delete-process process))
1908	(defun plcmp-anything-insert-header (name)
1909	(unless (bobp)
1910	(let ((start (point)))
1911	(insert "\n")
1912	(put-text-property start (point) 'plcmp-anything-header-separator t)))
1913	(let ((start (point)))
1914	(insert name)
1915	(put-text-property (line-beginning-position)
1916	(line-end-position) 'plcmp-anything-header t)
1917	(insert "\n")
1918	(put-text-property start (point) 'face plcmp-anything-header-face)))
1919	(defun plcmp-anything-set-source-filter (sources)
1920	(setq plcmp-anything-source-filter sources)
1921	(plcmp-anything-update))
1922	(defun plcmp-anything-maybe-fit-frame ()
1923	(when (and (require 'fit-frame nil t)
1924	(boundp 'fit-frame-inhibit-fitting-flag)
1925	(not fit-frame-inhibit-fitting-flag)
1926	(get-buffer-window plcmp-anything-buffer 'visible))
1927	(with-selected-window (get-buffer-window plcmp-anything-buffer 'visible)
1928	(fit-frame nil nil nil t)
1929	(modify-frame-parameters
1930	(selected-frame)
1931	`((left . ,(- (x-display-pixel-width) (+ (frame-pixel-width) 7)))
1932	(top . 0))))))
1933	(defvar plcmp-anything-isearch-original-global-map nil )
1934	(defvar plcmp-anything-isearch-original-message-timeout nil )
1935	(defvar plcmp-anything-isearch-pattern nil )
1936	(defvar plcmp-anything-isearch-message-suffix "" )
1937	(defvar plcmp-anything-isearch-original-point nil )
1938	(defvar plcmp-anything-isearch-original-window nil )
1939	(defvar plcmp-anything-isearch-original-cursor-in-non-selected-windows nil )
1940	(defvar plcmp-anything-isearch-original-post-command-hook nil )
1941	(defvar plcmp-anything-isearch-match-positions nil )
1942	(defvar plcmp-anything-isearch-match-start nil )
1943	(defun plcmp-anything-isearch ()
1944	(interactive)
1945	(if (eq (buffer-size (get-buffer plcmp-anything-buffer)) 0)
1946	(message "There are no results.")
1947	(setq plcmp-anything-isearch-original-message-timeout minibuffer-message-timeout)
1948	(setq minibuffer-message-timeout nil)
1949	(setq plcmp-anything-isearch-original-global-map global-map)
1950	(condition-case nil
1951	(progn
1952	(setq plcmp-anything-isearch-original-window (selected-window))
1953	(select-window (get-buffer-window plcmp-anything-buffer 'visible))
1954	(setq cursor-type t)
1955	(setq plcmp-anything-isearch-original-post-command-hook
1956	(default-value 'post-command-hook))
1957	(setq-default post-command-hook nil)
1958	(add-hook 'post-command-hook 'plcmp-anything-isearch-post-command)
1959	(use-global-map plcmp-anything-isearch-map)
1960	(setq overriding-terminal-local-map plcmp-anything-isearch-map)
1961	(setq plcmp-anything-isearch-pattern "")
1962	(setq plcmp-anything-isearch-original-cursor-in-non-selected-windows
1963	cursor-in-non-selected-windows)
1964	(setq cursor-in-non-selected-windows nil)
1965	(setq plcmp-anything-isearch-original-point (point-marker))
1966	(goto-char (point-min))
1967	(forward-line)
1968	(plcmp-anything-mark-current-line)
1969	(setq plcmp-anything-isearch-match-positions nil)
1970	(setq plcmp-anything-isearch-match-start (point-marker))
1971	(if plcmp-anything-isearch-overlay
1972	(move-overlay plcmp-anything-isearch-overlay (point-min) (point-min)
1973	(get-buffer plcmp-anything-buffer))
1974	(setq plcmp-anything-isearch-overlay (make-overlay (point-min) (point-min)))
1975	(overlay-put plcmp-anything-isearch-overlay 'face plcmp-anything-isearch-match-face))
1976	(setq plcmp-anything-isearch-message-suffix
1977	(substitute-command-keys "cancel with \\[plcmp-anything-isearch-cancel]")))
1978	(error (plcmp-anything-isearch-cleanup)))))
1979	(defun plcmp-anything-isearch-post-command ()
1980	(plcmp-anything-isearch-message)
1981	(when (get-buffer-window plcmp-anything-buffer 'visible)
1982	(with-selected-window (get-buffer-window plcmp-anything-buffer 'visible)
1983	(move-overlay plcmp-anything-isearch-overlay plcmp-anything-isearch-match-start (point)
1984	(get-buffer plcmp-anything-buffer)))))
1985	(defun plcmp-anything-isearch-printing-char ()
1986	(interactive)
1987	(let ((char (char-to-string last-command-char)))
1988	(setq plcmp-anything-isearch-pattern (concat plcmp-anything-isearch-pattern char))
1989	(with-selected-window (get-buffer-window plcmp-anything-buffer 'visible)
1990	(if (looking-at char)
1991	(progn
1992	(push (list 'event 'char
1993	'start plcmp-anything-isearch-match-start
1994	'pos (point-marker))
1995	plcmp-anything-isearch-match-positions)
1996	(forward-char))
1997	(let ((start (point)))
1998	(while (and (re-search-forward plcmp-anything-isearch-pattern nil t)
1999	(plcmp-anything-pos-header-line-p)))
2000	(if (or (plcmp-anything-pos-header-line-p)
2001	(eq start (point)))
2002	(progn
2003	(goto-char start)
2004	(push (list 'event 'error
2005	'start plcmp-anything-isearch-match-start
2006	'pos (point-marker))
2007	plcmp-anything-isearch-match-positions))
2008	(push (list 'event 'search
2009	'start plcmp-anything-isearch-match-start
2010	'pos (copy-marker start))
2011	plcmp-anything-isearch-match-positions)
2012	(setq plcmp-anything-isearch-match-start (copy-marker (match-beginning 0))))))
2013	(plcmp-anything-mark-current-line))))
2014	(defun plcmp-anything-isearch-again ()
2015	(interactive)
2016	(if (equal plcmp-anything-isearch-pattern "")
2017	(setq plcmp-anything-isearch-message-suffix "no pattern yet")
2018	(with-selected-window (get-buffer-window plcmp-anything-buffer 'visible)
2019	(let ((start (point)))
2020	(while (and (re-search-forward plcmp-anything-isearch-pattern nil t)
2021	(plcmp-anything-pos-header-line-p)))
2022	(if (or (plcmp-anything-pos-header-line-p)
2023	(eq start (point)))
2024	(progn
2025	(goto-char start)
2026	(unless (eq 'error (plist-get (car plcmp-anything-isearch-match-positions)
2027	'event))
2028	(setq plcmp-anything-isearch-message-suffix "no more matches")))
2029	(push (list 'event 'search-again
2030	'start plcmp-anything-isearch-match-start
2031	'pos (copy-marker start))
2032	plcmp-anything-isearch-match-positions)
2033	(setq plcmp-anything-isearch-match-start (copy-marker (match-beginning 0)))
2034	(plcmp-anything-mark-current-line))))))
2035	(defun plcmp-anything-isearch-delete ()
2036	(interactive)
2037	(unless (equal plcmp-anything-isearch-pattern "")
2038	(let ((last (pop plcmp-anything-isearch-match-positions)))
2039	(unless (eq 'search-again (plist-get last 'event))
2040	(setq plcmp-anything-isearch-pattern
2041	(substring plcmp-anything-isearch-pattern 0 -1)))
2042	(with-selected-window (get-buffer-window plcmp-anything-buffer 'visible)
2043	(goto-char (plist-get last 'pos))
2044	(setq plcmp-anything-isearch-match-start (plist-get last 'start))
2045	(plcmp-anything-mark-current-line)))))
2046	(defun plcmp-anything-isearch-default-action ()
2047	(interactive)
2048	(plcmp-anything-isearch-cleanup)
2049	(with-current-buffer plcmp-anything-buffer (plcmp-anything-exit-minibuffer)))
2050	(defun plcmp-anything-isearch-select-action ()
2051	(interactive)
2052	(plcmp-anything-isearch-cleanup)
2053	(with-selected-window (get-buffer-window plcmp-anything-buffer 'visible)
2054	(plcmp-anything-select-action)))
2055	(defun plcmp-anything-isearch-cancel ()
2056	(interactive)
2057	(plcmp-anything-isearch-cleanup)
2058	(when (get-buffer-window plcmp-anything-buffer 'visible)
2059	(with-selected-window (get-buffer-window plcmp-anything-buffer 'visible)
2060	(goto-char plcmp-anything-isearch-original-point)
2061	(plcmp-anything-mark-current-line))))
2062	(defun plcmp-anything-isearch-cleanup ()
2063	(setq minibuffer-message-timeout plcmp-anything-isearch-original-message-timeout)
2064	(with-current-buffer plcmp-anything-buffer
2065	(setq overriding-terminal-local-map nil)
2066	(setq cursor-type nil)
2067	(setq cursor-in-non-selected-windows
2068	plcmp-anything-isearch-original-cursor-in-non-selected-windows))
2069	(when plcmp-anything-isearch-original-window
2070	(select-window plcmp-anything-isearch-original-window))
2071	(use-global-map plcmp-anything-isearch-original-global-map)
2072	(setq-default post-command-hook plcmp-anything-isearch-original-post-command-hook)
2073	(when (overlayp plcmp-anything-isearch-overlay)
2074	(delete-overlay plcmp-anything-isearch-overlay)))
2075	(defun plcmp-anything-isearch-message ()
2076	(if (and (equal plcmp-anything-isearch-message-suffix "")
2077	(eq (plist-get (car plcmp-anything-isearch-match-positions) 'event)
2078	'error))
2079	(setq plcmp-anything-isearch-message-suffix "failing"))
2080	(unless (equal plcmp-anything-isearch-message-suffix "")
2081	(setq plcmp-anything-isearch-message-suffix
2082	(concat " [" plcmp-anything-isearch-message-suffix "]")))
2083	(message (concat "Search within results: "
2084	plcmp-anything-isearch-pattern
2085	plcmp-anything-isearch-message-suffix))
2086	(setq plcmp-anything-isearch-message-suffix ""))
2087	(defvar plcmp-anything-iswitchb-candidate-selected nil )
2088	(defvar plcmp-anything-iswitchb-frame-configuration nil )
2089	(defvar plcmp-anything-iswitchb-saved-keys nil )
2090	(defun plcmp-anything-iswitchb-setup ()
2091	(interactive)
2092	(require 'iswitchb)
2093	(put 'iswitchb-buffer 'timid-completion 'disabled)
2094	(add-hook 'minibuffer-setup-hook 'plcmp-anything-iswitchb-minibuffer-setup)
2095	(defadvice iswitchb-visit-buffer
2096	(around plcmp-anything-iswitchb-visit-buffer activate)
2097	(if plcmp-anything-iswitchb-candidate-selected
2098	(plcmp-anything-execute-selection-action)
2099	ad-do-it))
2100	(defadvice iswitchb-possible-new-buffer
2101	(around plcmp-anything-iswitchb-possible-new-buffer activate)
2102	(if plcmp-anything-iswitchb-candidate-selected
2103	(plcmp-anything-execute-selection-action)
2104	ad-do-it))
2105	(message "Iswitchb integration is activated."))
2106	(defun plcmp-anything-iswitchb-minibuffer-setup ()
2107	(when (eq this-command 'iswitchb-buffer)
2108	(add-hook 'minibuffer-exit-hook 'plcmp-anything-iswitchb-minibuffer-exit)
2109	(setq plcmp-anything-iswitchb-frame-configuration nil)
2110	(setq plcmp-anything-iswitchb-candidate-selected nil)
2111	(add-hook 'plcmp-anything-update-hook 'plcmp-anything-iswitchb-handle-update)
2112	(plcmp-anything-initialize)
2113	(add-hook 'post-command-hook 'plcmp-anything-iswitchb-check-input)))
2114	(defun plcmp-anything-iswitchb-minibuffer-exit ()
2115	(remove-hook 'minibuffer-exit-hook 'plcmp-anything-iswitchb-minibuffer-exit)
2116	(remove-hook 'post-command-hook 'plcmp-anything-iswitchb-check-input)
2117	(remove-hook 'plcmp-anything-update-hook 'plcmp-anything-iswitchb-handle-update)
2118	(plcmp-anything-cleanup)
2119	(when plcmp-anything-iswitchb-frame-configuration
2120	(set-frame-configuration plcmp-anything-iswitchb-frame-configuration)
2121	(setq plcmp-anything-iswitchb-frame-configuration nil)))
2122	(defun plcmp-anything-iswitchb-check-input ()
2123	(if (or plcmp-anything-iswitchb-frame-configuration
2124	(sit-for plcmp-anything-iswitchb-idle-delay))
2125	(plcmp-anything-check-new-input iswitchb-text)))
2126	(defun plcmp-anything-iswitchb-handle-update ()
2127	(unless (or (equal (buffer-size (get-buffer plcmp-anything-buffer)) 0)
2128	plcmp-anything-iswitchb-frame-configuration)
2129	(setq plcmp-anything-iswitchb-frame-configuration (current-frame-configuration))
2130	(save-selected-window
2131	(if (not plcmp-anything-samewindow)
2132	(pop-to-buffer plcmp-anything-buffer)
2133	(select-window (get-lru-fwindow))
2134	(switch-to-buffer plcmp-anything-buffer)))
2135	(with-current-buffer (window-buffer (active-minibuffer-window))
2136	(let* ((plcmp-anything-prefix "plcmp-anything-")
2137	(prefix-length (length plcmp-anything-prefix))
2138	(commands
2139	(delete-dups
2140	(remove-if 'null
2141	(mapcar
2142	(lambda (binding)
2143	(let ((command (cdr binding)))
2144	(when (and (symbolp command)
2145	(eq (compare-strings
2146	plcmp-anything-prefix
2147	0 prefix-length
2148	(symbol-name command)
2149	0 prefix-length)
2150	t))
2151	command)))
2152	(cdr plcmp-anything-map)))))
2153	(bindings (mapcar (lambda (command)
2154	(cons command
2155	(where-is-internal command plcmp-anything-map)))
2156	commands)))
2157	(push (list 'plcmp-anything-iswitchb-cancel-anything (kbd "<ESC>"))
2158	bindings)
2159	(setq plcmp-anything-iswitchb-saved-keys nil)
2160	(let* ((iswitchb-prefix "iswitchb-")
2161	(prefix-length (length iswitchb-prefix)))
2162	(dolist (binding bindings)
2163	(dolist (key (cdr binding))
2164	(let ((old-command (lookup-key (current-local-map) key)))
2165	(unless (and plcmp-anything-iswitchb-dont-touch-iswithcb-keys
2166	(symbolp old-command)
2167	(eq (compare-strings iswitchb-prefix
2168	0 prefix-length
2169	(symbol-name old-command)
2170	0 prefix-length)
2171	t))
2172	(push (cons key old-command)
2173	plcmp-anything-iswitchb-saved-keys)
2174	(define-key (current-local-map) key (car binding)))))))))))
2175	(defun plcmp-anything-iswitchb-cancel-anything ()
2176	(interactive)
2177	(save-excursion
2178	(dolist (binding plcmp-anything-iswitchb-saved-keys)
2179	(define-key (current-local-map) (car binding) (cdr binding)))
2180	(plcmp-anything-iswitchb-minibuffer-exit)))
2181	(unless (fboundp 'assoc-default)
2182	(defun assoc-default (key alist &optional test default)
2183	(let (found (tail alist) value)
2184	(while (and tail (not found))
2185	(let ((elt (car tail)))
2186	(when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
2187	(setq found t value (if (consp elt) (cdr elt) default))))
2188	(setq tail (cdr tail)))
2189	value)))
2190	(unless (fboundp 'minibuffer-contents)
2191	(defun minibuffer-contents ()
2192	(field-string (point-max)))
2193	(defun delete-minibuffer-contents ()
2194	(delete-field (point-max))))
2195
2196	;;; compatibility anything-execute-persistent-action
2197	;;; written by rubikitch see http://d.hatena.ne.jp/rubikitch/20071228/anythingpersistent (japanese)
2198	(defun plcmp-anything-execute-persistent-action ()
2199	"If a candidate was selected then perform the associated action without quitting anything."
2200	(interactive)
2201	(save-selected-window
2202	(select-window (get-buffer-window plcmp-anything-buffer))
2203	(select-window (setq minibuffer-scroll-window
2204	(if (one-window-p t) (split-window) (next-window (selected-window) 1))))
2205	(let* ((plcmp-anything-window (get-buffer-window plcmp-anything-buffer))
2206	(selection (if plcmp-anything-saved-sources
2207	;; the action list is shown
2208	plcmp-anything-saved-selection
2209	(plcmp-anything-get-selection)))
2210	(default-action (plcmp-anything-get-action))
2211	(action (assoc-default 'persistent-action (plcmp-anything-get-current-source))))
2212	(setq action (or action default-action))
2213	(if (and (listp action)
2214	(not (functionp action))) ; lambda
2215	;; select the default action
2216	(setq action (cdar action)))
2217	(set-window-dedicated-p plcmp-anything-window t)
2218	(unwind-protect
2219	(and action selection (funcall action selection))
2220	(set-window-dedicated-p plcmp-anything-window nil)))))
2221
2222	;;; perl-completion.el ends here

Note: See TracBrowser for help on using the browser.

Context Navigation

root/lang/elisp/perl-completion/trunk/perl-completion.el @ 14626

Download in other formats: