Index: /dotfiles/emacs/yappo/.emacs =================================================================== --- /dotfiles/emacs/yappo/.emacs (revision 26364) +++ /dotfiles/emacs/yappo/.emacs (revision 26364) @@ -0,0 +1,32 @@ +(display-time) +(setq make-backup-files nil) +(setq scroll-step 1) + + +;; 引数をload-pathへ追加する +(defun add-to-load-path (&rest paths) + (mapc '(lambda (path) + (add-to-list 'load-path path)) + (mapcar 'expand-file-name paths))) + +;; elispと設定ファイルのディレクトリをload-pathに追加 +(add-to-load-path "~/.emacs.d/elisp" + "~/.emacs.d/conf") + +(require 'anything-config) +(require 'perl-completion) +(perl-completion-mode t) +(require 'auto-complete) +(global-auto-complete-mode t) + + +(autoload 'javascript-mode "javascript-mode" "JavaScript mode" t) +(autoload 'c-mode "c-mode" "C mode" t) + +(load "init-siteconf") +(load "init-perl") +(load "init-javascript") + +(defun my-insert-date () + (interactive) + (insert (format-time-string "%Y-%m-%dT%R:%S+09:00" (current-time)))) Index: /dotfiles/emacs/yappo/.emacs.d/conf/perl.el =================================================================== --- /dotfiles/emacs/yappo/.emacs.d/conf/perl.el (revision 26364) +++ /dotfiles/emacs/yappo/.emacs.d/conf/perl.el (revision 26364) @@ -0,0 +1,27 @@ + +;;; cperl-mode +(add-to-list 'interpreter-mode-alist '("perl" . cperl-mode)) ;; +(setq auto-mode-alist (cons '("\\.\\([pP][Llm]\\|t\\)$" . cperl-mode) auto-mode-alist) ) +(defalias 'perl-mode 'cperl-mode) + +(setq cperl-indent-level 4) +(setq cperl-indent-maybe-tab nil) +(setq cperl-continued-statement-offset 4) +(setq cperl-comment-column 40) + +(set-face-italic-p 'cperl-hash-face nil) +(set-face-background 'cperl-hash-face nil) +(set-face-background 'cperl-array-face nil) +(setq cperl-array-face 'font-lock-variable-name-face) +(setq cperl-hash-face 'font-variable-name-face) + +(define-key cperl-mode-map "\C-c\C-c" 'cperl-comment-region) ;; C-c C-cでコメントアウト +(define-key cperl-mode-map "\C-u\C-c\C-c" 'uncomment-region) ;; cperl-uncomment-region is buggy + + + +(add-hook 'cperl-mode-hook + '(lambda () + (setq indent-tabs-mode nil))) + + Index: /dotfiles/emacs/yappo/.emacs.d/conf/init-perl.el =================================================================== --- /dotfiles/emacs/yappo/.emacs.d/conf/init-perl.el (revision 26364) +++ /dotfiles/emacs/yappo/.emacs.d/conf/init-perl.el (revision 26364) @@ -0,0 +1,46 @@ + +;;; cperl-mode +(add-to-list 'interpreter-mode-alist '("perl" . cperl-mode)) ;; +;(setq auto-mode-alist (cons '("\\.\\([pP][Llm]\\|t\\)$" . perl-completion-mode) auto-mode-alist) ) +(setq auto-mode-alist (cons '("\\.\\([pP][Llm]\\|t\\)$" . cperl-mode) auto-mode-alist) ) +(defalias 'perl-mode 'cperl-mode) + +(setq cperl-close-paren-offset -4) +(setq cperl-continued-statement-offset 4) +(setq cperl-indent-level 4) +(setq cperl-indent-parens-as-block t) +(setq cperl-label-offset -4) +(setq cperl-highlight-variables-indiscriminately t) + +;; faces +;(set-face-bold-p 'cperl-array-face nil) +;(set-face-background 'cperl-array-face "blightblue") +;(set-face-bold-p 'cperl-hash-face nil) +;(set-face-italic-p 'cperl-hash-face nil) +;(set-face-background 'cperl-hash-face "blightblue") + + + +;(setq cperl-indent-level 4) +;(setq cperl-indent-maybe-tab nil) +;(setq cperl-continued-statement-offset 4) +;(setq cperl-comment-column 40) + +;(set-face-italic-p 'cperl-hash-face nil) +;(set-face-background 'cperl-hash-face nil) +;(set-face-background 'cperl-array-face nil) +;(setq cperl-array-face 'font-lock-variable-name-face) +;(setq cperl-hash-face 'font-variable-name-face) + +(add-hook 'cperl-mode-hook + '(lambda () + (setq indent-tabs-mode nil) + (setq cperl-font-lock t) + (cperl-set-style "PerlStyle") + )) + + +(add-hook 'cperl-mode-hook + (lambda () + (require 'perl-completion) + (add-to-list 'ac-sources 'ac-source-perl-completion))) Index: /dotfiles/emacs/yappo/.emacs.d/conf/javascript.el =================================================================== --- /dotfiles/emacs/yappo/.emacs.d/conf/javascript.el (revision 26364) +++ /dotfiles/emacs/yappo/.emacs.d/conf/javascript.el (revision 26364) @@ -0,0 +1,3 @@ +(add-hook 'java-mode-hook + '(lambda () + (setq indent-tabs-mode nil))) Index: /dotfiles/emacs/yappo/.emacs.d/conf/init-javascript.el =================================================================== --- /dotfiles/emacs/yappo/.emacs.d/conf/init-javascript.el (revision 26364) +++ /dotfiles/emacs/yappo/.emacs.d/conf/init-javascript.el (revision 26364) @@ -0,0 +1,8 @@ +(setq auto-mode-alist (cons '("\\.js$" . javascript-mode) auto-mode-alist) ) + +(add-hook 'javascript-mode-hook + '(lambda () + (setq indent-tabs-mode nil) + )) + + Index: /dotfiles/emacs/yappo/.emacs.d/elisp/anything.el =================================================================== --- /dotfiles/emacs/yappo/.emacs.d/elisp/anything.el (revision 26364) +++ /dotfiles/emacs/yappo/.emacs.d/elisp/anything.el (revision 26364) @@ -0,0 +1,4219 @@ +;;; anything.el --- open anything / QuickSilver-like candidate-selection framework +;; $Id: anything.el,v 1.136 2008/10/27 17:41:27 rubikitch Exp $ + +;; Copyright (C) 2007 Tamas Patrovics +;; 2008 rubikitch + +;; Author: Tamas Patrovics +;; Maintainer: rubikitch +;; Keywords: files, frames, help, matching, outlines, processes, tools, convenience, anything +;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything.el +;; Site: http://www.emacswiki.org/cgi-bin/emacs/Anything + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; +;; Start with M-x anything, narrow the list by typing some pattern, +;; select with up/down/pgup/pgdown, choose with enter, left/right +;; moves between sources. With TAB actions can be selected if the +;; selected candidate has more than one possible action. +;; +;; Note that anything.el provides only the framework and some example +;; configurations for demonstration purposes. See anything-config.el +;; for practical, polished, easy to use configurations which can be +;; used to assemble a custom personalized configuration. And many +;; other configurations are in the EmacsWiki. +;; +;; http://www.emacswiki.org/cgi-bin/wiki/download/anything-config.el +;; http://www.emacswiki.org/cgi-bin/emacs/AnythingSources +;; +;; Maintainer's configuration is in the EmacsWiki. It would tell you +;; many tips to write smart sources! +;; +;; http://www.emacswiki.org/cgi-bin/emacs/RubikitchAnythingConfiguration + +;; You can extend `anything' by writing plug-ins. As soon as +;; `anything' is invoked, `anything-sources' is compiled into basic +;; attributes, then compiled one is used during invocation. +;; +;; The oldest built-in plug-in is `type' attribute: appends +;; appropriate element of `anything-type-attributes'. Second built-in +;; plug-in is `candidates-in-buffer': selecting a line from candidates +;; buffer. +;; +;; To write a plug-in: +;; 1. Define a compiler: anything-compile-source--* +;; 2. Add compier function to `anything-compile-source-functions'. +;; 3. (optional) Write helper functions. +;; +;; Anything plug-ins are found in the EmacsWiki. +;; +;; http://www.emacswiki.org/cgi-bin/emacs/AnythingPlugins + +;; Tested on Emacs 22. +;; +;; +;; Thanks to Vagn Johansen for ideas. +;; Thanks to Stefan Kamphausen for fixes and XEmacs support. +;; Thanks to Tassilo Horn for fixes. +;; Thanks to Drew Adams for various fixes (frame, isearch, customization, etc.) +;; Thanks to IMAKADO for candidates-in-buffer idea. +;; Thanks to Tomohiro MATSUYAMA for multiline patch. +;; + +;;; (@* "Index") + +;; If you have library `linkd.el', load +;; `linkd.el' and turn on `linkd-mode' now. It lets you easily +;; navigate around the sections Linkd mode will +;; highlight this Index. You can get `linkd.el' here: +;; http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el +;; + + +;;; (@* "INCOMPATIBLE CHANGES") + +;; v1.114 +;; +;; `anything-attr' returns nil when the source attribute is defined +;; but the value of attribute is nil, eg. (volatile) cell. Use +;; `anything-attr-defined' when testing whether the attribute is +;; defined. + +;;; (@* "Tips") + +;; +;; `set-frame-configuration' arises flickering. If you hate +;; flickering, eval: +;; (setq anything-save-configuration-functions +;; '(set-window-configuration . current-window-configuration)) +;; at the cost of restoring frame configuration (only window configuration). + +;; +;; `anything-delete-current-selection' deletes the current line. +;; It is useful when deleting a candidate in persistent action. +;; eg. `kill-buffer'. +;; +;; [EVAL IT] (describe-function 'anything-delete-current-selection) + +;; +;; `anything-attr' gets the attribute. `anything-attrset' sets the +;; attribute. `anything-attr-defined' tests whether the attribute is +;; defined. They handles source-local variables. +;; +;; [EVAL IT] (describe-function 'anything-attr) +;; [EVAL IT] (describe-function 'anything-attrset) +;; [EVAL IT] (describe-function 'anything-attr-defined) + +;; +;; `anything-sources' accepts many attributes to make your life easier. +;; Now `anything-sources' accepts a list of symbols. +;; +;; [EVAL IT] (describe-variable 'anything-sources) + +;; +;; `anything' has optional arguments. Now you do not have to let-bind +;; `anything-sources'. +;; +;; [EVAL IT] (describe-function 'anything) + +;; +;; `anything-resume' resumes last `anything' session. Now you do not +;; have to retype pattern. +;; +;; [EVAL IT] (describe-function 'anything-resume) + +;; +;; `anything-execute-persistent-action' executes action without +;; quitting `anything'. When popping up a buffer in other window by +;; persistent action, you can scroll with `anything-scroll-other-window' and +;; `anything-scroll-other-window-down'. See also `anything-sources' docstring. +;; +;; [EVAL IT] (describe-function 'anything-execute-persistent-action) +;; [EVAL IT] (describe-variable 'anything-sources) + +;; +;; `anything-select-2nd-action', `anything-select-3rd-action' and +;; `anything-select-4th-action' select other than default action +;; without pressing Tab. + +;; +;; Using `anything-candidate-buffer' and the candidates-in-buffer +;; attribute is much faster than traditional "candidates and match" +;; way. And `anything-current-buffer-is-modified' avoids to +;; recalculate candidates for unmodified buffer. See docstring of +;; them. +;; +;; [EVAL IT] (describe-function 'anything-candidate-buffer) +;; [EVAL IT] (describe-function 'anything-candidates-in-buffer) +;; [EVAL IT] (describe-function 'anything-current-buffer-is-modified) + +;; +;; `anything-current-buffer' and `anything-buffer-file-name' stores +;; `(current-buffer)' and `buffer-file-name' in the buffer `anything' +;; is invoked. Use them freely. +;; +;; [EVAL IT] (describe-variable 'anything-current-buffer) +;; [EVAL IT] (describe-variable 'anything-buffer-file-name) + +;; +;; `anything-completing-read' and `anything-read-file-name' are +;; experimental implementation. If you are curious, type M-x +;; anything-read-string-mode. It is a minor mode and toggles on/off. + +;; +;; Use `anything-test-candidates' to test your handmade anything +;; sources. It simulates contents of *anything* buffer with pseudo +;; `anything-sources' and `anything-pattern', without side-effect. So +;; you can unit-test your anything sources! Let's TDD! +;; +;; [EVAL IT] (describe-function 'anything-test-candidates) +;; +;; There are many unit-testing framework in Emacs Lisp. See the EmacsWiki. +;; http://www.emacswiki.org/cgi-bin/emacs/UnitTesting +;; +;; There is an unit-test by Emacs Lisp Expectations at the tail of this file. +;; http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el +;; http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el + + +;; (@* "TODO") +;; +;; - process status indication +;; +;; - results from async sources should appear in the order they are +;; specified in anything-sources +;; +;; - async sources doesn't honor digit-shortcut-count +;; +;; - anything-candidate-number-limit can't be nil everywhere +;; +;; - support multi line candidates + +;; (@* "HISTORY") +;; $Log: anything.el,v $ +;; Revision 1.136 2008/10/27 17:41:27 rubikitch +;; `anything-process-delayed-sources', `anything-check-minibuffer-input-1': quittable +;; +;; Revision 1.135 2008/10/27 17:04:25 rubikitch +;; arranged source, added more linkd tags (no code change) +;; +;; Revision 1.134 2008/10/27 15:02:25 rubikitch +;; New variable: `anything-save-configuration-functions' +;; Delete variable: `anything-save-configuration-type' +;; +;; Revision 1.133 2008/10/27 11:16:13 rubikitch +;; New variable: `anything-save-configuration-type' +;; +;; Revision 1.132 2008/10/26 22:34:59 rubikitch +;; `anything-delete-current-selection' with multiline +;; +;; Revision 1.131 2008/10/26 21:44:43 rubikitch +;; New command: `anything-delete-current-selection' +;; +;; Revision 1.130 2008/10/22 10:41:09 rubikitch +;; `anything-insert-match': do not override 'anything-realvalue property +;; +;; Revision 1.129 2008/10/21 17:01:37 rubikitch +;; `anything-resume' per buffer. +;; `anything-last-sources': obsolete +;; +;; Revision 1.128 2008/10/20 06:27:54 rubikitch +;; `anything-quick-update': new user option +;; +;; Revision 1.127 2008/10/20 05:47:49 rubikitch +;; refactoring +;; +;; Revision 1.126 2008/10/20 03:47:58 rubikitch +;; `anything-update': reversed order of delayed sources +;; +;; Revision 1.125 2008/10/19 00:29:54 rubikitch +;; kill buffer-local candidate buffers when creating global candidate buffers. +;; +;; Revision 1.124 2008/10/18 13:04:20 rubikitch +;; Remove tick entry from `anything-tick-hash' when killing a buffer. +;; +;; Revision 1.123 2008/10/18 10:23:36 rubikitch +;; multiline patch by Tomohiro MATSUYAMA. +;; +;; Revision 1.122 2008/10/13 03:10:07 rubikitch +;; `anything': do `anything-mark-current-line' when resuming +;; +;; Revision 1.121 2008/10/13 03:08:08 rubikitch +;; always set `anything-current-position' +;; +;; Revision 1.120 2008/10/07 14:12:02 rubikitch +;; `anything-execute-persistent-action': optional arg +;; +;; Revision 1.119 2008/10/06 06:43:29 rubikitch +;; `anything-candidate-buffer': return nil when the buffer is dead +;; +;; Revision 1.118 2008/09/30 22:21:28 rubikitch +;; New `anything-sources' attribute: accept-empty +;; dummy: include accept-empty +;; +;; Revision 1.117 2008/09/30 21:59:10 rubikitch +;; New function: `anything-buffer-is-modified' +;; +;; Revision 1.116 2008/09/22 11:27:29 rubikitch +;; *** empty log message *** +;; +;; Revision 1.115 2008/09/20 20:21:11 rubikitch +;; added linkd index. (no code change) +;; +;; Revision 1.114 2008/09/20 20:09:57 rubikitch +;; INCOMPATIBLE CHANGES: `anything-attr' +;; New functions: `anything-attrset', `anything-attr-defined' +;; +;; Revision 1.113 2008/09/14 15:15:32 rubikitch +;; bugfix: volatile and match attribute / process and match attribute +;; +;; Revision 1.112 2008/09/12 01:57:17 rubikitch +;; When resuming anything, reinitialize overlays. +;; +;; Revision 1.111 2008/09/10 22:53:11 rubikitch +;; anything: bug fix of `anything-buffer' +;; New macro: `anything-test-update' +;; +;; Revision 1.110 2008/09/10 22:17:11 rubikitch +;; New `anything-sources' attribute: header-name +;; +;; Revision 1.109 2008/09/10 21:12:26 rubikitch +;; New hook: `anything-after-action-hook' +;; +;; Revision 1.108 2008/09/06 06:07:56 rubikitch +;; Extended `anything-set-sources' optional arguments. +;; +;; Revision 1.107 2008/09/05 03:14:35 rubikitch +;; reimplement `anything-current-buffer-is-modified' in the right way +;; +;; Revision 1.106 2008/09/05 00:11:05 rubikitch +;; Moved `anything-read-string-mode' and read functions to anything-complete.el. +;; +;; Revision 1.105 2008/09/04 12:45:06 rubikitch +;; New hook: `anything-after-persistent-action-hook' +;; +;; Revision 1.104 2008/09/04 12:27:05 rubikitch +;; `anything': prefixed optional arguments +;; +;; Revision 1.103 2008/09/04 09:16:28 rubikitch +;; fixed a bug of `anything-read-file-name'. +;; +;; Revision 1.102 2008/09/03 11:25:19 rubikitch +;; Extended `anything' optional arguments: buffer +;; +;; Revision 1.101 2008/09/03 11:15:13 rubikitch +;; `anything': return nil when keybord-quitted +;; +;; Revision 1.100 2008/09/01 23:11:02 rubikitch +;; bug fix of search-from-end +;; +;; Revision 1.99 2008/09/01 13:45:55 rubikitch +;; bug fix of search-from-end +;; +;; Revision 1.98 2008/09/01 11:23:38 rubikitch +;; New `anything-sources' attribute: search-from-end +;; +;; Revision 1.97 2008/09/01 00:44:34 rubikitch +;; Make sure to display the other window when persistent action. +;; +;; Revision 1.96 2008/08/31 20:55:20 rubikitch +;; define `buffer-modified-tick' for older emacs. +;; +;; Revision 1.95 2008/08/30 04:55:51 rubikitch +;; fixed a bug of `anything-completing-read' +;; +;; Revision 1.94 2008/08/28 20:18:03 rubikitch +;; added some tests +;; +;; Revision 1.93 2008/08/25 20:18:46 rubikitch +;; `anything': set `anything-input' and `anything-pattern' before `anything-update' +;; +;; Revision 1.92 2008/08/24 22:38:46 rubikitch +;; *** empty log message *** +;; +;; Revision 1.91 2008/08/24 21:34:35 rubikitch +;; rewrite `with-anything-restore-variables' +;; +;; Revision 1.90 2008/08/24 20:33:02 rubikitch +;; prevent the unit test from byte-compiled. +;; macro bug fix. +;; +;; Revision 1.89 2008/08/24 08:35:27 rubikitch +;; *** empty log message *** +;; +;; Revision 1.88 2008/08/24 08:22:19 rubikitch +;; Rename `anything-candidates-buffer' -> `anything-candidate-buffer' +;; +;; Revision 1.87 2008/08/23 22:27:04 rubikitch +;; New hook: `anything-cleanup-hook' +;; +;; Revision 1.86 2008/08/23 22:05:42 rubikitch +;; `anything-original-source-filter' is removed. +;; Now use `anything-restored-variables' and `with-anything-restore-variables'. +;; +;; Revision 1.85 2008/08/23 21:23:21 rubikitch +;; inhibit-read-only = t in anything-buffer +;; +;; Revision 1.84 2008/08/23 21:18:33 rubikitch +;; *** empty log message *** +;; +;; Revision 1.83 2008/08/23 20:44:20 rubikitch +;; `anything-execute-persistent-action': display-to-real bug fix +;; +;; Revision 1.82 2008/08/23 20:19:12 rubikitch +;; New `anything-sources' attribute: get-line +;; +;; Revision 1.81 2008/08/23 19:32:14 rubikitch +;; `anything-attr': Return t in (attribute-name) case. +;; +;; Revision 1.80 2008/08/22 21:25:05 rubikitch +;; anything-candidates-in-buffer-1: +;; Open a line at the BOB to make use of `search-forward' for faster exact/prefix match. +;; Of course, restore the buffer contents after search. +;; +;; Revision 1.79 2008/08/22 17:11:00 rubikitch +;; New hook: `anything-before-initialize-hook', `anything-after-initialize-hook' +;; +;; Revision 1.78 2008/08/21 18:37:03 rubikitch +;; Implemented dummy sources as plug-in. +;; +;; Revision 1.77 2008/08/21 17:40:40 rubikitch +;; New function: `anything-set-sources' +;; +;; Revision 1.76 2008/08/21 12:25:02 rubikitch +;; New variable: `anything-version' +;; +;; Revision 1.75 2008/08/21 12:13:46 rubikitch +;; New variable: `anything-in-persistent-action' +;; +;; Revision 1.74 2008/08/21 10:34:22 rubikitch +;; New function `anything-mklist' +;; +;; Revision 1.73 2008/08/21 09:41:38 rubikitch +;; accept multiple init/cleanup functions so that plug-ins can add new function. +;; +;; Revision 1.72 2008/08/20 22:51:53 rubikitch +;; New `anything-sources' attribute: candidate-number-limit +;; +;; Revision 1.71 2008/08/20 21:45:42 rubikitch +;; added many tests. +;; +;; Revision 1.70 2008/08/20 18:51:45 rubikitch +;; `anything-preselect' bug fix. +;; refactoring. +;; +;; Revision 1.69 2008/08/20 17:57:51 rubikitch +;; Extended `anything' optional arguments: preselect +;; +;; Revision 1.68 2008/08/20 16:39:07 rubikitch +;; Nested `anything' invocation support, ie. `anything' can be invoked by anything action. +;; +;; (anything '(((name . "nested anything invocation test") +;; (candidates "anything-c-source-buffers" "anything-c-source-man-pages") +;; (display-to-real . intern) +;; (action . anything)))) +;; +;; Revision 1.67 2008/08/20 00:08:28 rubikitch +;; `anything-candidates-in-buffer-1': add code when pattern == "" +;; +;; Revision 1.66 2008/08/19 23:31:52 rubikitch +;; Removed `anything-show-exact-match-first' because it should be provided as a plug-in. +;; +;; Revision 1.65 2008/08/19 23:18:47 rubikitch +;; *** empty log message *** +;; +;; Revision 1.64 2008/08/19 23:15:43 rubikitch +;; `anything-compute-matches': short-cut when match == '(identity) +;; +;; Revision 1.63 2008/08/19 23:06:42 rubikitch +;; Use hash table to speed uniquify candidates. +;; +;; Revision 1.62 2008/08/19 22:40:57 rubikitch +;; `anything-test-candidates': additional optonal argument +;; +;; Revision 1.61 2008/08/19 18:13:39 rubikitch +;; search attribute: multiple search functions +;; +;; Revision 1.60 2008/08/19 15:07:39 rubikitch +;; New function: `anything-attr' +;; +;; Revision 1.59 2008/08/19 15:01:59 rubikitch +;; arranged code +;; added unit tests +;; update doc +;; +;; Revision 1.58 2008/08/19 13:40:52 rubikitch +;; `anything-get-current-source': This function can be used in +;; init/candidates/action/candidate-transformer/filtered-candidate-transformer +;; display-to-real/cleanup function. +;; +;; Revision 1.57 2008/08/19 03:43:57 rubikitch +;; `anything-process-delayed-sources': delay = anything-idle-delay - anything-input-idle-delay +;; +;; Revision 1.56 2008/08/18 06:37:51 rubikitch +;; Make `anything-input-idle-delay' ineffective when the action list is shown. +;; +;; Revision 1.55 2008/08/18 06:35:00 rubikitch +;; New variable: `anything-show-exact-match-first' +;; +;; Revision 1.54 2008/08/17 23:22:24 rubikitch +;; *** empty log message *** +;; +;; Revision 1.53 2008/08/17 23:15:38 rubikitch +;; bind `anything-source-name' when executing action to enable to use `anything-candidate-buffer' in action. +;; +;; Revision 1.52 2008/08/17 15:21:27 rubikitch +;; `anything-test-candidates': accept a symbol for source +;; New variable: `anything-input-idle-delay' +;; +;; Revision 1.51 2008/08/17 12:45:30 rubikitch +;; (buffer-disable-undo) in anything-buffer +;; +;; Revision 1.50 2008/08/16 22:21:37 rubikitch +;; `anything-saved-sources': removed +;; `anything-action-buffer': action selection buffer +;; `anything-select-action': toggle actions <=> candidates +;; +;; Revision 1.49 2008/08/16 19:46:11 rubikitch +;; New function: `anything-action-list-is-shown' +;; +;; Revision 1.48 2008/08/16 17:03:02 rubikitch +;; bugfix: cleanup +;; +;; Revision 1.47 2008/08/16 16:35:24 rubikitch +;; silence byte compiler +;; +;; Revision 1.46 2008/08/16 14:51:27 rubikitch +;; *** empty log message *** +;; +;; Revision 1.45 2008/08/16 11:27:59 rubikitch +;; refactoring +;; `anything-aif': Anaphoric if. +;; `anything-compile-source-functions': make `anything-get-sources' customizable. +;; +;; Revision 1.44 2008/08/16 09:38:15 rubikitch +;; *** empty log message *** +;; +;; Revision 1.43 2008/08/15 11:44:28 rubikitch +;; `anything-read-string-mode': minor mode for `anything' version of read functions. (experimental) +;; +;; Revision 1.42 2008/08/15 11:03:20 rubikitch +;; update docs +;; +;; Revision 1.41 2008/08/14 20:51:28 rubikitch +;; New `anything-sources' attribute: cleanup +;; +;; Revision 1.40 2008/08/14 10:34:04 rubikitch +;; `anything': SOURCES: accept symbols +;; +;; Revision 1.39 2008/08/10 22:46:01 rubikitch +;; `anything-move-selection': avoid infinite loop +;; +;; Revision 1.38 2008/08/09 21:38:25 rubikitch +;; `anything-read-file-name': experimental implementation. +;; +;; Revision 1.37 2008/08/09 17:54:25 rubikitch +;; action test +;; +;; Revision 1.36 2008/08/09 17:13:00 rubikitch +;; fixed test +;; +;; Revision 1.35 2008/08/09 10:43:08 rubikitch +;; New `anything-sources' attribute: display-to-real +;; +;; Revision 1.34 2008/08/07 13:15:44 rubikitch +;; New `anything-sources' attribute: search +;; +;; Revision 1.33 2008/08/05 23:14:20 rubikitch +;; `anything-candidate-buffer': bugfix +;; +;; Revision 1.32 2008/08/05 21:42:15 rubikitch +;; *** empty log message *** +;; +;; Revision 1.31 2008/08/05 21:06:23 rubikitch +;; `anything-candidate-buffer': candidates buffer registration +;; +;; Revision 1.30 2008/08/05 19:46:36 rubikitch +;; New `anything-sources' attribute: candidates-in-buffer +;; +;; Revision 1.29 2008/08/05 17:58:31 rubikitch +;; *** empty log message *** +;; +;; Revision 1.28 2008/08/05 17:46:04 rubikitch +;; memoized `anything-get-sources' +;; +;; Revision 1.27 2008/08/05 17:29:40 rubikitch +;; update doc +;; +;; Revision 1.26 2008/08/05 08:35:45 rubikitch +;; `anything-completing-read': accept obarray +;; +;; Revision 1.25 2008/08/05 07:26:17 rubikitch +;; `anything-completing-read': guard from non-string return value +;; +;; Revision 1.24 2008/08/04 12:05:41 rubikitch +;; Wrote Tips and some docstrings. +;; `anything-candidate-buffer': buffer-local by default +;; +;; Revision 1.23 2008/08/04 05:29:46 rubikitch +;; `anything-buffer-file-name': `buffer-file-name' when `anything' is invoked. +;; +;; Revision 1.22 2008/08/04 00:10:13 rubikitch +;; `anything-candidate-buffer': new API +;; +;; Revision 1.21 2008/08/03 22:05:08 rubikitch +;; `anything-candidate-buffer': Return a buffer containing candidates of current source. +;; +;; Revision 1.20 2008/08/03 20:47:56 rubikitch +;; `anything-current-buffer-is-modified': modify checker +;; +;; Revision 1.19 2008/08/03 19:06:18 rubikitch +;; `anything-candidates-in-buffer': use `with-current-buffer' instead. +;; +;; Revision 1.18 2008/08/03 05:55:01 rubikitch +;; `anything-candidates-in-buffer': extract candidates in a buffer for speed. +;; +;; Revision 1.17 2008/08/02 21:31:29 rubikitch +;; Extended `anything' optional arguments. +;; `anything-completing-read': experimental implementation. +;; +;; Revision 1.16 2008/08/02 20:32:54 rubikitch +;; Extended `anything' optional arguments. +;; +;; Revision 1.15 2008/08/02 16:53:40 rubikitch +;; Fixed a small bug of `anything-test-candidates'. +;; +;; Revision 1.14 2008/08/02 16:48:29 rubikitch +;; Refactored to testable code. +;; Added many candidate tests with `anything-test-candidates'. +;; +;; Revision 1.13 2008/08/02 15:08:14 rubikitch +;; *** empty log message *** +;; +;; Revision 1.12 2008/08/02 14:29:31 rubikitch +;; `anything-sources' accepts symbols. (patched by Sugawara) +;; +;; Revision 1.11 2008/08/02 10:20:36 rubikitch +;; `anything-resume' is usable with other (let-binded) `anything-sources'. +;; +;; Revision 1.10 2008/08/01 19:44:01 rubikitch +;; `anything-resume': resurrect previously invoked `anything'. +;; +;; Revision 1.9 2008/07/30 15:44:49 rubikitch +;; *** empty log message *** +;; +;; Revision 1.8 2008/07/30 15:38:51 rubikitch +;; *** empty log message *** +;; +;; Revision 1.7 2008/07/30 15:21:48 rubikitch +;; `anything-scroll-other-window', `anything-scroll-other-window-down': +;; Scroll other window (for persistent action). +;; +;; Revision 1.6 2008/07/30 15:12:36 rubikitch +;; *** empty log message *** +;; +;; Revision 1.5 2008/07/30 15:06:32 rubikitch +;; `anything-select-2nd-action', `anything-select-3rd-action', `anything-select-4th-action': +;; Select other than default action without pressing Tab. +;; +;; Revision 1.4 2008/07/30 14:58:27 rubikitch +;; `anything-current-buffer': Store current buffer when `anything' is invoked. +;; `anything-current-position': Restore position when keyboard-quitted. +;; +;; Revision 1.3 2008/07/30 14:38:04 rubikitch +;; Implemented persistent action. +;; +;; Revision 1.2 2008/07/30 13:37:16 rubikitch +;; Update doc. +;; +;; Revision 1.1 2008/07/30 13:22:06 rubikitch +;; New maintainer. +;; + +(defvar anything-version "$Id: anything.el,v 1.136 2008/10/27 17:41:27 rubikitch Exp $") +(require 'cl) + +;; (@* "User Configuration") + +;; This is only an example. Customize it to your own taste! +(defvar anything-sources `(((name . "Buffers") + (candidates + . (lambda () + (remove-if (lambda (name) + (or (equal name anything-buffer) + (eq ?\ (aref name 0)))) + (mapcar 'buffer-name (buffer-list))))) + (type . buffer)) + + ((name . "File Name History") + (candidates . file-name-history) + (match (lambda (candidate) + ;; list basename matches first + (string-match + anything-pattern + (file-name-nondirectory candidate))) + + (lambda (candidate) + ;; and then directory part matches + (let ((dir (file-name-directory candidate))) + (if dir + (string-match anything-pattern dir))))) + (type . file)) + + ((name . "Files from Current Directory") + (init . (lambda () + (setq anything-default-directory + default-directory))) + (candidates . (lambda () + (directory-files + anything-default-directory))) + (type . file)) + + ((name . "Manual Pages") + (candidates . ,(progn + ;; XEmacs doesn't have a woman :) + (declare (special woman-file-name + woman-topic-all-completions)) + (condition-case nil + (progn + (require 'woman) + (woman-file-name "") + (sort (mapcar 'car + woman-topic-all-completions) + 'string-lessp)) + (error nil)))) + (action . (("Open Manual Page" . woman))) + (requires-pattern . 2)) + + ((name . "Complex Command History") + (candidates . (lambda () + (mapcar 'prin1-to-string + command-history))) + (action . (("Repeat Complex Command" . + (lambda (c) + (eval (read c)))))) + (delayed))) + "The source of candidates for anything. +It accepts symbols: + (setq anything-sources (list anything-c-foo anything-c-bar)) +can be written as + (setq anything-sources '(anything-c-foo anything-c-bar)) +The latter is recommended because if you change anything-c-* variable, +you do not have to update `anything-sources'. + +If you want to change `anything-sources' during `anything' invocation, +use `anything-set-sources', never use `setq'. + +Attributes: + +- name (mandatory) + + The name of the source. It is also the heading which appears + above the list of matches from the source. Must be unique. + +- header-name (optional) + + A function returning the display string of the header. Its + argument is the name of the source. This attribute is useful to + add an additional information with the source name. + +- candidates (mandatory if candidates-in-buffer attribute is not provided) + + Specifies how to retrieve candidates from the source. It can + either be a variable name, a function called with no parameters + or the actual list of candidates. + + The list must be a list of strings, so it's the responsibility + of the source to convert candidates to strings if necessary. + + If the candidates have to be retrieved asynchronously (for + example, by an external command which takes a while to run) + then the function should start the external command + asynchronously and return the associated process object. + Anything will take care of managing the process (receiving the + output from it, killing it if necessary, etc.). The process + should return candidates matching the current pattern (see + variable `anything-pattern'.) + + Note that currently results from asynchronous sources appear + last in the anything buffer regardless of their position in + `anything-sources'. + +- action (mandatory if type attribute is not provided) + + It is a list of (DISPLAY . FUNCTION) pairs. FUNCTION is called + with one parameter: the selected candidate. + + An action other than the default can be chosen from this list + of actions for the currently selected candidate (by default + with TAB). The DISPLAY string is shown in the completions + buffer and the FUNCTION is invoked when an action is + selected. The first action of the list is the default. + +- type (optional if action attribute is provided) + + Indicates the type of the items the source returns. + + Merge attributes not specified in the source itself from + `anything-type-attributes'. + + This attribute is implemented by plug-in. + +- init (optional) + + Function called with no parameters when anything is started. It + is useful for collecting current state information which can be + used to create the list of candidates later. + + For example, if a source needs to work with the current + directory then it can store its value here, because later + anything does its job in the minibuffer and in the + `anything-buffer' and the current directory can be different + there. + +- match (optional) + + List of functions called with one parameter: a candidate. The + function should return non-nil if the candidate matches the + current pattern (see variable `anything-pattern'). + + This attribute allows the source to override the default + pattern matching based on `string-match'. It can be used, for + example, to implement a source for file names and do the + pattern matching on the basename of files, since it's more + likely one is typing part of the basename when searching for a + file, instead of some string anywhere else in its path. + + If the list contains more than one function then the list of + matching candidates from the source is constructed by appending + the results after invoking the first function on all the + potential candidates, then the next function, and so on. The + matching candidates supplied by the first function appear first + in the list of results and then results from the other + functions, respectively. + + This attribute has no effect for asynchronous sources (see + attribute `candidates'), since they perform pattern matching + themselves. + +- candidate-transformer (optional) + + It's a function called with one argument when the completion + list from the source is built. The argument is the list of + candidates retrieved from the source. The function should + return a transformed list of candidates which will be used for + the actual completion. + + This can be used to transform or remove items from the list of + candidates. + + The function can also substitute candidates in the returned + list with (DISPLAY . REAL) pairs. In this case the DISPLAY + string is shown in the Anything buffer, but the REAL one is + used as action argument when the candidate is selected. This + allows a more readable presentation for candidates which would + otherwise be, for example, too long or have a common part + shared with other candidates which can be safely replaced with + an abbreviated string for display purposes. + + Note that if the (DISPLAY . REAL) form is used then pattern + matching is done on the displayed string, not on the real + value. + +- filtered-candidate-transformer (optional) + + It has the same format as `candidate-transformer', except the + function is called with two parameters: the candidate list and + the source. + + This transformer is run on the candidate list which is already + filtered by the current pattern. While `candidate-transformer' + is run only once, it is run every time the input pattern is + changed. + + It can be used to transform the candidate list dynamically, for + example, based on the current pattern. + + In some cases it may also be more efficent to perform candidate + transformation here, instead of with `candidate-transformer' + even if this transformation is done every time the pattern is + changed. For example, if a candidate set is very large then + `candidate-transformer' transforms every candidate while only + some of them will actually be dislpayed due to the limit + imposed by `anything-candidate-number-limit'. + + Note that `candidate-transformer' is run already, so the given + transformer function should also be able to handle candidates + with (DISPLAY . REAL) format. + + This option has no effect for asynchronous sources. (Not yet, + at least. + +- action-transformer (optional) + + It's a function called with two arguments when the action list + from the source is assembled. The first argument is the list of + actions, the second is the current selection. + + The function should return a transformed action list. + + This can be used to customize the list of actions based on the + currently selected candidate. + +- delayed (optional) + + Candidates from the source are shown only if the user stops + typing and is idle for `anything-idle-delay' seconds. + +- volatile (optional) + + Indicates the source assembles the candidate list dynamically, + so it shouldn't be cached within a single Anything + invocation. It is only applicable to synchronous sources, + because asynchronous sources are not cached. + +- requires-pattern (optional) + + If present matches from the source are shown only if the + pattern is not empty. Optionally, it can have an integer + parameter specifying the required length of input which is + useful in case of sources with lots of candidates. + +- persistent-action (optional) + + Function called with one parameter; the selected candidate. + + An action performed by `anything-execute-persistent-action'. + If none, use the default action. + +- candidates-in-buffer (optional) + + Shortcut attribute for making and narrowing candidates using + buffers. This newly-introduced attribute prevents us from + forgetting to add volatile and match attributes. + + See docstring of `anything-candidates-in-buffer'. + + (candidates-in-buffer) is equivalent of three attributes: + (candidates . anything-candidates-in-buffer) + (volatile) + (match identity) + + (candidates-in-buffer . candidates-function) is equivalent of: + (candidates . candidates-function) + (volatile) + (match identity) + + This attribute is implemented by plug-in. + +- search (optional) + + List of functions like `re-search-forward' or `search-forward'. + Buffer search function used by `anything-candidates-in-buffer'. + By default, `anything-candidates-in-buffer' uses `re-search-forward'. + This attribute is meant to be used with + (candidates . anything-candidates-in-buffer) or + (candidates-in-buffer) in short. + +- search-from-end (optional) + + Make `anything-candidates-in-buffer' search from the end of buffer. + If this attribute is specified, `anything-candidates-in-buffer' uses + `re-search-backward' instead. + +- get-line (optional) + + A function like `buffer-substring-no-properties' or `buffer-substring'. + This function converts point of line-beginning and point of line-end, + which represents a candidate computed by `anything-candidates-in-buffer'. + By default, `anything-candidates-in-buffer' uses + `buffer-substring-no-properties'. + +- display-to-real (optional) + + Function called with one parameter; the selected candidate. + + The function transforms the selected candidate, and the result + is passed to the action function. The display-to-real + attribute provides another way to pass other string than one + shown in Anything buffer. + + Traditionally, it is possible to make candidates, + candidate-transformer or filtered-candidate-transformer + function return a list with (DISPLAY . REAL) pairs. But if REAL + can be generated from DISPLAY, display-to-real is more + convenient and faster. + +- cleanup (optional) + + Function called with no parameters when *anything* buffer is closed. It + is useful for killing unneeded candidates buffer. + + Note that the function is executed BEFORE performing action. + +- candidate-number-limit (optional) + + Override `anything-candidate-number-limit' only for this source. + +- accept-empty (optional) + + Pass empty string \"\" to action function. + +- dummy (optional) + + Set `anything-pattern' to candidate. If this attribute is + specified, The candidates attribute is ignored. + + This attribute is implemented by plug-in. + +- multiline (optional) + + Enable to selection multiline candidates. +") + + +;; This value is only provided as an example. Customize it to your own +;; taste! +(defvar anything-type-attributes + '((file (action . (("Find File" . find-file) + ("Delete File" . (lambda (file) + (if (y-or-n-p (format "Really delete file %s? " + file)) + (delete-file file))))))) + (buffer (action . (("Switch to Buffer" . switch-to-buffer) + ("Pop to Buffer" . pop-to-buffer) + ("Display Buffer" . display-buffer) + ("Kill Buffer" . kill-buffer))))) + "It's a list of (TYPE ATTRIBUTES ...). ATTRIBUTES are the same + as attributes for `anything-sources'. TYPE connects the value + to the appropriate sources in `anything-sources'. + + This allows specifying common attributes for several + sources. For example, sources which provide files can specify + common attributes with a `file' type.") + + +(defvar anything-enable-digit-shortcuts nil + "*If t then the first nine matches can be selected using + Ctrl+.") + + +(defvar anything-candidate-number-limit 50 + "*Do not show more candidates than this limit from inidividual + sources. It is usually pointless to show hundreds of matches + when the pattern is empty, because it is much simpler to type a + few characters to narrow down the list of potential candidates. + + Set it to nil if you don't want this limit.") + + +(defvar anything-idle-delay 0.5 + "*The user has to be idle for this many seconds, before + candidates from delayed sources are collected. This is useful + for sources involving heavy operations (like launching external + programs), so that candidates from the source are not retrieved + unnecessarily if the user keeps typing. + + It also can be used to declutter the results anything displays, + so that results from certain sources are not shown with every + character typed, only if the user hesitates a bit.") + + +(defvar anything-input-idle-delay nil + "The user has to be idle for this many seconds, before ALL candidates are collected. +Unlink `anything-input-idle', it is also effective for non-delayed sources. +If nil, candidates are collected immediately. ") + + +(defvar anything-samewindow nil + "If t then Anything doesn't pop up a new window, it uses the +current window to show the candidates.") + + +(defvar anything-source-filter nil + "A list of source names to be displayed. Other sources won't +appear in the search results. If nil then there is no filtering. +See also `anything-set-source-filter'.") + + +(defvar anything-map + (let ((map (copy-keymap minibuffer-local-map))) + (define-key map (kbd "") 'anything-next-line) + (define-key map (kbd "") 'anything-previous-line) + (define-key map (kbd "") 'anything-previous-page) + (define-key map (kbd "") 'anything-next-page) + (define-key map (kbd "") 'anything-next-source) + (define-key map (kbd "") 'anything-previous-source) + (define-key map (kbd "") 'anything-exit-minibuffer) + (define-key map (kbd "C-1") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-2") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-3") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-4") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-5") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-6") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-7") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-8") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-9") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-i") 'anything-select-action) + ;; the defalias is needed because commands are bound by name when + ;; using iswitchb, so only commands having the prefix anything- + ;; get rebound + (defalias 'anything-previous-history-element 'previous-history-element) + ;; C-p is used instead of M-p, because anything uses ESC + ;; (currently hardcoded) for `anything-iswitchb-cancel-anything' and + ;; Emacs handles ESC and Meta as synonyms, so ESC overrides + ;; other commands with Meta prefix. + ;; + ;; Note that iswitchb uses M-p and M-n by default for history + ;; navigation, so you should bind C-p and C-n in + ;; `iswitchb-mode-map' if you use the history keys and don't want + ;; to use different keys for iswitchb while anything is not yet + ;; kicked in. These keys are not bound automatically by anything + ;; in `iswitchb-mode-map' because they (C-n at least) already have + ;; a standard iswitchb binding which you might be accustomed to. + (define-key map (kbd "C-p") 'anything-previous-history-element) + (defalias 'anything-next-history-element 'next-history-element) + (define-key map (kbd "C-n") 'anything-next-history-element) + ;; Binding M-s is used instead of C-s, because C-s has a binding in + ;; iswitchb. You can rebind it, of course. + (define-key map (kbd "M-s") 'anything-isearch) + ;; unbind C-r to prevent problems during anything-isearch + (define-key map (kbd "C-r") nil) + map) + "Keymap for anything.") + + +(defvar anything-isearch-map + (let ((map (copy-keymap (current-global-map)))) + (define-key map (kbd "") 'anything-isearch-default-action) + (define-key map (kbd "C-i") 'anything-isearch-select-action) + (define-key map (kbd "C-g") 'anything-isearch-cancel) + (define-key map (kbd "M-s") 'anything-isearch-again) + (define-key map (kbd "") 'anything-isearch-delete) + ;; add printing chars + (let ((i 32)) + (while (< i 256) + (define-key map (vector i) 'anything-isearch-printing-char) + (setq i (1+ i)))) + map) + "Keymap for anything incremental search.") + + +(defgroup anything nil + "Open anything." :prefix "anything-" :group 'convenience) + +(if (facep 'header-line) + (copy-face 'header-line 'anything-header) + + (defface anything-header + '((t (:bold t :underline t))) + "Face for header lines in the anything buffer." :group 'anything)) + +(defvar anything-header-face 'anything-header + "Face for header lines in the anything buffer.") + +(defface anything-isearch-match '((t (:background "Yellow"))) + "Face for isearch in the anything buffer." :group 'anything) + +(defvar anything-isearch-match-face 'anything-isearch-match + "Face for matches during incremental search.") + +(defvar anything-iswitchb-idle-delay 1 + "Show anything completions if the user is idle that many + seconds after typing.") + +(defvar anything-iswitchb-dont-touch-iswithcb-keys nil + "If t then those commands are not bound from `anything-map' + under iswitchb which would override standard iswithcb keys. + +This allows an even more seamless integration with iswitchb for +those who prefer using iswitchb bindings even if the anything +completions buffer is popped up. + +Note that you can bind alternative keys for the same command in +`anything-map', so that you can use different keys for anything +under iswitchb. For example, I bind the character \ to +`anything-exit-minibuffer' which key is just above Enter on my +keyboard. This way I can switch buffers with Enter and choose +anything completions with \.") + + +;;---------------------------------------------------------------------- + +(defvar anything-buffer "*anything*" + "Buffer showing completions.") + +(defvar anything-action-buffer "*anything action*" + "Buffer showing actions.") + +(defvar anything-selection-overlay nil + "Overlay used to highlight the currently selected file.") + +(defvar anything-isearch-overlay nil + "Overlay used to highlight the current match during isearch.") + +(defvar anything-digit-overlays nil + "Overlays for digit shortcuts. See `anything-enable-digit-shortcuts'.") + +(defvar anything-candidate-cache nil + "Holds the available candidate withing a single anything invocation.") + +(defvar anything-pattern + "The input pattern used to update the anything buffer.") + +(defvar anything-input + "The input typed in the candidates panel.") + +(defvar anything-async-processes nil + "List of information about asynchronous processes managed by anything.") + +(defvar anything-digit-shortcut-count 0 + "Number of digit shortcuts shown in the anything buffer.") + +(defvar anything-before-initialize-hook nil + "Run before anything initialization. +This hook is run before init functions in `anything-sources'.") + +(defvar anything-after-initialize-hook nil + "Run after anything initialization. +Global variables are initialized and the anything buffer is created. +But the anything buffer has no contents. ") + +(defvar anything-update-hook nil + "Run after the anything buffer was updated according the new + input pattern.") + +(defvar anything-cleanup-hook nil + "Run after anything minibuffer is closed, IOW this hook is executed BEFORE performing action. ") + +(defvar anything-after-action-hook nil + "Run after executing action.") + +(defvar anything-after-persistent-action-hook nil + "Run after executing persistent action.") + +(defvar anything-restored-variables + '( anything-candidate-number-limit + anything-source-filter) + "Variables which are restored after `anything' invocation.") +;; `anything-saved-sources' is removed + +(defvar anything-saved-selection nil + "Saved value of the currently selected object when the action + list is shown.") + +;; `anything-original-source-filter' is removed + +(defvar anything-candidate-separator + "--------------------" + "Candidates separator of `multiline' source.") + +(defvar anything-current-buffer nil + "Current buffer when `anything' is invoked.") + +(defvar anything-buffer-file-name nil + "`buffer-file-name' when `anything' is invoked.") + +(defvar anything-current-position nil + "Cons of (point) and (window-start) when `anything' is invoked. +It is needed because restoring position when `anything' is keyboard-quitted.") + +(defvar anything-saved-action nil + "Saved value of the currently selected action by key.") + +(defvar anything-last-sources nil + "OBSOLETE!! Sources of previously invoked `anything'.") + +(defvar anything-saved-current-source nil + "Saved value of the original (anything-get-current-source) when the action + list is shown.") + +(defvar anything-compiled-sources nil + "Compiled version of `anything-sources'. ") + +(defvar anything-in-persistent-action nil + "Flag whether in persistent-action or not.") + +(defvar anything-quick-update nil + "If non-nil, suppress displaying sources which are out of screen at first. +They are treated as delayed sources at this input. +This flag makes `anything' a bit faster with many sources.") + +(defvar anything-last-sources-local nil + "Buffer local value of `anything-sources'.") +(defvar anything-last-buffer nil + "`anything-buffer' of previously `anything' session.") + +(defvar anything-save-configuration-functions + '(set-frame-configuration . current-frame-configuration) + "If you hate flickering, set this variable to + '(set-window-configuration . current-window-configuration) +") + +(put 'anything 'timid-completion 'disabled) + +;; (@* "Internal Variables") +(defvar anything-test-candidate-list nil) +(defvar anything-test-mode nil) +(defvar anything-source-name nil) +(defvar anything-candidate-buffer-alist nil) +(defvar anything-check-minibuffer-input-timer nil) +(defvar anything-match-hash (make-hash-table :test 'equal)) +(defvar anything-cib-hash (make-hash-table :test 'equal)) +(defvar anything-tick-hash (make-hash-table :test 'equal)) + +;; (@* "Programming Tools") +(defmacro anything-aif (test-form then-form &rest else-forms) + "Anaphoric if. Temporary variable `it' is the result of test-form." + `(let ((it ,test-form)) + (if it ,then-form ,@else-forms))) +(put 'anything-aif 'lisp-indent-function 2) + +(defun anything-mklist (obj) + "If OBJ is a list, return itself, otherwise make a list with one element." + (if (listp obj) obj (list obj))) + +;; (@* "Anything API") +(defun anything-buffer-get () + "If *anything action* buffer is shown, return `anything-action-buffer', otherwise `anything-buffer'." + (if (anything-action-window) + anything-action-buffer + anything-buffer)) + +(defun anything-window () + "Window of `anything-buffer'." + (get-buffer-window (anything-buffer-get) 'visible)) + +(defun anything-action-window () + "Window of `anything-action-buffer'." + (get-buffer-window anything-action-buffer 'visible)) + +(defmacro with-anything-window (&rest body) + `(let ((--tmpfunc-- (lambda () ,@body))) + (if anything-test-mode + (with-current-buffer (anything-buffer-get) + (funcall --tmpfunc--)) + (with-selected-window (anything-window) + (funcall --tmpfunc--))))) +(put 'with-anything-window 'lisp-indent-function 0) + +(defmacro with-anything-restore-variables(&rest body) + "Restore variables specified by `anything-restored-variables' after executing BODY ." + `(let ((--orig-vars (mapcar (lambda (v) (cons v (symbol-value v))) anything-restored-variables))) + (unwind-protect (progn ,@body) + (loop for (var . value) in --orig-vars + do (set var value))))) +(put 'with-anything-restore-variables 'lisp-indent-function 0) + +(defun* anything-attr (attribute-name &optional (src (anything-get-current-source))) + "Get the value of ATTRIBUTE-NAME of SRC (source). +if SRC is omitted, use current source. +It is useful to write your sources." + (anything-aif (assq attribute-name src) + (cdr it))) + +(defun* anything-attr-defined (attribute-name &optional (src (anything-get-current-source))) + "Return non-nil if ATTRIBUTE-NAME of SRC (source) is defined. +if SRC is omitted, use current source. +It is useful to write your sources." + (and (assq attribute-name src) t)) + +(defun* anything-attrset (attribute-name value &optional (src (anything-get-current-source))) + "Set the value of ATTRIBUTE-NAME of SRC (source) to VALUE. +if SRC is omitted, use current source. +It is useful to write your sources." + (anything-aif (assq attribute-name src) + (setcdr it value) + (setcdr src (cons (cons attribute-name value) (cdr src)))) + value) + +;; anything-set-source-filter +;; +;; This function sets a filter for anything sources and it may be +;; called while anything is running. It can be used to toggle +;; displaying of sources dinamically. For example, additional keys +;; can be bound into `anything-map' to display only the file-related +;; results if there are too many matches from other sources and +;; you're after files only: +;; +;; Shift+F shows only file results from some sources: +;; +;; (define-key anything-map "F" 'anything-my-show-files-only) +;; +;; (defun anything-my-show-files-only () +;; (interactive) +;; (anything-set-source-filter '("File Name History" +;; "Files from Current Directory"))) +;; +;; Shift+A shows all results: +;; +;; (define-key anything-map "A" 'anything-my-show-all) +;; +;; (defun anything-my-show-all () +;; (interactive) +;; (anything-set-source-filter nil)) +;; +;; +;; Note that you have to prefix the functions with anything- prefix, +;; otherwise they won't be bound when Anything is used under +;; Iswitchb. The -my- part is added to avoid collisions with +;; existing Anything function names. +;; +(defun anything-set-source-filter (sources) + "Sets the value of `anything-source-filter' and updates the list of results." + (setq anything-source-filter sources) + (anything-update)) + +(defun anything-set-sources (sources &optional no-init no-update) + "Set `anything-sources' during `anything' invocation. +If NO-INIT is non-nil, skip executing init functions of SOURCES. +If NO-UPDATE is non-nil, skip executing `anything-update'." + (setq anything-compiled-sources nil + anything-sources sources) + (unless no-init (anything-funcall-foreach 'init)) + (unless no-update (anything-update))) + +(defun anything-get-sources () + "Return compiled `anything-sources', which is memoized. + +Attributes: + +- type + `anything-type-attributes' are merged in. +- candidates-buffer + candidates, volatile and match attrubute are created. +" + (cond + ;; action + ((anything-action-window) + anything-sources) + ;; memoized + (anything-compiled-sources) + ;; first time + (t + (setq anything-compiled-sources + (anything-compile-sources anything-sources anything-compile-source-functions))))) + +(defun* anything-get-selection (&optional (buffer anything-buffer)) + "Return the currently selected item or nil." + (unless (zerop (buffer-size (get-buffer buffer))) + (with-current-buffer buffer + (let ((selection + (or (get-text-property (overlay-start + anything-selection-overlay) + 'anything-realvalue) + (buffer-substring-no-properties + (overlay-start anything-selection-overlay) + (1- (overlay-end anything-selection-overlay)))))) + (unless (equal selection "") + selection))))) + +(defun anything-get-action () + "Return the associated action for the selected candidate." + (unless (zerop (buffer-size (get-buffer (anything-buffer-get)))) + (let* ((source (anything-get-current-source)) + (actions (assoc-default 'action source))) + + (anything-aif (assoc-default 'action-transformer source) + (funcall it actions (anything-get-selection)) + actions)))) + +(defun anything-get-current-source () + "Return the source for the current selection / in init/candidates/action/candidate-transformer/filtered-candidate-transformer function." + (declare (special source)) + ;; The name `anything-get-current-source' should be used in init function etc. + (if (and (boundp 'anything-source-name) (stringp anything-source-name)) + source + (with-current-buffer (anything-buffer-get) + ;; This goto-char shouldn't be necessary, but point is moved to + ;; point-min somewhere else which shouldn't happen. + (goto-char (overlay-start anything-selection-overlay)) + (let* ((header-pos (anything-get-previous-header-pos)) + (source-name + (save-excursion + (assert header-pos) + (goto-char header-pos) + (buffer-substring-no-properties + (line-beginning-position) (line-end-position))))) + (some (lambda (source) + (if (equal (assoc-default 'name source) + source-name) + source)) + (anything-get-sources)))))) + +(defun anything-buffer-is-modified (buffer) + "Return non-nil when BUFFER is modified since `anything' was invoked." + (let* ((b (get-buffer buffer)) + (key (concat (buffer-name b) + "/" + (anything-attr 'name))) + (source-tick (or (gethash key anything-tick-hash) 0)) + (buffer-tick (buffer-chars-modified-tick b))) + (prog1 (/= source-tick buffer-tick) + (puthash key buffer-tick anything-tick-hash)))) +(defun anything-current-buffer-is-modified () + "Return non-nil when `anything-current-buffer' is modified since `anything' was invoked." + (anything-buffer-is-modified anything-current-buffer)) + +;; (@* "Core: tools") +(defun anything-current-frame/window-configuration () + (funcall (cdr anything-save-configuration-functions))) + +(defun anything-set-frame/window-configuration (conf) + (funcall (car anything-save-configuration-functions) conf)) + +(defun anything-funcall-with-source (source func &rest args) + (let ((anything-source-name (assoc-default 'name source))) + (apply func args))) + +(defun anything-funcall-foreach (sym) + "Call the sym function(s) for each source if any." + (dolist (source (anything-get-sources)) + (when (symbolp source) + (setq source (symbol-value source))) + (anything-aif (assoc-default sym source) + (dolist (func (if (functionp it) (list it) it)) + (anything-funcall-with-source source func))))) + +(defun anything-normalize-sources (sources) + (cond ((and sources (symbolp sources)) (list sources)) + (sources) + (t anything-sources))) + +;; (@* "Core: entry point") +(defun anything (&optional any-sources any-input any-prompt any-resume any-preselect any-buffer) + "Select anything. In Lisp program, some optional arguments can be used. + +Note that all the optional arguments are prefixed because of +dynamic scope problem, IOW argument variables may eat +already-bound variables. Yuck! + +- ANY-SOURCES + + Temporary value of `anything-sources'. ANY-SOURCES accepts a + symbol, interpreted as a variable of an anything source. + +- ANY-INPUT + + Temporary value of `anything-pattern', ie. initial input of minibuffer. + +- ANY-PROMPT + + Prompt other than \"pattern: \". + +- ANY-RESUME + + Resurrect previously instance of `anything'. Skip the initialization. + +- ANY-PRESELECT + + Initially selected candidate. Specified by exact candidate or a regexp. + +- ANY-BUFFER + + `anything-buffer' instead of *anything*. +" + ;; TODO more document + (interactive) + (condition-case v + (with-anything-restore-variables + (let ((frameconfig (anything-current-frame/window-configuration)) + ;; It is needed because `anything-source-name' is non-nil + ;; when `anything' is invoked by action. Awful global scope. + anything-source-name anything-in-persistent-action + (anything-buffer (or any-buffer anything-buffer)) + (anything-sources (anything-normalize-sources any-sources))) + + (add-hook 'post-command-hook 'anything-check-minibuffer-input) + + (setq anything-current-position (cons (point) (window-start))) + (if any-resume + (anything-initialize-overlays (anything-buffer-get)) + (anything-initialize)) + (setq anything-last-buffer anything-buffer) + (when any-input (setq anything-input any-input anything-pattern any-input)) + (if anything-samewindow + (switch-to-buffer anything-buffer) + (pop-to-buffer anything-buffer)) + + (unwind-protect + (progn + (if any-resume (anything-mark-current-line) (anything-update)) + (select-frame-set-input-focus (window-frame (minibuffer-window))) + (anything-preselect any-preselect) + (let ((minibuffer-local-map anything-map)) + (read-string (or any-prompt "pattern: ") (if any-resume anything-pattern any-input)))) + + (anything-cleanup) + (remove-hook 'post-command-hook 'anything-check-minibuffer-input) + (anything-set-frame/window-configuration frameconfig)) + (unwind-protect + (anything-execute-selection-action) + (anything-aif (get-buffer anything-action-buffer) + (kill-buffer it)) + (run-hooks 'anything-after-action-hook)))) + (quit + (goto-char (car anything-current-position)) + (set-window-start (selected-window) (cdr anything-current-position)) + nil))) + +(defun* anything-resume (&optional (any-buffer anything-last-buffer)) + "Resurrect previously invoked `anything'." + (interactive) + (when current-prefix-arg + (setq any-buffer + (completing-read + "Resume anything buffer: " + (delq nil + (mapcar (lambda (b) + (when (buffer-local-value 'anything-last-sources-local b) + (list (buffer-name b)))) (buffer-list))) + nil t nil nil anything-buffer))) + (setq anything-compiled-sources nil) + (anything + (or (buffer-local-value 'anything-last-sources-local (get-buffer any-buffer)) + anything-last-sources anything-sources) + nil nil t nil any-buffer)) + +;; (@* "Core: initialize") +(defun anything-initialize () + "Initialize anything settings and set up the anything buffer." + (run-hooks 'anything-before-initialize-hook) + (setq anything-current-buffer (current-buffer)) + (setq anything-buffer-file-name buffer-file-name) + (setq anything-compiled-sources nil) + (setq anything-saved-current-source nil) + ;; Call the init function for sources where appropriate + (anything-funcall-foreach 'init) + + (setq anything-pattern "") + (setq anything-input "") + (setq anything-candidate-cache nil) + (setq anything-last-sources anything-sources) + + (anything-create-anything-buffer) + (run-hooks 'anything-after-initialize-hook)) + +(defun anything-create-anything-buffer (&optional test-mode) + "Create newly created `anything-buffer'. +If TEST-MODE is non-nil, clear `anything-candidate-cache'." + (when test-mode + (setq anything-candidate-cache nil)) + (with-current-buffer (get-buffer-create anything-buffer) + (buffer-disable-undo) + (erase-buffer) + (set (make-local-variable 'inhibit-read-only) t) + (set (make-local-variable 'anything-last-sources-local) anything-sources) + (setq cursor-type nil) + (setq mode-name "Anything")) + (anything-initialize-overlays anything-buffer) + (get-buffer anything-buffer)) + +(defun anything-initialize-overlays (buffer) + (if anything-selection-overlay + ;; make sure the overlay belongs to the anything buffer if + ;; it's newly created + (move-overlay anything-selection-overlay (point-min) (point-min) + (get-buffer buffer)) + + (setq anything-selection-overlay + (make-overlay (point-min) (point-min) (get-buffer buffer))) + (overlay-put anything-selection-overlay 'face 'highlight)) + + (if anything-enable-digit-shortcuts + (unless anything-digit-overlays + (dotimes (i 9) + (push (make-overlay (point-min) (point-min) + (get-buffer buffer)) + anything-digit-overlays) + (overlay-put (car anything-digit-overlays) + 'before-string (concat (int-to-string (1+ i)) " - "))) + (setq anything-digit-overlays (nreverse anything-digit-overlays))) + + (when anything-digit-overlays + (dolist (overlay anything-digit-overlays) + (delete-overlay overlay)) + (setq anything-digit-overlays nil)))) + +;; (@* "Core: clean up") +(defun anything-cleanup () + "Clean up the mess." + (with-current-buffer anything-buffer + (setq cursor-type t)) + (bury-buffer anything-buffer) + (anything-funcall-foreach 'cleanup) + (anything-kill-async-processes) + (run-hooks 'anything-cleanup-hook)) + +;; (@* "Core: input handling") +(defun anything-check-minibuffer-input () + "Extract input string from the minibuffer and check if it needs +to be handled." + (if (or (not anything-input-idle-delay) (anything-action-window)) + (anything-check-minibuffer-input-1) + (if anything-check-minibuffer-input-timer + (cancel-timer anything-check-minibuffer-input-timer)) + (setq anything-check-minibuffer-input-timer + (run-with-idle-timer anything-input-idle-delay nil + 'anything-check-minibuffer-input-1)))) + +(defun anything-check-minibuffer-input-1 () + (let (inhibit-quit) + (with-selected-window (minibuffer-window) + (anything-check-new-input (minibuffer-contents))))) +(defun anything-check-new-input (input) + "Check input string and update the anything buffer if +necessary." + (unless (equal input anything-pattern) + (setq anything-pattern input) + (unless (anything-action-window) + (setq anything-input anything-pattern)) + (anything-update))) + +;; (@* "Core: source compiler") +(defvar anything-compile-source-functions + '(anything-compile-source--type anything-compile-source--dummy anything-compile-source--candidates-in-buffer) + "Functions to compile elements of `anything-sources' (plug-in).") +(defvar anything-compile-source-functions-default anything-compile-source-functions + "Plug-ins this file provides.") +(defun anything-compile-sources (sources funcs) + "Compile sources (`anything-sources') with funcs (`anything-compile-source-functions'). +Anything plug-ins are realized by this function." + (mapcar + (lambda (source) + (loop with source = (if (listp source) source (symbol-value source)) + for f in funcs + do (setq source (funcall f source)) + finally (return source))) + sources)) + +;; (@* "Core: all candidates") +(defun anything-get-candidates (source) + "Retrieve and return the list of candidates from +SOURCE." + (let* ((candidate-source (assoc-default 'candidates source)) + (candidates + (if (functionp candidate-source) + (anything-funcall-with-source source candidate-source) + (if (listp candidate-source) + candidate-source + (if (and (symbolp candidate-source) + (boundp candidate-source)) + (symbol-value candidate-source) + (error (concat "Candidates must either be a function, " + " a variable or a list: %s") + candidate-source)))))) + (if (processp candidates) + candidates + (anything-transform-candidates candidates source)))) + + +(defun anything-transform-candidates (candidates source) + "Transform CANDIDATES according to candidate transformers." + (anything-aif (assoc-default 'candidate-transformer source) + (anything-funcall-with-source source it candidates) + candidates)) + + +(defun anything-get-cached-candidates (source) + "Return the cached value of candidates for SOURCE. +Cache the candidates if there is not yet a cached value." + (let* ((name (assoc-default 'name source)) + (candidate-cache (assoc name anything-candidate-cache)) + candidates) + + (if candidate-cache + (setq candidates (cdr candidate-cache)) + + (setq candidates (anything-get-candidates source)) + + (if (processp candidates) + (progn + (push (cons candidates + (append source + (list (cons 'item-count 0) + (cons 'incomplete-line "")))) + anything-async-processes) + (set-process-filter candidates 'anything-output-filter) + (setq candidates nil)) + + (unless (assoc 'volatile source) + (setq candidate-cache (cons name candidates)) + (push candidate-cache anything-candidate-cache)))) + + candidates)) + +;; (@* "Core: narrowing candidates") +(defun anything-candidate-number-limit (source) + "`anything-candidate-number-limit' variable may be overridden by SOURCE." + (or (assoc-default 'candidate-number-limit source) + anything-candidate-number-limit + 99999999)) + +(defun anything-compute-matches (source) + "Compute matches from SOURCE according to its settings." + (let ((functions (assoc-default 'match source)) + (limit (anything-candidate-number-limit source)) + matches) + (if (or (equal anything-pattern "") (equal functions '(identity))) + (progn + (setq matches (anything-get-cached-candidates source)) + (if (> (length matches) limit) + (setq matches + (subseq matches 0 limit)))) + + (condition-case nil + (let ((item-count 0) + (cands (anything-get-cached-candidates source)) + exit) + + (unless functions + (setq functions + (list (lambda (candidate) + (string-match anything-pattern candidate))))) + + (clrhash anything-match-hash) + (dolist (function functions) + (let (newmatches) + (dolist (candidate cands) + (when (and (not (gethash candidate anything-match-hash)) + (funcall function (if (listp candidate) + (car candidate) + candidate))) + (puthash candidate t anything-match-hash) + (push candidate newmatches) + + (when limit + (incf item-count) + (when (= item-count limit) + (setq exit t) + (return))))) + + (setq matches (append matches (reverse newmatches))) + + (if exit + (return))))) + + (invalid-regexp (setq matches nil)))) + + (anything-aif (assoc-default 'filtered-candidate-transformer source) + (setq matches + (anything-funcall-with-source source it matches source))) + matches)) + +(defun anything-process-source (source) + "Display matches from SOURCE according to its settings." + (let ((matches (anything-compute-matches source))) + (when matches + (when anything-test-mode + (setq anything-test-candidate-list + `(,@anything-test-candidate-list + (,(assoc-default 'name source) + ,matches)))) + (let ((multiline (assoc 'multiline source)) + (start (point)) + separate) + (anything-insert-header-from-source source) + (dolist (match matches) + (when (and anything-enable-digit-shortcuts + (not (eq anything-digit-shortcut-count 9))) + (move-overlay (nth anything-digit-shortcut-count + anything-digit-overlays) + (line-beginning-position) + (line-beginning-position)) + (incf anything-digit-shortcut-count)) + + (if (and multiline separate) + (anything-insert-candidate-separator) + (setq separate t)) + (anything-insert-match match 'insert)) + + (if multiline + (put-text-property start (point) 'anything-multiline t)))))) + +(defun anything-process-delayed-sources (delayed-sources) + "Process delayed sources if the user is idle for +`anything-idle-delay' seconds." + (let (inhibit-quit) + (if (sit-for (if anything-input-idle-delay + (max 0 (- anything-idle-delay anything-input-idle-delay)) + anything-idle-delay)) + (with-current-buffer anything-buffer + (save-excursion + (goto-char (point-max)) + (dolist (source delayed-sources) + (anything-process-source source)) + + (when (and (not (equal (buffer-size) 0)) + ;; no selection yet + (= (overlay-start anything-selection-overlay) + (overlay-end anything-selection-overlay))) + (goto-char (point-min)) + (run-hooks 'anything-update-hook) + (anything-next-line))) + + (anything-maybe-fit-frame))))) + +;; (@* "Core: *anything* buffer contents") +(defun anything-update () + "Update the list of matches in the anything buffer according to +the current pattern." + (setq anything-digit-shortcut-count 0) + (anything-kill-async-processes) + (with-current-buffer (anything-buffer-get) + (erase-buffer) + + (if anything-enable-digit-shortcuts + (dolist (overlay anything-digit-overlays) + (delete-overlay overlay))) + + (let (delayed-sources) + (dolist (source (anything-get-sources)) + (when (and (or (not anything-source-filter) + (member (assoc-default 'name source) anything-source-filter)) + (>= (length anything-pattern) + (anything-aif (assoc 'requires-pattern source) + (or (cdr it) 1) + 0))) + (if (or (assoc 'delayed source) + (and anything-quick-update + (< (window-height (get-buffer-window (current-buffer))) + (line-number-at-pos (point-max))))) + (push source delayed-sources) + (anything-process-source source)))) + + (goto-char (point-min)) + (run-hooks 'anything-update-hook) + (anything-next-line) + + (setq delayed-sources (nreverse delayed-sources)) + (if anything-test-mode + (dolist (source delayed-sources) + (anything-process-source source)) + (anything-maybe-fit-frame) + (run-with-idle-timer (if (featurep 'xemacs) + 0.1 + 0) + nil + 'anything-process-delayed-sources + delayed-sources))))) + +(defun anything-insert-match (match insert-function) + "Insert MATCH into the anything buffer. If MATCH is a list then +insert the string inteneded to appear on the display and store +the real value in a text property." + (let ((start (line-beginning-position (point))) + (string (if (listp match) (car match) match)) + (realvalue (if (listp match) (cdr match) match))) + (funcall insert-function string) + ;; Some sources with candidates-in-buffer have already added + ;; 'anything-realvalue property when creating candidate buffer. + (unless (get-text-property start 'anything-realvalue) + (put-text-property start (line-end-position) + 'anything-realvalue realvalue))) + (funcall insert-function "\n")) + +(defun anything-insert-header-from-source (source) + (let ((name (assoc-default 'name source))) + (anything-insert-header name + (anything-aif (assoc-default 'header-name source) + (funcall it name))))) + +(defun anything-insert-header (name &optional display-string) + "Insert header of source NAME into the anything buffer." + (unless (bobp) + (let ((start (point))) + (insert "\n") + (put-text-property start (point) 'anything-header-separator t))) + + (let ((start (point))) + (insert name) + (put-text-property (line-beginning-position) + (line-end-position) 'anything-header t) + (when display-string + (overlay-put (make-overlay (line-beginning-position) (line-end-position)) + 'display display-string)) + (insert "\n") + (put-text-property start (point) 'face anything-header-face))) + + +(defun anything-insert-candidate-separator () + "Insert separator of candidates into the anything buffer." + (insert anything-candidate-separator) + (put-text-property (line-beginning-position) + (line-end-position) 'anything-candidate-separator t) + (insert "\n")) + + + + +;; (@* "Core: async process") +(defun anything-output-filter (process string) + "Process output from PROCESS." + (let* ((process-assoc (assoc process anything-async-processes)) + (process-info (cdr process-assoc)) + (insertion-marker (assoc-default 'insertion-marker process-info)) + (incomplete-line-info (assoc 'incomplete-line process-info)) + (item-count-info (assoc 'item-count process-info))) + + (with-current-buffer anything-buffer + (save-excursion + (if insertion-marker + (goto-char insertion-marker) + + (goto-char (point-max)) + (anything-insert-header-from-source process-info) + (setcdr process-assoc + (append process-info `((insertion-marker . ,(point-marker)))))) + + (let ((lines (split-string string "\n")) + candidates) + (while lines + (if (not (cdr lines)) + ;; store last incomplete line until new output arrives + (setcdr incomplete-line-info (car lines)) + + (if (cdr incomplete-line-info) + (progn + (push (concat (cdr incomplete-line-info) (car lines)) + candidates) + (setcdr incomplete-line-info nil)) + + (push (car lines) candidates))) + + (pop lines)) + + (setq candidates (reverse candidates)) + (dolist (candidate (anything-transform-candidates candidates process-info)) + (anything-insert-match candidate 'insert-before-markers) + (incf (cdr item-count-info)) + (when (>= (cdr item-count-info) anything-candidate-number-limit) + (anything-kill-async-process process) + (return))))) + + (anything-maybe-fit-frame) + + (run-hooks 'anything-update-hook) + + (if (bobp) + (anything-next-line) + + (save-selected-window + (select-window (get-buffer-window anything-buffer 'visible)) + (anything-mark-current-line)))))) + + +(defun anything-kill-async-processes () + "Kill all known asynchronous processes according to +`anything-async-processes'." + "Kill locate process." + (dolist (process-info anything-async-processes) + (anything-kill-async-process (car process-info))) + (setq anything-async-processes nil)) + + +(defun anything-kill-async-process (process) + "Kill PROCESS and detach the associated functions." + (set-process-filter process nil) + (delete-process process)) + + +;; (@* "Core: action") +(defun anything-execute-selection-action (&optional selection action clear-saved-action display-to-real) + "If a candidate was selected then perform the associated +action." + (setq selection (or selection (anything-get-selection))) + (setq action (or action + anything-saved-action + (if (get-buffer anything-action-buffer) + (anything-get-selection anything-action-buffer) + (anything-get-action)))) + (let ((source (or anything-saved-current-source (anything-get-current-source)))) + (if (and (not selection) (assoc 'accept-empty source)) + (setq selection "")) + (setq display-to-real + (or display-to-real (assoc-default 'display-to-real source) + #'identity)) + (if (and (listp action) + (not (functionp action))) ; lambda + ;;select the default action + (setq action (cdar action))) + (unless clear-saved-action (setq anything-saved-action nil)) + (if (and selection action) + (anything-funcall-with-source + source action + (anything-funcall-with-source source display-to-real selection))))) + +(defun anything-select-action () + "Select an action for the currently selected candidate. +If action buffer is selected, back to the anything buffer." + (interactive) + (cond ((get-buffer-window anything-action-buffer 'visible) + (set-window-buffer (get-buffer-window anything-action-buffer) anything-buffer) + (kill-buffer anything-action-buffer)) + (t + (setq anything-saved-selection (anything-get-selection)) + (unless anything-saved-selection + (error "Nothing is selected.")) + (setq anything-saved-current-source (anything-get-current-source)) + (let ((actions (anything-get-action))) + (with-current-buffer (get-buffer-create anything-action-buffer) + (erase-buffer) + (buffer-disable-undo) + (set-window-buffer (get-buffer-window anything-buffer) anything-action-buffer) + (set (make-local-variable 'anything-sources) + `(((name . "Actions") + (candidates . ,actions)))) + (set (make-local-variable 'anything-source-filter) nil) + (set (make-local-variable 'anything-selection-overlay) nil) + (set (make-local-variable 'anything-digit-overlays) nil) + (anything-initialize-overlays anything-action-buffer)) + (with-selected-window (minibuffer-window) + (delete-minibuffer-contents)) + (setq anything-pattern 'dummy) ; so that it differs from the + ; previous one + + (anything-check-minibuffer-input))))) + +;; (@* "Core: selection") +(defun anything-previous-line () + "Move selection to the previous line." + (interactive) + (anything-move-selection 'line 'previous)) + +(defun anything-next-line () + "Move selection to the next line." + (interactive) + (anything-move-selection 'line 'next)) + +(defun anything-previous-page () + "Move selection back with a pageful." + (interactive) + (anything-move-selection 'page 'previous)) + +(defun anything-next-page () + "Move selection forward with a pageful." + (interactive) + (anything-move-selection 'page 'next)) + + +(defun anything-previous-source () + "Move selection to the previous source." + (interactive) + (anything-move-selection 'source 'previous)) + + +(defun anything-next-source () + "Move selection to the next source." + (interactive) + (anything-move-selection 'source 'next)) + + +(defun anything-move-selection (unit direction) + "Move the selection marker to a new position determined by +UNIT and DIRECTION." + (unless (or (zerop (buffer-size (get-buffer (anything-buffer-get)))) + (not (anything-window))) + (with-anything-window + (case unit + (line (case direction + (next (if (not (anything-pos-multiline-p)) + (forward-line 1) + (let ((header-pos (anything-get-next-header-pos)) + (candidate-pos (anything-get-next-candidate-separator-pos))) + (if (and candidate-pos + (or (null header-pos) + (< candidate-pos header-pos))) + (goto-char candidate-pos) + (if header-pos + (goto-char header-pos))) + (if candidate-pos + (forward-line 1))))) + + (previous (progn + (forward-line -1) + (when (anything-pos-multiline-p) + (if (or (anything-pos-header-line-p) + (anything-pos-candidate-separator-p)) + (forward-line -1) + (forward-line 1)) + (let ((header-pos (anything-get-previous-header-pos)) + (candidate-pos (anything-get-previous-candidate-separator-pos))) + (when header-pos + (if (or (null candidate-pos) (< candidate-pos header-pos)) + (goto-char header-pos) + (goto-char candidate-pos)) + (forward-line 1)))))) + + (t (error "Invalid direction.")))) + + (page (case direction + (next (condition-case nil + (scroll-up) + (end-of-buffer (goto-char (point-max))))) + (previous (condition-case nil + (scroll-down) + (beginning-of-buffer (goto-char (point-min))))) + (t (error "Invalid direction.")))) + + (source (case direction + (next (goto-char (or (anything-get-next-header-pos) + (point-min)))) + (previous (progn + (forward-line -1) + (if (bobp) + (goto-char (point-max)) + (if (anything-pos-header-line-p) + (forward-line -1) + (forward-line 1))) + (goto-char (anything-get-previous-header-pos)) + (forward-line 1))) + (t (error "Invalid direction.")))) + + (t (error "Invalid unit."))) + + (while (and (not (bobp)) + (or (anything-pos-header-line-p) + (anything-pos-candidate-separator-p))) + (forward-line (if (and (eq direction 'previous) + (not (eq (line-beginning-position) + (point-min)))) + -1 + 1))) + (if (bobp) + (forward-line 1)) + (if (eobp) + (forward-line -1)) + + (anything-mark-current-line)))) + + +(defun anything-mark-current-line () + "Move selection overlay to current line." + (move-overlay anything-selection-overlay + (line-beginning-position) + (if (anything-pos-multiline-p) + (let ((header-pos (anything-get-next-header-pos)) + (candidate-pos (anything-get-next-candidate-separator-pos))) + (or (and (null header-pos) candidate-pos candidate-pos) + (and header-pos candidate-pos (< candidate-pos header-pos) candidate-pos) + header-pos + (point-max))) + (1+ (line-end-position))))) + + +(defun anything-select-with-digit-shortcut () + (interactive) + (if anything-enable-digit-shortcuts + (save-selected-window + (select-window (anything-window)) + (let* ((index (- (event-basic-type (elt (this-command-keys-vector) 0)) ?1)) + (overlay (nth index anything-digit-overlays))) + (when (overlay-buffer overlay) + (goto-char (overlay-start overlay)) + (anything-mark-current-line) + (anything-exit-minibuffer)))))) + + +(defun anything-exit-minibuffer () + "Select the current candidate by exiting the minibuffer." + (interactive) + (declare (special anything-iswitchb-candidate-selected)) + (setq anything-iswitchb-candidate-selected (anything-get-selection)) + (exit-minibuffer)) + + +(defun anything-get-next-header-pos () + "Return the position of the next header from point." + (next-single-property-change (point) 'anything-header)) + + +(defun anything-get-previous-header-pos () + "Return the position of the previous header from point" + (previous-single-property-change (point) 'anything-header)) + + +(defun anything-pos-multiline-p () + "Return non-nil if the current position is in the multiline source region." + (get-text-property (point) 'anything-multiline)) + + +(defun anything-get-next-candidate-separator-pos () + "Return the position of the next candidate separator from point." + (next-single-property-change (point) 'anything-candidate-separator)) + + +(defun anything-get-previous-candidate-separator-pos () + "Return the position of the previous candidate separator from point." + (previous-single-property-change (point) 'anything-candidate-separator)) + + +(defun anything-pos-header-line-p () + "Return t if the current line is a header line." + (or (get-text-property (line-beginning-position) 'anything-header) + (get-text-property (line-beginning-position) 'anything-header-separator))) + +(defun anything-pos-candidate-separator-p () + "Return t if the current line is a candidate separator." + (get-text-property (line-beginning-position) 'anything-candidate-separator)) + +;; (@* "Core: misc") +(defun anything-kill-buffer-hook () + "Remove tick entry from `anything-tick-hash' when killing a buffer." + (loop for key being the hash-keys in anything-tick-hash + if (string-match (format "^%s/" (regexp-quote (buffer-name))) key) + do (remhash key anything-tick-hash))) +(add-hook 'kill-buffer-hook 'anything-kill-buffer-hook) + +(defun anything-maybe-fit-frame () + "Fit anything frame to its buffer, and put it at top right of display. + To inhibit fitting, set `fit-frame-inhibit-fitting-flag' to t. + You can set user options `fit-frame-max-width-percent' and + `fit-frame-max-height-percent' to control max frame size." + (declare (warn (unresolved 0))) + (when (and (require 'fit-frame nil t) + (boundp 'fit-frame-inhibit-fitting-flag) + (not fit-frame-inhibit-fitting-flag) + (anything-window)) + (with-anything-window + (fit-frame nil nil nil t) + (modify-frame-parameters + (selected-frame) + `((left . ,(- (x-display-pixel-width) (+ (frame-pixel-width) 7))) + (top . 0)))))) ; The (top . 0) shouldn't be necessary (Emacs bug). + +(defun anything-preselect (candidate-or-regexp) + (when candidate-or-regexp + (with-anything-window + (goto-char (point-min)) + ;; go to first candidate of first source + (forward-line 1) + (let ((start (point))) + (unless (or (re-search-forward (concat "^" (regexp-quote candidate-or-regexp) "$") nil t) + (progn (goto-char start) + (re-search-forward candidate-or-regexp nil t))) + (goto-char start)) + (anything-mark-current-line))))) + +(defun anything-delete-current-selection () + "Delete the currently selected item." + (interactive) + (with-anything-window + (cond ((anything-pos-multiline-p) + (anything-aif (anything-get-next-candidate-separator-pos) + (delete-region (point-at-bol) + (1+ (progn (goto-char it) (point-at-eol)))) + ;; last candidate + (goto-char (anything-get-previous-candidate-separator-pos)) + (delete-region (point-at-bol) (point-max))) + (when (eobp) + (goto-char (or (anything-get-previous-candidate-separator-pos) + (point-min))) + (forward-line 1))) + (t + (delete-region (point-at-bol) (1+ (point-at-eol))) + (when (eobp) (forward-line -1)))) + (anything-mark-current-line))) + +;; (@* "Built-in plug-in: type") +(defun anything-compile-source--type (source) + (anything-aif (assoc-default 'type source) + (append source (assoc-default it anything-type-attributes) nil) + source)) + +;; (@* "Built-in plug-in: dummy") +(defun anything-dummy-candidate (candidate source) + ;; `source' is defined in filtered-candidate-transformer + (list anything-pattern)) + +(defun anything-compile-source--dummy (source) + (if (assoc 'dummy source) + (append '((candidates "dummy") + (accept-empty) + (match identity) + (filtered-candidate-transformer . anything-dummy-candidate) + (volatile)) + source) + source)) + +;; (@* "Built-in plug-in: candidates-in-buffer") +(defun anything-candidates-in-buffer () + "Get candidates from the candidates buffer according to `anything-pattern'. + +BUFFER is `anything-candidate-buffer' by default. Each +candidate must be placed in one line. This function is meant to +be used in candidates-in-buffer or candidates attribute of an +anything source. Especially fast for many (1000+) candidates. + +eg. + '((name . \"many files\") + (init . (lambda () (with-current-buffer (anything-candidate-buffer 'local) + (insert-many-filenames)))) + (search re-search-forward) ; optional + (candidates-in-buffer) + (type . file)) + ++===============================================================+ +| The new way of making and narrowing candidates: Using buffers | ++===============================================================+ + +By default, `anything' makes candidates by evaluating the +candidates function, then narrows them by `string-match' for each +candidate. + +But this way is very slow for many candidates. The new way is +storing all candidates in a buffer and narrowing them by +`re-search-forward'. Search function is customizable by search +attribute. The important point is that buffer processing is MUCH +FASTER than string list processing and is the Emacs way. + +The init function writes all candidates to a newly-created +candidate buffer. The candidates buffer is created or specified +by `anything-candidate-buffer'. Candidates are stored in a line. + +The candidates function narrows all candidates, IOW creates a +subset of candidates dynamically. It is the task of +`anything-candidates-in-buffer'. As long as +`anything-candidate-buffer' is used,`(candidates-in-buffer)' is +sufficient in most cases. + +Note that `(candidates-in-buffer)' is shortcut of three attributes: + (candidates . anything-candidates-in-buffer) + (volatile) + (match identity) +And `(candidates-in-buffer . func)' is shortcut of three attributes: + (candidates . func) + (volatile) + (match identity) +The expansion is performed in `anything-get-sources'. + +The candidates-in-buffer attribute implies the volatile attribute. +The volatile attribute is needed because `anything-candidates-in-buffer' +creates candidates dynamically and need to be called everytime +`anything-pattern' changes. + +Because `anything-candidates-in-buffer' plays the role of `match' attribute +function, specifying `(match identity)' makes the source slightly faster. + +To customize `anything-candidates-in-buffer' behavior, use search, +get-line and search-from-end attributes. See also `anything-sources' docstring. +" + (declare (special source)) + (anything-candidates-in-buffer-1 (anything-candidate-buffer) + anything-pattern + (or (assoc-default 'get-line source) + #'buffer-substring-no-properties) + ;; use external variable `source'. + (or (assoc-default 'search source) + (if (assoc 'search-from-end source) + '(re-search-backward) + '(re-search-forward))) + (anything-candidate-number-limit source) + (assoc 'search-from-end source))) + +(defun* anything-candidates-in-buffer-1 (buffer &optional (pattern anything-pattern) (get-line-fn 'buffer-substring-no-properties) (search-fns '(re-search-forward)) (limit anything-candidate-number-limit) search-from-end) + ;; buffer == nil when candidates buffer does not exist. + (when buffer + (with-current-buffer buffer + (let ((start-point (if search-from-end (point-max) (point-min))) + (next-line-fn (if search-from-end + (lambda (x) (goto-char (max (1- (point-at-bol)) 1))) + #'forward-line)) + (endp (if search-from-end #'bobp #'eobp))) + (goto-char (1- start-point)) + (if (string= pattern "") + (delq nil (loop until (funcall endp) + for i from 1 to limit + collecting (funcall get-line-fn (point-at-bol) (point-at-eol)) + do (funcall next-line-fn 1))) + + (let ((i 1) + (next-line-fn (if search-from-end + (lambda (x) (goto-char (max (point-at-bol) 1))) + #'forward-line)) + buffer-read-only + matches exit newmatches) + (progn + (goto-char (point-min)) + (insert "\n") + (goto-char (point-max)) + (insert "\n") + (setq start-point (if search-from-end (point-max) (point-min))) + (clrhash anything-cib-hash) + (unwind-protect + (dolist (searcher search-fns) + (goto-char start-point) + (setq newmatches nil) + (loop while (funcall searcher pattern nil t) + if (or (funcall endp) (< limit i)) + do (setq exit t) (return) + else do + (let ((cand (funcall get-line-fn (point-at-bol) (point-at-eol)))) + (unless (gethash cand anything-cib-hash) + (puthash cand t anything-cib-hash) + (incf i) + (push cand newmatches))) + (funcall next-line-fn 1)) + (setq matches (append matches (nreverse newmatches))) + (if exit (return))) + (goto-char (point-min)) + (delete-char 1) + (goto-char (1- (point-max))) + (delete-char 1) + + (set-buffer-modified-p nil))) + (delq nil matches))))))) + + +(defun anything-candidate-buffer (&optional create-or-buffer) + "Register and return a buffer containing candidates of current source. +`anything-candidate-buffer' searches buffer-local candidates buffer first, +then global candidates buffer. + +Acceptable values of CREATE-OR-BUFFER: + +- nil (omit) + Only return the candidates buffer. +- a buffer + Register a buffer as a candidates buffer. +- 'global + Create a new global candidates buffer, + named \" *anything candidates:SOURCE*\". +- other non-nil value + Create a new global candidates buffer, + named \" *anything candidates:SOURCE*ANYTHING-CURRENT-BUFFER\". +" + (let* ((gbufname (format " *anything candidates:%s*" anything-source-name)) + (lbufname (concat gbufname (buffer-name anything-current-buffer))) + buf) + (when create-or-buffer + (if (bufferp create-or-buffer) + (add-to-list 'anything-candidate-buffer-alist + (cons anything-source-name create-or-buffer)) + (when (eq create-or-buffer 'global) + (loop for b in (buffer-list) + if (string-match (format "^%s" (regexp-quote gbufname)) (buffer-name b)) + do (kill-buffer b))) + (with-current-buffer + (get-buffer-create (if (eq create-or-buffer 'global) gbufname lbufname)) + (buffer-disable-undo) + (erase-buffer) + (font-lock-mode -1)))) + (or (get-buffer lbufname) + (get-buffer gbufname) + (anything-aif (assoc-default anything-source-name anything-candidate-buffer-alist) + (and (buffer-live-p it) it))))) + +(defun anything-compile-source--candidates-in-buffer (source) + (anything-aif (assoc 'candidates-in-buffer source) + (append source `((candidates . ,(or (cdr it) 'anything-candidates-in-buffer)) + (volatile) (match identity))) + source)) + +;; (@* "Utility: select another action by key") +(defun anything-select-nth-action (n) + "Select the nth action for the currently selected candidate." + (setq anything-saved-selection (anything-get-selection)) + (unless anything-saved-selection + (error "Nothing is selected.")) + (setq anything-saved-action (cdr (elt (anything-get-action) n))) + (anything-exit-minibuffer)) + +(defun anything-select-2nd-action () + "Select the 2nd action for the currently selected candidate." + (interactive) + (anything-select-nth-action 1)) + +(defun anything-select-3rd-action () + "Select the 3rd action for the currently selected candidate." + (interactive) + (anything-select-nth-action 2)) + +(defun anything-select-4th-action () + "Select the 4th action for the currently selected candidate." + (interactive) + (anything-select-nth-action 3)) + + +;; (@* "Utility: Persistent Action") +(defun* anything-execute-persistent-action (&optional (attr 'persistent-action)) + "If a candidate is selected then perform the associated action without quitting anything." + (interactive) + (save-selected-window + (select-window (get-buffer-window (anything-buffer-get))) + (select-window (setq minibuffer-scroll-window + (if (one-window-p t) (split-window) + (next-window (selected-window) 1)))) + (let ((anything-in-persistent-action t)) + (with-anything-display-same-window + (anything-execute-selection-action + nil + (or (assoc-default attr (anything-get-current-source)) + (anything-get-action)) + t) + (run-hooks 'anything-after-persistent-action-hook))))) + +(defmacro with-anything-display-same-window (&rest body) + "Make `pop-to-buffer' and `display-buffer' display in the same window." + `(let ((same-window-regexps '(".")) + (pop-up-windows nil) + (display-buffer-function nil)) + ,@body)) +(put 'with-anything-display-same-window 'lisp-indent-function 0) + +;; scroll-other-window(-down)? for persistent-action +(defun anything-scroll-other-window-base (command) + (save-selected-window + (other-window 2) + (call-interactively command))) + +(defun anything-scroll-other-window () + "Scroll other window (not *Anything* window) upward." + (interactive) + (anything-scroll-other-window-base 'scroll-other-window)) +(defun anything-scroll-other-window-down () + "Scroll other window (not *Anything* window) downward." + (interactive) + (anything-scroll-other-window-base 'scroll-other-window-down)) + +;; (@* "Utility: Incremental search within results") + +(defvar anything-isearch-original-global-map nil + "Original global map before Anything isearch is started.") + +(defvar anything-isearch-original-message-timeout nil + "Original message timeout before Anything isearch is started.") + +(defvar anything-isearch-pattern nil + "The current isearch pattern.") + +(defvar anything-isearch-message-suffix "" + "Message suffix indicating the current state of the search.") + +(defvar anything-isearch-original-point nil + "Original position of point before isearch is started.") + +(defvar anything-isearch-original-window nil + "Original selected window before isearch is started.") + +(defvar anything-isearch-original-cursor-in-non-selected-windows nil + "Original value of cursor-in-non-selected-windows before isearch is started.") + +(defvar anything-isearch-original-post-command-hook nil + "Original value of post-command-hook before isearch is started.") + +(defvar anything-isearch-match-positions nil + "Stack of positions of matches or non-matches. + +It's a list of plists with two properties: `event', the last user + event, `start', the start position of the current match, and + `pos', the position of point after that event. + +The value of `event' can be the following symbols: `char' if a +character was typed, `error' if a non-matching character was +typed, `search' if a forward search had to be done after a +character, and `search-again' if a search was done for the next +occurrence of the current pattern.") + +(defvar anything-isearch-match-start nil + "Start position of the current match.") + + +(defun anything-isearch () + "Start incremental search within results." + (interactive) + (if (zerop (buffer-size (get-buffer (anything-buffer-get)))) + (message "There are no results.") + + (setq anything-isearch-original-message-timeout minibuffer-message-timeout) + (setq minibuffer-message-timeout nil) + + (setq anything-isearch-original-global-map global-map) + + (condition-case nil + (progn + (setq anything-isearch-original-window (selected-window)) + (select-window (anything-window)) + (setq cursor-type t) + + (setq anything-isearch-original-post-command-hook + (default-value 'post-command-hook)) + (setq-default post-command-hook nil) + (add-hook 'post-command-hook 'anything-isearch-post-command) + + (use-global-map anything-isearch-map) + (setq overriding-terminal-local-map anything-isearch-map) + + (setq anything-isearch-pattern "") + + (setq anything-isearch-original-cursor-in-non-selected-windows + cursor-in-non-selected-windows) + (setq cursor-in-non-selected-windows nil) + + (setq anything-isearch-original-point (point-marker)) + (goto-char (point-min)) + (forward-line) + (anything-mark-current-line) + + (setq anything-isearch-match-positions nil) + (setq anything-isearch-match-start (point-marker)) + + (if anything-isearch-overlay + ;; make sure the overlay belongs to the anything buffer + (move-overlay anything-isearch-overlay (point-min) (point-min) + (get-buffer (anything-buffer-get))) + + (setq anything-isearch-overlay (make-overlay (point-min) (point-min))) + (overlay-put anything-isearch-overlay 'face anything-isearch-match-face)) + + (setq anything-isearch-message-suffix + (substitute-command-keys "cancel with \\[anything-isearch-cancel]"))) + + (error (anything-isearch-cleanup))))) + + +(defun anything-isearch-post-command () + "Print the current pattern after every command." + (anything-isearch-message) + (when (anything-window) + (with-anything-window + (move-overlay anything-isearch-overlay anything-isearch-match-start (point) + (get-buffer (anything-buffer-get)))))) + + +(defun anything-isearch-printing-char () + "Add printing char to the pattern." + (interactive) + (let ((char (char-to-string last-command-char))) + (setq anything-isearch-pattern (concat anything-isearch-pattern char)) + + (with-anything-window + (if (looking-at char) + (progn + (push (list 'event 'char + 'start anything-isearch-match-start + 'pos (point-marker)) + anything-isearch-match-positions) + (forward-char)) + + (let ((start (point))) + (while (and (re-search-forward anything-isearch-pattern nil t) + (anything-pos-header-line-p))) + (if (or (anything-pos-header-line-p) + (eq start (point))) + (progn + (goto-char start) + (push (list 'event 'error + 'start anything-isearch-match-start + 'pos (point-marker)) + anything-isearch-match-positions)) + + (push (list 'event 'search + 'start anything-isearch-match-start + 'pos (copy-marker start)) + anything-isearch-match-positions) + (setq anything-isearch-match-start (copy-marker (match-beginning 0)))))) + + (anything-mark-current-line)))) + + +(defun anything-isearch-again () + "Search again for the current pattern" + (interactive) + (if (equal anything-isearch-pattern "") + (setq anything-isearch-message-suffix "no pattern yet") + + (with-anything-window + (let ((start (point))) + (while (and (re-search-forward anything-isearch-pattern nil t) + (anything-pos-header-line-p))) + (if (or (anything-pos-header-line-p) + (eq start (point))) + (progn + (goto-char start) + (unless (eq 'error (plist-get (car anything-isearch-match-positions) + 'event)) + (setq anything-isearch-message-suffix "no more matches"))) + + (push (list 'event 'search-again + 'start anything-isearch-match-start + 'pos (copy-marker start)) + anything-isearch-match-positions) + (setq anything-isearch-match-start (copy-marker (match-beginning 0))) + + (anything-mark-current-line)))))) + + +(defun anything-isearch-delete () + "Undo last event." + (interactive) + (unless (equal anything-isearch-pattern "") + (let ((last (pop anything-isearch-match-positions))) + (unless (eq 'search-again (plist-get last 'event)) + (setq anything-isearch-pattern + (substring anything-isearch-pattern 0 -1))) + + (with-anything-window + (goto-char (plist-get last 'pos)) + (setq anything-isearch-match-start (plist-get last 'start)) + (anything-mark-current-line))))) + + +(defun anything-isearch-default-action () + "Execute the default action for the selected candidate." + (interactive) + (anything-isearch-cleanup) + (with-current-buffer (anything-buffer-get) (anything-exit-minibuffer))) + + +(defun anything-isearch-select-action () + "Choose an action for the selected candidate." + (interactive) + (anything-isearch-cleanup) + (with-anything-window + (anything-select-action))) + + +(defun anything-isearch-cancel () + "Cancel Anything isearch." + (interactive) + (anything-isearch-cleanup) + (when (anything-window) + (with-anything-window + (goto-char anything-isearch-original-point) + (anything-mark-current-line)))) + + +(defun anything-isearch-cleanup () + "Clean up the mess." + (setq minibuffer-message-timeout anything-isearch-original-message-timeout) + (with-current-buffer (anything-buffer-get) + (setq overriding-terminal-local-map nil) + (setq cursor-type nil) + (setq cursor-in-non-selected-windows + anything-isearch-original-cursor-in-non-selected-windows)) + (when anything-isearch-original-window + (select-window anything-isearch-original-window)) + + (use-global-map anything-isearch-original-global-map) + (setq-default post-command-hook anything-isearch-original-post-command-hook) + (when (overlayp anything-isearch-overlay) + (delete-overlay anything-isearch-overlay))) + + +(defun anything-isearch-message () + "Print prompt." + (if (and (equal anything-isearch-message-suffix "") + (eq (plist-get (car anything-isearch-match-positions) 'event) + 'error)) + (setq anything-isearch-message-suffix "failing")) + + (unless (equal anything-isearch-message-suffix "") + (setq anything-isearch-message-suffix + (concat " [" anything-isearch-message-suffix "]"))) + + (message (concat "Search within results: " + anything-isearch-pattern + anything-isearch-message-suffix)) + + (setq anything-isearch-message-suffix "")) + + +;; (@* "Utility: Iswitchb integration") + +(defvar anything-iswitchb-candidate-selected nil + "Indicates whether an anything candidate is selected from iswitchb.") + +(defvar anything-iswitchb-frame-configuration nil + "Saved frame configuration, before anything buffer was displayed.") + +(defvar anything-iswitchb-saved-keys nil + "The original in iswitchb before binding anything keys.") + + +(defun anything-iswitchb-setup () + "Integrate anything completion into iswitchb. + +If the user is idle for `anything-iswitchb-idle-delay' seconds +after typing something into iswitchb then anything candidates are +shown for the current iswitchb input. + +ESC cancels anything completion and returns to normal iswitchb." + (interactive) + + (require 'iswitchb) + + ;; disable timid completion during iswitchb + (put 'iswitchb-buffer 'timid-completion 'disabled) + (add-hook 'minibuffer-setup-hook 'anything-iswitchb-minibuffer-setup) + + (defadvice iswitchb-visit-buffer + (around anything-iswitchb-visit-buffer activate) + (if anything-iswitchb-candidate-selected + (anything-execute-selection-action) + ad-do-it)) + + (defadvice iswitchb-possible-new-buffer + (around anything-iswitchb-possible-new-buffer activate) + (if anything-iswitchb-candidate-selected + (anything-execute-selection-action) + ad-do-it)) + + (message "Iswitchb integration is activated.")) + + +(defun anything-iswitchb-minibuffer-setup () + (when (eq this-command 'iswitchb-buffer) + (add-hook 'minibuffer-exit-hook 'anything-iswitchb-minibuffer-exit) + + (setq anything-iswitchb-frame-configuration nil) + (setq anything-iswitchb-candidate-selected nil) + (add-hook 'anything-update-hook 'anything-iswitchb-handle-update) + + (anything-initialize) + + (add-hook 'post-command-hook 'anything-iswitchb-check-input))) + + +(defun anything-iswitchb-minibuffer-exit () + (remove-hook 'minibuffer-exit-hook 'anything-iswitchb-minibuffer-exit) + (remove-hook 'post-command-hook 'anything-iswitchb-check-input) + (remove-hook 'anything-update-hook 'anything-iswitchb-handle-update) + + (anything-cleanup) + + (when anything-iswitchb-frame-configuration + (anything-set-frame/window-configuration anything-iswitchb-frame-configuration) + (setq anything-iswitchb-frame-configuration nil))) + + +(defun anything-iswitchb-check-input () + "Extract iswitchb input and check if it needs to be handled." + (declare (special iswitchb-text)) + (if (or anything-iswitchb-frame-configuration + (sit-for anything-iswitchb-idle-delay)) + (anything-check-new-input iswitchb-text))) + + +(defun anything-iswitchb-handle-update () + "Pop up the anything buffer if it's not empty and it's not +shown yet and bind anything commands in iswitchb." + (unless (or (equal (buffer-size (get-buffer anything-buffer)) 0) + anything-iswitchb-frame-configuration) + (setq anything-iswitchb-frame-configuration (anything-current-frame/window-configuration)) + + (save-selected-window + (if (not anything-samewindow) + (pop-to-buffer anything-buffer) + + (select-window (get-lru-window)) + (switch-to-buffer anything-buffer))) + + (with-current-buffer (window-buffer (active-minibuffer-window)) + (let* ((anything-prefix "anything-") + (prefix-length (length anything-prefix)) + (commands + (delete-dups + (remove-if 'null + (mapcar + (lambda (binding) + (let ((command (cdr binding))) + (when (and (symbolp command) + (eq (compare-strings + anything-prefix + 0 prefix-length + (symbol-name command) + 0 prefix-length) + t)) + command))) + (cdr anything-map))))) + (bindings (mapcar (lambda (command) + (cons command + (where-is-internal command anything-map))) + commands))) + + (push (list 'anything-iswitchb-cancel-anything (kbd "")) + bindings) + + (setq anything-iswitchb-saved-keys nil) + + (let* ((iswitchb-prefix "iswitchb-") + (prefix-length (length iswitchb-prefix))) + (dolist (binding bindings) + (dolist (key (cdr binding)) + (let ((old-command (lookup-key (current-local-map) key))) + (unless (and anything-iswitchb-dont-touch-iswithcb-keys + (symbolp old-command) + (eq (compare-strings iswitchb-prefix + 0 prefix-length + (symbol-name old-command) + 0 prefix-length) + t)) + (push (cons key old-command) + anything-iswitchb-saved-keys) + (define-key (current-local-map) key (car binding))))))))))) + + +(defun anything-iswitchb-cancel-anything () + "Cancel anything completion and return to standard iswitchb." + (interactive) + (save-excursion + (dolist (binding anything-iswitchb-saved-keys) + (define-key (current-local-map) (car binding) (cdr binding))) + (anything-iswitchb-minibuffer-exit))) + +;; (@* "Compatibility") + +;; Copied assoc-default from XEmacs version 21.5.12 +(unless (fboundp 'assoc-default) + (defun assoc-default (key alist &optional test default) + "Find object KEY in a pseudo-alist ALIST. +ALIST is a list of conses or objects. Each element (or the element's car, +if it is a cons) is compared with KEY by evaluating (TEST (car elt) KEY). +If that is non-nil, the element matches; +then `assoc-default' returns the element's cdr, if it is a cons, +or DEFAULT if the element is not a cons. + +If no element matches, the value is nil. +If TEST is omitted or nil, `equal' is used." + (let (found (tail alist) value) + (while (and tail (not found)) + (let ((elt (car tail))) + (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key) + (setq found t value (if (consp elt) (cdr elt) default)))) + (setq tail (cdr tail))) + value))) + +;; Function not available in XEmacs, +(unless (fboundp 'minibuffer-contents) + (defun minibuffer-contents () + "Return the user input in a minbuffer as a string. +The current buffer must be a minibuffer." + (field-string (point-max))) + + (defun delete-minibuffer-contents () + "Delete all user input in a minibuffer. +The current buffer must be a minibuffer." + (delete-field (point-max)))) + +;; Function not available in older Emacs (<= 22.1). +(unless (fboundp 'buffer-chars-modified-tick) + (defun buffer-chars-modified-tick (&optional buffer) + "Return BUFFER's character-change tick counter. +Each buffer has a character-change tick counter, which is set to the +value of the buffer's tick counter (see `buffer-modified-tick'), each +time text in that buffer is inserted or deleted. By comparing the +values returned by two individual calls of `buffer-chars-modified-tick', +you can tell whether a character change occurred in that buffer in +between these calls. No argument or nil as argument means use current +buffer as BUFFER." + (with-current-buffer (or buffer (current-buffer)) + (if (listp buffer-undo-list) + (length buffer-undo-list) + (buffer-modified-tick))))) + + +;; (@* "Unit Tests") + +(defun* anything-test-candidates (sources &optional (input "") (compile-source-functions anything-compile-source-functions-default)) + "Test helper function for anything. +Given pseudo `anything-sources' and `anything-pattern', returns list like + ((\"source name1\" (\"candidate1\" \"candidate2\")) + (\"source name2\" (\"candidate3\" \"candidate4\"))) +" + (let ((anything-test-mode t) + anything-enable-digit-shortcuts + anything-candidate-cache + (anything-sources (anything-normalize-sources sources)) + (anything-compile-source-functions compile-source-functions) + anything-before-initialize-hook + anything-after-initialize-hook + anything-update-hook + anything-test-candidate-list) + (get-buffer-create anything-buffer) + + (anything-initialize) + (setq anything-input input anything-pattern input) + (anything-update) + ;; test-mode spec: select 1st candidate! + (with-current-buffer anything-buffer + (forward-line 1) + (anything-mark-current-line)) + (prog1 + anything-test-candidate-list + (anything-cleanup)))) + +(defmacro anything-test-update (sources pattern) + "Test helper macro for anything. It is meant for testing *anything* buffer contents." + `(progn (stub anything-get-sources => ,sources) + (stub run-hooks => nil) + (stub anything-maybe-fit-frame => nil) + (stub run-with-idle-timer => nil) + (let (anything-test-mode (anything-pattern ,pattern)) (anything-update)))) + +;;;; unit test +;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el") +;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el") +(dont-compile + (when (fboundp 'expectations) + (expectations + (desc "anything-current-buffer") + (expect "__a_buffer" + (with-current-buffer (get-buffer-create "__a_buffer") + (anything-test-candidates '(((name . "FOO"))) "") + (prog1 + (buffer-name anything-current-buffer) + (kill-buffer "__a_buffer") + ))) + (desc "anything-buffer-file-name") + (expect (regexp "/__a_file__") + (with-current-buffer (get-buffer-create "__a_file__") + (setq buffer-file-name "/__a_file__") + (anything-test-candidates '(((name . "FOO"))) "") + (prog1 + anything-buffer-file-name + ;;(kill-buffer "__a_file__") + ))) + (desc "anything-compile-sources") + (expect '(((name . "foo"))) + (anything-compile-sources '(((name . "foo"))) nil) + ) + (expect '(((name . "foo") (type . test) (action . identity))) + (let ((anything-type-attributes '((test (action . identity))))) + (anything-compile-sources '(((name . "foo") (type . test))) + '(anything-compile-source--type)))) + (desc "anything-sources accepts symbols") + (expect '(((name . "foo"))) + (let* ((foo '((name . "foo")))) + (anything-compile-sources '(foo) nil))) + (desc "anything-get-sources action") + (expect '(((name . "Actions") (candidates . actions))) + (stub anything-action-window => t) + (let (anything-compiled-sources + (anything-sources '(((name . "Actions") (candidates . actions))))) + (anything-get-sources))) + (desc "get-buffer-create candidates-buffer") + (expect '(((name . "many") (init . many-init) + (candidates-in-buffer . anything-candidates-in-buffer) + (candidates . anything-candidates-in-buffer) + (volatile) (match identity))) + (anything-compile-sources + '(((name . "many") (init . many-init) + (candidates-in-buffer . anything-candidates-in-buffer))) + '(anything-compile-source--candidates-in-buffer))) + (expect '(((name . "many") (init . many-init) + (candidates-in-buffer) + (candidates . anything-candidates-in-buffer) + (volatile) (match identity))) + (anything-compile-sources + '(((name . "many") (init . many-init) + (candidates-in-buffer))) + '(anything-compile-source--candidates-in-buffer))) + (expect '(((name . "many") (init . many-init) + (candidates-in-buffer) + (type . test) + (action . identity) + (candidates . anything-candidates-in-buffer) + (volatile) (match identity))) + (let ((anything-type-attributes '((test (action . identity))))) + (anything-compile-sources + '(((name . "many") (init . many-init) + (candidates-in-buffer) + (type . test))) + '(anything-compile-source--type + anything-compile-source--candidates-in-buffer)))) + + (desc "anything-get-candidates") + (expect '("foo" "bar") + (anything-get-candidates '((name . "foo") (candidates "foo" "bar")))) + (expect '("FOO" "BAR") + (anything-get-candidates '((name . "foo") (candidates "foo" "bar") + (candidate-transformer + . (lambda (cands) (mapcar 'upcase cands)))))) + (expect '("foo" "bar") + (anything-get-candidates '((name . "foo") + (candidates . (lambda () '("foo" "bar")))))) + (desc "anything-compute-matches") + (expect '("foo" "bar") + (let ((anything-pattern "")) + (anything-compute-matches '((name . "FOO") (candidates "foo" "bar") (volatile))))) + (expect '("foo") + (let ((anything-pattern "oo")) + (anything-compute-matches '((name . "FOO") (candidates "foo" "bar") (volatile))))) + (expect '("bar") + (let ((anything-pattern "^b")) + (anything-compute-matches '((name . "FOO") (candidates "foo" "bar") (volatile))))) + (expect '("a" "b") + (let ((anything-pattern "") + (anything-candidate-number-limit 2)) + (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c") (volatile))))) + (expect '("a" "b") + (let ((anything-pattern ".") + (anything-candidate-number-limit 2)) + (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c") (volatile))))) + (expect '("a" "b" "c") + (let ((anything-pattern "") + anything-candidate-number-limit) + (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c") (volatile))))) + (expect '("a" "b" "c") + (let ((anything-pattern "[abc]") + anything-candidate-number-limit) + (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c") (volatile))))) + ;; using anything-test-candidate-list + (desc "anything-test-candidates") + (expect '(("FOO" ("foo" "bar"))) + (anything-test-candidates '(((name . "FOO") (candidates "foo" "bar"))))) + (expect '(("FOO" ("bar"))) + (anything-test-candidates '(((name . "FOO") (candidates "foo" "bar"))) "ar")) + (expect '(("T1" ("hoge" "aiue")) + ("T2" ("test" "boke"))) + (anything-test-candidates '(((name . "T1") (candidates "hoge" "aiue")) + ((name . "T2") (candidates "test" "boke"))))) + (expect '(("T1" ("hoge")) + ("T2" ("boke"))) + (anything-test-candidates '(((name . "T1") (candidates "hoge" "aiue")) + ((name . "T2") (candidates "test" "boke"))) "o")) + (desc "requires-pattern attribute") + (expect nil + (anything-test-candidates '(((name . "FOO") (candidates "foo" "bar") + (requires-pattern . 1))))) + (expect '(("FOO" ("bar"))) + (anything-test-candidates '(((name . "FOO") (candidates "foo" "bar") + (requires-pattern . 1))) "b")) + (desc "delayed attribute(for test)") + (expect '(("T2" ("boke")) + ("T1" ("hoge"))) + (anything-test-candidates + '(((name . "T1") (candidates "hoge" "aiue") (delayed)) + ((name . "T2") (candidates "test" "boke"))) + "o")) + (desc "match attribute(prefix search)") + (expect '(("FOO" ("bar"))) + (anything-test-candidates + '(((name . "FOO") (candidates "foo" "bar") + (match (lambda (c) (string-match (concat "^" anything-pattern) c))))) + "ba")) + (expect nil + (anything-test-candidates + '(((name . "FOO") (candidates "foo" "bar") + (match (lambda (c) (string-match (concat "^" anything-pattern) c))))) + "ar")) + (desc "init attribute") + (expect '(("FOO" ("bar"))) + (let (v) + (anything-test-candidates + '(((name . "FOO") (init . (lambda () (setq v '("foo" "bar")))) + (candidates . v))) + "ar"))) + (desc "candidate-transformer attribute") + (expect '(("FOO" ("BAR"))) + (anything-test-candidates '(((name . "FOO") (candidates "foo" "bar") + (candidate-transformer + . (lambda (cands) (mapcar 'upcase cands))))) + "ar")) + (desc "filtered-candidate-transformer attribute") + ;; needs more tests + (expect '(("FOO" ("BAR"))) + (anything-test-candidates '(((name . "FOO") (candidates "foo" "bar") + (filtered-candidate-transformer + . (lambda (cands src) (mapcar 'upcase cands))))) + "ar")) + (desc "anything-candidates-in-buffer-1") + (expect nil + (anything-candidates-in-buffer-1 nil)) + (expect '("foo+" "bar+" "baz+") + (with-temp-buffer + (insert "foo+\nbar+\nbaz+\n") + (let ((anything-candidate-number-limit 5)) + (anything-candidates-in-buffer-1 (current-buffer) "")))) + (expect '("foo+" "bar+") + (with-temp-buffer + (insert "foo+\nbar+\nbaz+\n") + (let ((anything-candidate-number-limit 2)) + (anything-candidates-in-buffer-1 (current-buffer) "")))) + (expect '("foo+") + (with-temp-buffer + (insert "foo+\nbar+\nbaz+\n") + (anything-candidates-in-buffer-1 (current-buffer) "oo\\+"))) + (expect '("foo+") + (with-temp-buffer + (insert "foo+\nbar+\nbaz+\n") + (anything-candidates-in-buffer-1 + (current-buffer) "oo+" + #'buffer-substring-no-properties '(search-forward)))) + (expect '(("foo+" "FOO+")) + (with-temp-buffer + (insert "foo+\nbar+\nbaz+\n") + (anything-candidates-in-buffer-1 + (current-buffer) "oo\\+" + (lambda (s e) + (let ((l (buffer-substring-no-properties s e))) + (list l (upcase l))))))) + (desc "anything-candidates-in-buffer") + (expect '(("TEST" ("foo+" "bar+" "baz+"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "foo+\nbar+\nbaz+\n")))) + (candidates . anything-candidates-in-buffer) + (match identity) + (volatile))))) + (expect '(("TEST" ("foo+" "bar+" "baz+"))) + (let (anything-candidate-number-limit) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "foo+\nbar+\nbaz+\n")))) + (candidates . anything-candidates-in-buffer) + (match identity) + (volatile)))))) + (expect '(("TEST" ("foo+"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "foo+\nbar+\nbaz+\n")))) + (candidates . anything-candidates-in-buffer) + (match identity) + (volatile))) + "oo\\+")) + (desc "search attribute") + (expect '(("TEST" ("foo+"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "foo+\nbar+\nbaz+\nooo\n")))) + (search search-forward) + (candidates . anything-candidates-in-buffer) + (match identity) + (volatile))) + "oo+")) + (expect '(("TEST" ("foo+" "ooo"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "foo+\nbar+\nbaz+\nooo\n")))) + (search search-forward re-search-forward) + (candidates . anything-candidates-in-buffer) + (match identity) + (volatile))) + "oo+")) + (expect '(("TEST" ("foo+" "ooo"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "foo+\nbar+\nbaz+\nooo\n")))) + (search re-search-forward search-forward) + (candidates . anything-candidates-in-buffer) + (match identity) + (volatile))) + "oo+")) + (expect '(("TEST" ("ooo" "foo+"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "bar+\nbaz+\nooo\nfoo+\n")))) + (search re-search-forward search-forward) + (candidates . anything-candidates-in-buffer) + (match identity) + (volatile))) + "oo+")) + ;; faster exact match + (expect '(("TEST" ("bar+"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "bar+\nbaz+\nooo\nfoo+\n")))) + (search (lambda (pattern &rest _) + (and (search-forward (concat "\n" pattern "\n") nil t) + (forward-line -1)))) + (candidates . anything-candidates-in-buffer) + (match identity) + (volatile))) + "bar+")) + ;; faster prefix match + (expect '(("TEST" ("bar+"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "bar+\nbaz+\nooo\nfoo+\n")))) + (search (lambda (pattern &rest _) + (search-forward (concat "\n" pattern) nil t))) + (candidates . anything-candidates-in-buffer) + (match identity) + (volatile))) + "ba")) + (desc "anything-current-buffer-is-modified") + (expect '(("FOO" ("modified"))) + (let ((sources '(((name . "FOO") + (candidates + . (lambda () + (if (anything-current-buffer-is-modified) + '("modified") + '("unmodified")))))))) + (with-temp-buffer + (clrhash anything-tick-hash) + (insert "1") + (anything-test-candidates sources)))) + (expect '(("FOO" ("unmodified"))) + (let ((sources '(((name . "FOO") + (candidates + . (lambda () + (if (anything-current-buffer-is-modified) + '("modified") + '("unmodified")))))))) + (with-temp-buffer + (clrhash anything-tick-hash) + (insert "1") + (anything-test-candidates sources) + (anything-test-candidates sources)))) + (expect '(("FOO" ("modified"))) + (let ((sources '(((name . "FOO") + (candidates + . (lambda () + (if (anything-current-buffer-is-modified) + '("modified") + '("unmodified")))))))) + (with-temp-buffer + (clrhash anything-tick-hash) + (insert "1") + (anything-test-candidates sources) + (insert "2") + (anything-test-candidates sources)))) + (expect '(("BAR" ("modified"))) + (let ((sources1 '(((name . "FOO") + (candidates + . (lambda () + (if (anything-current-buffer-is-modified) + '("modified") + '("unmodified"))))))) + (sources2 '(((name . "BAR") + (candidates + . (lambda () + (if (anything-current-buffer-is-modified) + '("modified") + '("unmodified")))))))) + (with-temp-buffer + (clrhash anything-tick-hash) + (insert "1") + (anything-test-candidates sources1) + (anything-test-candidates sources2)))) + (expect '(("FOO" ("unmodified"))) + (let ((sources1 '(((name . "FOO") + (candidates + . (lambda () + (if (anything-current-buffer-is-modified) + '("modified") + '("unmodified"))))))) + (sources2 '(((name . "BAR") + (candidates + . (lambda () + (if (anything-current-buffer-is-modified) + '("modified") + '("unmodified")))))))) + (with-temp-buffer + (clrhash anything-tick-hash) + (insert "1") + (anything-test-candidates sources1) + (anything-test-candidates sources2) + (anything-test-candidates sources1)))) + (expect '(("BAR" ("unmodified"))) + (let ((sources1 '(((name . "FOO") + (candidates + . (lambda () + (if (anything-current-buffer-is-modified) + '("modified") + '("unmodified"))))))) + (sources2 '(((name . "BAR") + (candidates + . (lambda () + (if (anything-current-buffer-is-modified) + '("modified") + '("unmodified")))))))) + (with-temp-buffer + (clrhash anything-tick-hash) + (insert "1") + (anything-test-candidates sources1) + (anything-test-candidates sources2) + (anything-test-candidates sources2)))) + (expect '(("BAR" ("modified"))) + (let ((sources1 '(((name . "FOO") + (candidates + . (lambda () + (if (anything-current-buffer-is-modified) + '("modified") + '("unmodified"))))))) + (sources2 '(((name . "BAR") + (candidates + . (lambda () + (if (anything-current-buffer-is-modified) + '("modified") + '("unmodified")))))))) + (with-temp-buffer + (clrhash anything-tick-hash) + (insert "1") + (anything-test-candidates sources1) + (anything-test-candidates sources2) + (with-temp-buffer + (anything-test-candidates sources2))))) + (desc "anything-source-name") + (expect "FOO" + (let (v) + (anything-test-candidates '(((name . "FOO") + (init + . (lambda () (setq v anything-source-name))) + (candidates "ok")))) + v)) + (expect "FOO" + (let (v) + (anything-test-candidates '(((name . "FOO") + (candidates + . (lambda () + (setq v anything-source-name) + '("ok")))))) + v)) + (expect "FOO" + (let (v) + (anything-test-candidates '(((name . "FOO") + (candidates "ok") + (candidate-transformer + . (lambda (c) + (setq v anything-source-name) + c))))) + v)) + (expect "FOO" + (let (v) + (anything-test-candidates '(((name . "FOO") + (candidates "ok") + (filtered-candidate-transformer + . (lambda (c s) + (setq v anything-source-name) + c))))) + v)) + (expect "FOO" + (let (v) + (anything-test-candidates '(((name . "FOO") + (candidates "ok") + (display-to-real + . (lambda (c) + (setq v anything-source-name) + c)) + (action . identity)))) + (anything-execute-selection-action) + v)) + (desc "anything-candidate-buffer create") + (expect " *anything candidates:FOO*" + (let* (anything-candidate-buffer-alist + (anything-source-name "FOO") + (buf (anything-candidate-buffer 'global))) + (prog1 (buffer-name buf) + (kill-buffer buf)))) + (expect " *anything candidates:FOO*aTestBuffer" + (let* (anything-candidate-buffer-alist + (anything-source-name "FOO") + (anything-current-buffer (get-buffer-create "aTestBuffer")) + (buf (anything-candidate-buffer 'local))) + (prog1 (buffer-name buf) + (kill-buffer anything-current-buffer) + (kill-buffer buf)))) + (expect 0 + (let (anything-candidate-buffer-alist + (anything-source-name "FOO") buf) + (with-current-buffer (anything-candidate-buffer 'global) + (insert "1")) + (setq buf (anything-candidate-buffer 'global)) + (prog1 (buffer-size buf) + (kill-buffer buf)))) + (desc "anything-candidate-buffer get-buffer") + (expect " *anything candidates:FOO*" + (let* (anything-candidate-buffer-alist + (anything-source-name "FOO") + (buf (anything-candidate-buffer 'global))) + (prog1 (buffer-name (anything-candidate-buffer)) + (kill-buffer buf)))) + (expect " *anything candidates:FOO*aTestBuffer" + (let* (anything-candidate-buffer-alist + (anything-source-name "FOO") + (anything-current-buffer (get-buffer-create "aTestBuffer")) + (buf (anything-candidate-buffer 'local))) + (prog1 (buffer-name (anything-candidate-buffer)) + (kill-buffer anything-current-buffer) + (kill-buffer buf)))) + (expect " *anything candidates:FOO*" + (let* (anything-candidate-buffer-alist + (anything-source-name "FOO") + (buf-local (anything-candidate-buffer 'local)) + (buf-global (anything-candidate-buffer 'global))) + (prog1 (buffer-name (anything-candidate-buffer)) + (kill-buffer buf-local) + (kill-buffer buf-global)))) + (expect " *anything candidates:FOO*aTestBuffer" + (let* (anything-candidate-buffer-alist + (anything-source-name "FOO") + (anything-current-buffer (get-buffer-create "aTestBuffer")) + (buf-global (anything-candidate-buffer 'global)) + (buf-local (anything-candidate-buffer 'local))) + (prog1 (buffer-name (anything-candidate-buffer)) + (kill-buffer buf-local) + (kill-buffer buf-global)))) + (expect nil + (let* (anything-candidate-buffer-alist + (anything-source-name "NOP__")) + (anything-candidate-buffer))) + (desc "anything-candidate-buffer register-buffer") + (expect " *anything test candidates*" + (let (anything-candidate-buffer-alist + (buf (get-buffer-create " *anything test candidates*"))) + (with-current-buffer buf + (insert "1\n2\n") + (prog1 (buffer-name (anything-candidate-buffer buf)) + (kill-buffer (current-buffer)))))) + (expect " *anything test candidates*" + (let (anything-candidate-buffer-alist + (buf (get-buffer-create " *anything test candidates*"))) + (with-current-buffer buf + (insert "1\n2\n") + (anything-candidate-buffer buf) + (prog1 (buffer-name (anything-candidate-buffer)) + (kill-buffer (current-buffer)))))) + (expect "1\n2\n" + (let (anything-candidate-buffer-alist + (buf (get-buffer-create " *anything test candidates*"))) + (with-current-buffer buf + (insert "1\n2\n") + (anything-candidate-buffer buf) + (prog1 (buffer-string) + (kill-buffer (current-buffer)))))) + (desc "action attribute") + (expect "foo" + (anything-test-candidates + '(((name . "TEST") + (candidates "foo") + (action ("identity" . identity))))) + (anything-execute-selection-action)) + (expect "foo" + (anything-test-candidates + '(((name . "TEST") + (candidates "foo") + (action ("identity" . (lambda (c) (identity c))))))) + (anything-execute-selection-action)) + (desc "anything-execute-selection-action") + (expect "FOO" + (anything-execute-selection-action + "foo" '(("upcase" . upcase)) nil #'identity)) + (expect "FOO" + (anything-execute-selection-action + "foo" '(("upcase" . (lambda (c) (upcase c)))) nil #'identity)) + (desc "display-to-real attribute") + (expect "FOO" + (anything-execute-selection-action + "foo" + '(("identity" . identity)) + nil + #'upcase + )) + (expect "FOO" + (anything-test-candidates + '(((name . "TEST") + (candidates "foo") + (display-to-real . upcase) + (action ("identity" . identity))))) + (anything-execute-selection-action)) + (desc "cleanup test") + (expect 'cleaned + (let (v) + (anything-test-candidates + '(((name . "TEST") + (cleanup . (lambda () (setq v 'cleaned)))))) + v)) + (desc "anything-get-current-source") + ;; in init/candidates/action/candidate-transformer/filtered-candidate-transformer + ;; display-to-real/cleanup function + (expect "FOO" + (assoc-default + 'name + (anything-funcall-with-source '((name . "FOO")) 'anything-get-current-source))) + ;; init + (expect "FOO" + (let (v) + (anything-test-candidates + '(((name . "FOO") + (init . (lambda () (setq v (anything-get-current-source))))))) + (assoc-default 'name v))) + ;; candidates + (expect "FOO" + (let (v) + (anything-test-candidates + '(((name . "FOO") + (candidates . (lambda () (setq v (anything-get-current-source)) '("a")))))) + (assoc-default 'name v))) + ;; action + (expect "FOO" + (let (v) + (anything-test-candidates + '(((name . "FOO") + (candidates "a") + (action + . (lambda (c) (setq v (anything-get-current-source)) c))))) + (anything-execute-selection-action) + (assoc-default 'name v))) + ;; candidate-transformer + (expect "FOO" + (let (v) + (anything-test-candidates + '(((name . "FOO") + (candidates "a") + (candidate-transformer + . (lambda (c) (setq v (anything-get-current-source)) c))))) + (assoc-default 'name v))) + ;; filtered-candidate-transformer + (expect "FOO" + (let (v) + (anything-test-candidates + '(((name . "FOO") + (candidates "a") + (filtered-candidate-transformer + . (lambda (c s) (setq v (anything-get-current-source)) c))))) + (assoc-default 'name v))) + ;; action-transformer + (expect "FOO" + (let (v) + (anything-test-candidates + '(((name . "FOO") + (candidates "a") + (action-transformer + . (lambda (a c) (setq v (anything-get-current-source)) a)) + (action . identity)))) + (anything-execute-selection-action) + (assoc-default 'name v))) + ;; display-to-real + (expect "FOO" + (let (v) + (anything-test-candidates + '(((name . "FOO") + (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "a\n")))) + (candidates-in-buffer) + (display-to-real + . (lambda (c) (setq v (anything-get-current-source)) c)) + (action . identity)))) + (anything-execute-selection-action) + (assoc-default 'name v))) + ;; cleanup + (expect "FOO" + (let (v) + (anything-test-candidates + '(((name . "FOO") + (candidates "a") + (cleanup + . (lambda () (setq v (anything-get-current-source))))))) + (assoc-default 'name v))) + ;; candidates are displayed + (expect "TEST" + (anything-test-candidates + '(((name . "TEST") + (candidates "foo") + (action ("identity" . identity))))) + (assoc-default 'name (anything-get-current-source))) + (desc "anything-attr") + (expect "FOO" + (anything-funcall-with-source + '((name . "FOO")) + (lambda () + (anything-attr 'name)))) + (expect 'fuga + (let (v) + (anything-test-candidates + '(((name . "FOO") + (hoge . fuga) + (init . (lambda () (setq v (anything-attr 'hoge)))) + (candidates "a")))) + v)) + (expect nil + (let (v) + (anything-test-candidates + '(((name . "FOO") + (init . (lambda () (setq v (anything-attr 'hoge)))) + (candidates "a")))) + v)) + (expect nil + (let (v) + (anything-test-candidates + '(((name . "FOO") + (hoge) ;INCOMPATIBLE! + (init . (lambda () (setq v (anything-attr 'hoge)))) + (candidates "a")))) + v)) + (desc "anything-attr-defined") + (expect (non-nil) + (let (v) + (anything-test-candidates + '(((name . "FOO") + (hoge) + (init . (lambda () (setq v (anything-attr-defined 'hoge)))) + (candidates "a")))) + v)) + (expect nil + (let (v) + (anything-test-candidates + '(((name . "FOO") + (init . (lambda () (setq v (anything-attr-defined 'hoge)))) + (candidates "a")))) + v)) + (desc "anything-attrset") + (expect '((name . "FOO") (hoge . 77)) + (let ((src '((name . "FOO") (hoge)))) + (anything-attrset 'hoge 77 src) + src)) + (expect 77 + (anything-attrset 'hoge 77 '((name . "FOO") (hoge)))) + + (expect '((name . "FOO") (hoge . 77)) + (let ((src '((name . "FOO") (hoge . 1)))) + (anything-attrset 'hoge 77 src) + src)) + + (expect '((name . "FOO") (hoge . 77) (x)) + (let ((src '((name . "FOO") (x)))) + (anything-attrset 'hoge 77 src) + src)) + (expect 77 + (anything-attrset 'hoge 77 '((name . "FOO")))) + (desc "anything-preselect") + ;; entire candidate + (expect "foo" + (with-current-buffer (anything-create-anything-buffer t) + (let ((anything-pattern "") + (anything-test-mode t)) + (anything-process-source '((name . "test") + (candidates "hoge" "foo" "bar"))) + (anything-preselect "foo") + (anything-get-selection)))) + ;; regexp + (expect "foo" + (with-current-buffer (anything-create-anything-buffer t) + (let ((anything-pattern "") + (anything-test-mode t)) + (anything-process-source '((name . "test") + (candidates "hoge" "foo" "bar"))) + (anything-preselect "fo+") + (anything-get-selection)))) + ;; no match -> first entry + (expect "hoge" + (with-current-buffer (anything-create-anything-buffer t) + (let ((anything-pattern "") + (anything-test-mode t)) + (anything-process-source '((name . "test") + (candidates "hoge" "foo" "bar"))) + (anything-preselect "not found") + (anything-get-selection)))) + (desc "anything-check-new-input") + (expect "newpattern" + (stub anything-update) + (stub anything-action-window) + (let ((anything-pattern "pattern")) + (anything-check-new-input "newpattern") + anything-pattern)) + ;; anything-input == nil when action window is available + (expect nil + (stub anything-update) + (stub anything-action-window => t) + (let ((anything-pattern "pattern") + anything-input) + (anything-check-new-input "newpattern") + anything-input)) + ;; anything-input == anything-pattern unless action window is available + (expect "newpattern" + (stub anything-update) + (stub anything-action-window => nil) + (let ((anything-pattern "pattern") + anything-input) + (anything-check-new-input "newpattern") + anything-input)) + (expect (mock (anything-update)) + (stub anything-action-window) + (let (anything-pattern) + (anything-check-new-input "foo"))) + (desc "anything-update") + (expect (mock (anything-process-source '((name . "1")))) + (anything-test-update '(((name . "1"))) "")) + ;; (find-function 'anything-update) + ;; TODO el-mock.el should express 2nd call of function. + ;; (expect (mock (anything-process-source '((name . "2")))) + ;; (stub anything-get-sources => '(((name . "1")) ((name . "2")))) + ;; (stub run-hooks) + ;; (stub anything-maybe-fit-frame) + ;; (stub run-with-idle-timer) + ;; (anything-update)) + (expect (mock (run-with-idle-timer * nil 'anything-process-delayed-sources + '(((name . "2") (delayed))))) + (stub anything-get-sources => '(((name . "1")) + ((name . "2") (delayed)))) + (stub run-hooks) + (stub anything-maybe-fit-frame) + (let ((anything-pattern "") anything-test-mode) + (anything-update))) + + (expect (mock (run-with-idle-timer * nil 'anything-process-delayed-sources nil)) + (stub anything-get-sources => '(((name . "1")) + ((name . "2")))) + (stub run-hooks) + (stub anything-maybe-fit-frame) + (let ((anything-pattern "") anything-test-mode) + (anything-update))) + + + (desc "requires-pattern attribute") + (expect (not-called anything-process-source) + (anything-test-update '(((name . "1") (requires-pattern))) "")) + (expect (not-called anything-process-source) + (anything-test-update '(((name . "1") (requires-pattern . 3))) "xx")) + + (desc "delay") + (expect (mock (sit-for 0.25)) + (stub with-current-buffer) + (let ((anything-idle-delay 1.0) + (anything-input-idle-delay 0.75)) + (anything-process-delayed-sources t))) + (expect (mock (sit-for 0.0)) + (stub with-current-buffer) + (let ((anything-idle-delay 0.2) + (anything-input-idle-delay 0.5)) + (anything-process-delayed-sources t))) + (expect (mock (sit-for 0.5)) + (stub with-current-buffer) + (let ((anything-idle-delay 0.5) + (anything-input-idle-delay nil)) + (anything-process-delayed-sources t))) + (desc "anything-normalize-sources") + (expect '(anything-c-source-test) + (anything-normalize-sources 'anything-c-source-test)) + (expect '(anything-c-source-test) + (anything-normalize-sources '(anything-c-source-test))) + (expect '(anything-c-source-test) + (let ((anything-sources '(anything-c-source-test))) + (anything-normalize-sources nil))) + (desc "anything-get-action") + (expect '(("identity" . identity)) + (stub buffer-size => 1) + (stub anything-get-current-source => '((name . "test") + (action ("identity" . identity)))) + (anything-get-action)) + (expect '((("identity" . identity)) "action-transformer is called") + (stub buffer-size => 1) + (stub anything-get-current-source + => '((name . "test") + (action ("identity" . identity)) + (action-transformer + . (lambda (actions selection) + (list actions selection))))) + (stub anything-get-selection => "action-transformer is called") + (anything-get-action)) + (desc "anything-select-nth-action") + (expect "selection" + (stub anything-get-selection => "selection") + (stub anything-exit-minibuffer) + (let (anything-saved-selection) + (anything-select-nth-action 1) + anything-saved-selection)) + (expect 'cadr + (stub anything-get-action => '(("0" . car) ("1" . cdr) ("2" . cadr))) + (stub anything-exit-minibuffer) + (stub anything-get-selection => "selection") + (let (anything-saved-action) + (anything-select-nth-action 2) + anything-saved-action)) + (desc "anything-funcall-foreach") + (expect (mock (upcase "foo")) + (stub anything-get-sources => '(((init . (lambda () (upcase "foo")))))) + (anything-funcall-foreach 'init)) + (expect (mock (downcase "bar")) + (stub anything-get-sources => '(((init . (lambda () (upcase "foo")))) + ((init . (lambda () (downcase "bar")))))) + (anything-funcall-foreach 'init)) + (expect (not-called anything-funcall-with-source) + (stub anything-get-sources => '(((init . (lambda () (upcase "foo")))))) + (anything-funcall-foreach 'not-found)) + ;; TODO anything-select-with-digit-shortcut test + (desc "anything-get-cached-candidates") + (expect '("cached" "version") + (let ((anything-candidate-cache '(("test" "cached" "version")))) + (anything-get-cached-candidates '((name . "test") + (candidates "new"))))) + (expect '("new") + (let ((anything-candidate-cache '(("other" "cached" "version")))) + (anything-get-cached-candidates '((name . "test") + (candidates "new"))))) + (expect '(("test" "new") + ("other" "cached" "version")) + (let ((anything-candidate-cache '(("other" "cached" "version")))) + (anything-get-cached-candidates '((name . "test") + (candidates "new"))) + anything-candidate-cache)) + (expect '(("other" "cached" "version")) + (let ((anything-candidate-cache '(("other" "cached" "version")))) + (anything-get-cached-candidates '((name . "test") + (candidates "new") + (volatile))) + anything-candidate-cache)) + ;; TODO when candidates == process + ;; TODO anything-output-filter + (desc "candidate-number-limit attribute") + (expect '("a" "b") + (let ((anything-pattern "") + (anything-candidate-number-limit 20)) + (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c") + (candidate-number-limit . 2) (volatile))))) + (expect '("a" "b") + (let ((anything-pattern "[abc]") + (anything-candidate-number-limit 20)) + (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c") + (candidate-number-limit . 2) (volatile))))) + (expect '(("TEST" ("a" "b" "c"))) + (let ((anything-candidate-number-limit 2)) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "a\nb\nc\nd\n")))) + (candidates . anything-candidates-in-buffer) + (match identity) + (candidate-number-limit . 3) + (volatile)))))) + (expect '(("TEST" ("a" "b" "c"))) + (let ((anything-candidate-number-limit 2)) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "a\nb\nc\nd\n")))) + (candidates . anything-candidates-in-buffer) + (match identity) + (candidate-number-limit . 3) + (volatile))) + "."))) + (desc "multiple init") + (expect '(1 . 2) + (let (a b) + (anything-test-candidates + '(((name . "test") + (init (lambda () (setq a 1)) + (lambda () (setq b 2)))))) + (cons a b))) + (expect 1 + (let (a) + (anything-test-candidates + '(((name . "test") + (init (lambda () (setq a 1)))))) + a)) + (desc "multiple cleanup") + (expect '(1 . 2) + (let (a b) + (anything-test-candidates + '(((name . "test") + (cleanup (lambda () (setq a 1)) + (lambda () (setq b 2)))))) + (cons a b))) + (desc "anything-mklist") + (expect '(1) + (anything-mklist 1)) + (expect '(2) + (anything-mklist '(2))) + (desc "anything-before-initialize-hook") + (expect 'called + (let ((anything-before-initialize-hook '((lambda () (setq v 'called)))) + v) + (anything-initialize) + v)) + (desc "anything-after-initialize-hook") + (expect '(b a) + (let ((anything-before-initialize-hook + '((lambda () (setq v '(a))))) + (anything-after-initialize-hook + '((lambda () (setq v (cons 'b v))))) + v) + (anything-initialize) + v)) + (expect 0 + (let ((anything-after-initialize-hook + '((lambda () (setq v (buffer-size (get-buffer anything-buffer)))))) + v) + (anything-initialize) + v)) + (desc "get-line attribute") + (expect '(("TEST" ("FOO+"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "foo+\nbar+\nbaz+\n")))) + (candidates-in-buffer) + (get-line . (lambda (s e) (upcase (buffer-substring-no-properties s e)))))) + "oo\\+")) + (desc "with-anything-restore-variables") + (expect '(7 8) + (let ((a 7) (b 8) + (anything-restored-variables '(a b))) + (with-anything-restore-variables + (setq a 0 b 0)) + (list a b))) + (desc "anything-cleanup-hook") + (expect 'called + (let ((anything-cleanup-hook + '((lambda () (setq v 'called)))) + v) + (anything-cleanup) + v)) + (desc "with-anything-display-same-window") + (expect (non-nil) + (save-window-excursion + (delete-other-windows) + (split-window) + + (let ((buf (get-buffer-create " tmp")) + (win (selected-window))) + (with-anything-display-same-window + (display-buffer buf) + (eq win (get-buffer-window buf)))))) + (expect (non-nil) + (save-window-excursion + (delete-other-windows) + (split-window) + + (let ((buf (get-buffer-create " tmp")) + (win (selected-window))) + (with-anything-display-same-window + (pop-to-buffer buf) + (eq win (get-buffer-window buf)))))) + (expect (non-nil) + (save-window-excursion + (delete-other-windows) + (split-window) + + (let ((buf (get-buffer-create " tmp")) + (win (selected-window))) + (with-anything-display-same-window + (switch-to-buffer buf) + (eq win (get-buffer-window buf)))))) + (expect (non-nil) + (save-window-excursion + (delete-other-windows) + (let ((buf (get-buffer-create " tmp")) + (win (selected-window))) + (with-anything-display-same-window + (display-buffer buf) + (eq win (get-buffer-window buf)))))) + (expect (non-nil) + (save-window-excursion + (delete-other-windows) + (let ((buf (get-buffer-create " tmp")) + (win (selected-window))) + (with-anything-display-same-window + (pop-to-buffer buf) + (eq win (get-buffer-window buf)))))) + (desc "search-from-end attribute") + (expect '(("TEST" ("baz+" "bar+" "foo+"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "foo+\nbar+\nbaz+\n")))) + (candidates-in-buffer) + (search-from-end))))) + (expect '(("TEST" ("baz+" "bar+" "foo+"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "foo+\nbar+\nbaz+\n")))) + (candidates-in-buffer) + (search-from-end))) + "\\+")) + (expect '(("TEST" ("baz+" "bar+"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "foo+\nbar+\nbaz+\n")))) + (candidates-in-buffer) + (search-from-end) + (candidate-number-limit . 2))))) + (expect '(("TEST" ("baz+" "bar+"))) + (anything-test-candidates + '(((name . "TEST") + (init + . (lambda () (with-current-buffer (anything-candidate-buffer 'global) + (insert "foo+\nbar+\nbaz+\n")))) + (candidates-in-buffer) + (search-from-end) + (candidate-number-limit . 2))) + "\\+")) + + (desc "header-name attribute") + (expect "original is transformed" + (anything-test-update '(((name . "original") + (candidates "1") + (header-name + . (lambda (name) + (format "%s is transformed" name))))) + "") + (with-current-buffer (anything-buffer-get) + (buffer-string) + (overlay-get (car (overlays-at (1+(point-min)))) 'display))) + (desc "volatile and match attribute") + ;; candidates function is called once per `anything-process-delayed-sources' + (expect 1 + (let ((v 0)) + (anything-test-candidates '(((name . "test") + (candidates . (lambda () (incf v) '("ok"))) + (volatile) + (match identity identity identity))) + "o") + v)) + (desc "accept-empty attribute") + (expect nil + (anything-test-candidates + '(((name . "test") (candidates "") (action . identity)))) + (anything-execute-selection-action)) + (expect "" + (anything-test-candidates + '(((name . "test") (candidates "") (action . identity) (accept-empty)))) + (anything-execute-selection-action)) + (desc "anything-tick-hash") + (expect nil + (with-current-buffer (get-buffer-create " *00create+*") + (puthash " *00create+*/xxx" 1 anything-tick-hash) + (kill-buffer (current-buffer))) + (gethash " *00create+*/xxx" anything-tick-hash)) + ))) + + +(provide 'anything) +;; How to save (DO NOT REMOVE!!) +;; (emacswiki-post "anything.el") +;;; anything.el ends here Index: /dotfiles/emacs/yappo/.emacs.d/elisp/anything-config.el =================================================================== --- /dotfiles/emacs/yappo/.emacs.d/elisp/anything-config.el (revision 26364) +++ /dotfiles/emacs/yappo/.emacs.d/elisp/anything-config.el (revision 26364) @@ -0,0 +1,1148 @@ +;;; anything-config.el --- predefined configurations for anything + +;; Copyright (C) 2007 Tassilo Horn + +;; Maintainer: Tassilo Horn + +;; Contributors: +;; Tamas Patrovics +;; Tassilo Horn +;; Vagn Johansen +;; Mathias Dahl +;; Bill Clementson +;; Stefan Kamphausen (see http://www.skamphausen.de for more informations) +;; Drew Adams +;; Jason McBrayer + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; +;; This package provides predefined configurations for anything.el. To enable +;; it, put this into your `user-init-file'. +;; +;; (require 'anything-config) ; loads anything.el too +;; +;; To configure anything you should tweak the variables `anything-sources' and +;; `anything-type-attributes'. See the default configuration at the bottom of +;; this file. Copy and modify it to your needs. +;; +;; (setq anything-sources ...) +;; (setq anything-type-attributes ...) +;; + +;;; Bugs and TODOs: + +;; +;; - TODO: anything-c-adaptive stores infos for sources/types that don't have +;; set it as `filtered-candidate-transformer'. +;; +;; - TODO: The Imenu source is broken for very recent emacsen. It seems to +;; work with 22.1, though. +;; + +;;; Startup + +(require 'anything) + +;;; Version + +(defvar anything-c-version "<2008-08-13 Wed 14:49>" + "The version of anything-config.el, or better the date of the +last change.") + +;;; Keymaps + +(defvar anything-c-use-standard-keys t + "If non-nil the keybindings of anything will be the standard +bindings used in most parts of emacs, e.g. M-p/M-n for minibuffer +history, C-s for isearch, etc. + +If it's nil anything uses some bindings that don't conflict with +`iswitchb', e.g. C-p/C-n for the minibuffer history. If you use +`iswitchb' you probably should say nil here.") + +(when anything-c-use-standard-keys + (setq anything-map + (let ((map (copy-keymap minibuffer-local-map))) + (define-key map (kbd "") 'anything-next-line) + (define-key map (kbd "") 'anything-previous-line) + (define-key map (kbd "C-n") 'anything-next-line) + (define-key map (kbd "C-p") 'anything-previous-line) + (define-key map (kbd "") 'anything-previous-page) + (define-key map (kbd "") 'anything-next-page) + (define-key map (kbd "M-v") 'anything-previous-page) + (define-key map (kbd "C-v") 'anything-next-page) + (define-key map (kbd "") 'anything-next-source) + (define-key map (kbd "") 'anything-previous-source) + (define-key map (kbd "") 'anything-exit-minibuffer) + (define-key map (kbd "C-1") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-2") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-3") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-4") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-5") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-6") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-7") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-8") 'anything-select-with-digit-shortcut) + (define-key map (kbd "C-9") 'anything-select-with-digit-shortcut) + (define-key map (kbd "") 'anything-select-action) + (defalias 'anything-next-history-element 'next-history-element) + (defalias 'anything-previous-history-element 'previous-history-element) + (define-key map (kbd "M-p") 'anything-previous-history-element) + (define-key map (kbd "M-n") 'anything-next-history-element) + (define-key map (kbd "C-s") 'anything-isearch) + (define-key map (kbd "C-r") 'undefined) + map)) + + (setq anything-isearch-map + (let ((map (copy-keymap (current-global-map)))) + (define-key map (kbd "") 'anything-isearch-default-action) + (define-key map (kbd "") 'anything-isearch-select-action) + (define-key map (kbd "C-g") 'anything-isearch-cancel) + (define-key map (kbd "C-s") 'anything-isearch-again) + (define-key map (kbd "C-r") 'undefined) + (define-key map (kbd "") 'anything-isearch-delete) + ;; add printing chars + (let ((i ?\s)) + (while (< i 256) + (define-key map (vector i) 'anything-isearch-printing-char) + (setq i (1+ i)))) + map))) + +;;; Sources + +;;;; Match functions + +(defun anything-c-match-on-file-name (candidate) + "Return non-nil if `anything-pattern' matches the +filename (without directory part) of CANDIDATE." + (string-match anything-pattern (file-name-nondirectory candidate))) + +(defun anything-c-match-on-directory-name (candidate) + "Return non-nil if `anything-pattern' matches the directory +part of CANDIDATE (a file)." + (let ((dir (file-name-directory candidate))) + (when dir + (string-match anything-pattern dir)))) + +(defun anything-c-string-match (candidate) + "Return non-nil if `anything-pattern' matches CANDIDATE. +The match is done with `string-match'." + (string-match anything-pattern candidate)) + +;;;; Buffers + +(defun anything-c-buffer-list () + "Return the list of names of buffers with the `anything-buffer' +and hidden buffers filtered out. The first buffer in the list +will be the last recently used buffer that is not the current +buffer." + (let ((buffers (remove-if (lambda (name) + (or (equal name anything-buffer) + (eq ?\ (aref name 0)))) + (mapcar 'buffer-name (buffer-list))))) + (append (cdr buffers) (list (car buffers))))) + +(defvar anything-c-source-buffers + '((name . "Buffers") + (candidates . anything-c-buffer-list) + (volatile) + (type . buffer))) + +(defun anything-c-define-dummy-source (name func &rest other-attrib) + `((name . ,name) + (candidates "dummy") + ,@other-attrib + (filtered-candidate-transformer + . (lambda (candidates source) + (funcall ',func))) + (requires-pattern . 1) + (volatile) + (category create))) + +(defun anything-c-dummy-candidate () + ;; `source' is defined in filtered-candidate-transformer + (list (cons (concat (assoc-default 'name source) + " '" anything-input "'") + anything-input))) + +(defvar anything-c-source-buffer-not-found + (anything-c-define-dummy-source + "Create buffer" + (lambda () (unless (get-buffer anything-input) + (anything-c-dummy-candidate))) + '(type . buffer))) + +;;;; File name history + +(defvar anything-c-source-file-name-history + '((name . "File Name History") + (candidates . file-name-history) + (match . (anything-c-match-on-file-name + anything-c-match-on-directory-name)) + (type . file))) + +;;;; Recentf files + +(defvar anything-c-source-recentf + '((name . "Recentf") + (candidates . recentf-list) + (match . (anything-c-match-on-file-name + anything-c-match-on-directory-name)) + (type . file)) + "See (info \"(emacs)File Conveniences\").") + +;;;; Files in current dir + +(defvar anything-c-source-files-in-current-dir + '((name . "Files from Current Directory") + (init . (lambda () + (setq anything-c-default-directory + default-directory))) + (candidates . (lambda () + (directory-files + anything-c-default-directory))) + (volatile) + (type . file))) + +;;;; Man Pages + +(defvar anything-c-man-pages nil + "All man pages on system. +Will be calculated the first time you invoke anything with this +source.") + +(defvar anything-c-source-man-pages + `((name . "Manual Pages") + (candidates . (lambda () + (if anything-c-man-pages + anything-c-man-pages + ;; XEmacs doesn't have a woman :) + (setq anything-c-man-pages + (condition-case nil + (progn + (require 'woman) + (woman-file-name "") + (sort (mapcar 'car + woman-topic-all-completions) + 'string-lessp)) + (error nil)))))) + (action . (("Show with Woman" . woman))) + (requires-pattern . 2))) + +;;;; Info pages + +(defvar anything-c-info-pages nil + "All info pages on system. +Will be calculated the first time you invoke anything with this +source.") + +(defvar anything-c-source-info-pages + `((name . "Info Pages") + (candidates + . (lambda () + (if anything-c-info-pages + anything-c-info-pages + (setq anything-c-info-pages + (save-window-excursion + (save-excursion + (require 'info) + (Info-find-node "dir" "top") + (goto-char (point-min)) + (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.") + topics) + (while (re-search-forward info-topic-regexp nil t) + (add-to-list 'topics (match-string-no-properties 1))) + (goto-char (point-min)) + (Info-exit) + topics))))))) + (action . (("Show with Info" .(lambda (node-str) + (info (replace-regexp-in-string "^[^:]+: " + "" + node-str)))))) + (requires-pattern . 2))) + +;;;; Complex command history + +(defvar anything-c-source-complex-command-history + '((name . "Complex Command History") + (candidates . (lambda () + (mapcar 'prin1-to-string + command-history))) + (volatile) + (type . sexp))) + +;;;; Emacs commands + +(defvar anything-c-source-emacs-commands + '((name . "Emacs Commands") + (candidates . (lambda () + (let (commands) + (mapatoms (lambda (a) + (if (commandp a) + (push (symbol-name a) + commands)))) + (sort commands 'string-lessp)))) + (volatile) + (type . command) + (requires-pattern . 2)) + "Source for completing and invoking Emacs commands. A command +is a function with interactive spec that can be invoked with +`M-x'. + +To get non-interactive functions listed, use +`anything-c-source-emacs-functions'.") + +;;;; Emacs functions + +;;;;; Normal + +(defvar anything-c-source-emacs-functions + '((name . "Emacs Functions") + (candidates . (lambda () + (let (commands) + (mapatoms (lambda (a) + (if (functionp a) + (push (symbol-name a) + commands)))) + (sort commands 'string-lessp)))) + (volatile) + (type . function) + (requires-pattern . 2)) + "Source for completing Emacs functions.") + +;;;;; With abbrev expansion similar to my exec-abbrev-cmd.el + +;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el + +(defvar anything-c-function-abbrev-regexp nil + "Regexp built from the current `anything-pattern' interpreting +it as abbreviation. Only for internal use.") + +(defun anything-c-match-function-by-abbrev (candidate) + "Return non-nil if `anything-pattern' is an abbreviation of the +function CANDIDATE. + +Abbreviations are made by taking the first character from each +word in the function's name, e.g. \"bb\" is an abbrev for +`bury-buffer', \"stb\" is an abbrev for `switch-to-buffer'." + (string-match anything-c-function-abbrev-regexp candidate)) + +(defvar anything-c-source-emacs-functions-with-abbrevs + (append anything-c-source-emacs-functions + '((match . (anything-c-match-function-by-abbrev + anything-c-string-match))) + '((init . (lambda () + (defadvice anything-update + (before anything-c-update-function-abbrev-regexp activate) + (let ((char-list (append anything-pattern nil)) + (str "^")) + (dolist (c char-list) + (setq str (concat str (list c) "[^-]*-"))) + (setq str (concat (substring str 0 (1- (length str))) "$")) + (setq anything-c-function-abbrev-regexp str)))))))) + +;;;; Bookmarks + +(defvar anything-c-source-bookmarks + '((name . "Bookmarks") + (init . (lambda () + (require 'bookmark))) + (candidates . bookmark-all-names) + (type . bookmark)) + "See (info \"(emacs)Bookmarks\").") + +;;;; Picklist + +(defvar anything-c-source-picklist + '((name . "Picklist") + (candidates . (lambda () + (mapcar 'car picklist-list))) + (volatile) + (type . file))) + +;;;; Imenu + +(defvar anything-c-source-imenu + '((name . "Imenu") + (init . (lambda () + (setq anything-c-imenu-current-buffer + (current-buffer)))) + (candidates . (lambda () + (condition-case nil + (with-current-buffer anything-c-imenu-current-buffer + (mapcar (lambda (x) + (cons (car x) x)) + ;; leave only top level completions for + ;; simplicity (could be more sophisticated) + (remove-if-not (lambda (x) + (markerp (cdr x))) + (imenu--make-index-alist)))) + (error nil)))) + (volatile) + (action . imenu))) + +;;;; File Cache + +(defvar anything-c-source-file-cache-initialized nil) + +(defvar anything-c-file-cache-files nil) + +(defvar anything-c-source-file-cache + '((name . "File Cache") + (init . (lambda () + (unless anything-c-source-file-cache-initialized + (setq anything-c-file-cache-files + (loop for item in file-cache-alist append + (destructuring-bind (base &rest dirs) item + (loop for dir in dirs collect + (concat dir base))))) + (defadvice file-cache-add-file (after file-cache-list activate) + (add-to-list 'anything-c-file-cache-files (expand-file-name file))) + (setq anything-c-source-file-cache-initialized t)))) + (candidates . anything-c-file-cache-files) + (match . (anything-c-match-on-file-name + anything-c-match-on-directory-name)) + (type . file))) + +;;;; Locate + +(defvar anything-c-locate-options (if (eq system-type 'darwin) + '("locate") + '("locate" "-i" "-r")) + "A list where the `car' is the name of the locat program +followed by options. The search pattern will be appended, so the +\"-r\" option should be the last option.") + +(defvar anything-c-source-locate + '((name . "Locate") + (candidates . (lambda () + (apply 'start-process "locate-process" nil + (append anything-c-locate-options + (list anything-pattern))))) + (type . file) + (requires-pattern . 3) + (delayed)) + "Source for retrieving files matching the current input pattern +with locate.") + +;;;; Tracker desktop search + +(defvar anything-c-source-tracker-search + '((name . "Tracker Search") + (candidates . (lambda () + (start-process "tracker-search-process" nil + "tracker-search" + anything-pattern))) + (type . file) + (requires-pattern . 3) + (delayed)) + "Source for retrieving files matching the current input pattern +with the tracker desktop search.") + +;;;; Spotlight (MacOS X desktop search) + +(defvar anything-c-source-mac-spotlight + '((name . "mdfind") + (candidates . (lambda () + (start-process "mdfind-process" nil + "mdfind" anything-pattern))) + (type . file) + (requires-pattern . 3) + (delayed)) + "Source for retrieving files via Spotlight's command line +utility mdfind.") + +;;;; BBDB + +(defun anything-c-bbdb-candidates () + "Return a list of all names in the bbdb database. The format +is \"Firstname Lastname\"." + (mapcar (lambda (bbdb-record) + (concat (aref bbdb-record 0) " " (aref bbdb-record 1))) + (bbdb-records))) + +(defun anything-c-bbdb-create-contact (actions candidate) + "Action transformer that returns only an entry to add the +current `anything-pattern' as new contact. All other actions are +removed." + (if (string= candidate "*Add to contacts*") + '(("Add to contacts" + . (lambda (actions) + (bbdb-create-internal + (read-from-minibuffer "Name: " anything-c-bbdb-name) + (read-from-minibuffer "Company: ") + (read-from-minibuffer "Email: ") + nil + nil + (read-from-minibuffer "Note: "))))) + actions)) + +(defvar anything-c-bbdb-name nil + "Only for internal use.") + +(defvar anything-c-source-bbdb + '((name . "BBDB") + (candidates . anything-c-bbdb-candidates) + (volatile) + (action ("View person's data" . (lambda (candidate) + (bbdb candidate nil) + (set-buffer "*BBDB*") + (bbdb-redisplay-one-record (bbdb-current-record)))) + ("Send a mail" . (lambda (candidate) + (let ((rec (progn + (bbdb candidate nil) + (set-buffer "*BBDB*") + (bbdb-current-record)))) + (bbdb-send-mail rec))))) + (filtered-candidate-transformer . (lambda (candidates source) + (setq anything-c-bbdb-name anything-pattern) + (if (not candidates) + (list "*Add to contacts*") + candidates))) + (action-transformer . (lambda (actions candidate) + (anything-c-bbdb-create-contact actions candidate))))) + +;;;; Evaluation Result + +(defvar anything-c-source-evaluation-result + '((name . "Evaluation Result") + (requires-pattern) + (match (lambda (candidate) t)) + (candidates "dummy") + (filtered-candidate-transformer + . (lambda (candidates source) + (list + (condition-case nil + (prin1-to-string + (eval (read anything-pattern))) + (error "error"))))) + (volatile) + (action ("Do Nothing" . ignore)))) + +;;;; Calculation Result + +(defvar anything-c-source-calculation-result + '((name . "Calculation Result") + (requires-pattern) + (match (lambda (candidate) t)) + (candidates "dummy") + (filtered-candidate-transformer + . (lambda (candidates source) + (list + (condition-case nil + (calc-eval anything-pattern) + (error "error"))))) + (volatile) + (action ("Do Nothing" . ignore)))) + +;;;; Google Suggestions + +(defvar anything-c-source-google-suggest + '((name . "Google Suggest") + (candidates + . (lambda () + (let ((suggestions (anything-c-google-suggest-fetch anything-input))) + (if (some (lambda (suggestion) + (equal (cdr suggestion) anything-input)) + suggestions) + suggestions + ;; if there is no suggestion exactly matching the input then + ;; prepend a Search on Google item to the list + (append (list (cons (concat "Search for " + "'" anything-input "'" + " on Google") + anything-input)) + suggestions))))) + (action . (("Google Search" . + (lambda (candidate) + (browse-url (concat anything-c-google-suggest-search-url + (url-hexify-string candidate))))))) + (volatile) + (requires-pattern . 3) + (delayed))) + +(defvar anything-c-google-suggest-url + "http://www.google.com/complete/search?hl=en&js=true&qu=" + "URL used for looking up suggestions.") + +(defvar anything-c-google-suggest-search-url + "http://www.google.com/search?ie=utf-8&oe=utf-8&q=" + "URL used for searching.") + +(defun anything-c-google-suggest-fetch (input) + "Fetch suggestions for INPUT." + (let* ((result (with-current-buffer + (url-retrieve-synchronously + (concat anything-c-google-suggest-url + (url-hexify-string input))) + (buffer-substring (point-min) (point-max)))) + (split (split-string result "new Array(")) + (suggestions (anything-c-google-suggest-get-items (second split))) + (numbers (anything-c-google-suggest-get-items (third split))) + (longest (+ (apply 'max 0 (let (lengths) + (dotimes (i (length suggestions)) + (push (+ (length (nth i suggestions)) + (length (nth i numbers))) + lengths)) + lengths)) + 10)) + items) + (dotimes (i (length suggestions)) + (let ((suggestion (nth i suggestions)) + (number (nth i numbers))) + (push (cons (concat suggestion + (make-string (- longest + (length suggestion) + (length number)) + 32) + number) + suggestion) + items))) + items)) + +(defun anything-c-google-suggest-get-items (str) + "Extract items from STR returned by Google Suggest." + (let ((start nil) + items) + (while (string-match "\"\\([^\"]+?\\)\"" str start) + (push (match-string 1 str) items) + (setq start (1+ (match-end 1)))) + items)) + +;;;; Jabber Contacts (jabber.el) + +(defun anything-c-jabber-online-contacts () + "List online Jabber contacts." + (let (jids) + (dolist (item (jabber-concat-rosters) jids) + (when (get item 'connected) + (push (if (get item 'name) + (cons (get item 'name) item) + (cons (symbol-name item) item)) jids))))) + +(defvar anything-c-source-jabber-contacts + '((name . "Jabber Contacts") + (init . (lambda () (require 'jabber))) + (candidates . (lambda () + (mapcar + 'car + (anything-c-jabber-online-contacts)))) + (action . (lambda (x) + (jabber-chat-with + (jabber-read-account) + (symbol-name + (cdr (assoc x (anything-c-jabber-online-contacts))))))))) + +;;; Type Action helpers + +;;;; Files + +(defvar anything-c-external-commands-list nil + "A list of all external commands the user can execute. If this +variable is not set by the user, it will be calculated +automatically.") + +(defun anything-c-external-commands-list-1 () + "Returns a list of all external commands the user can execute. + +If `anything-c-external-commands-list' is non-nil it will +return its contents. Else it calculates all external commands +and sets `anything-c-external-commands-list'. + +The code is ripped out of `eshell-complete-commands-list'." + (if anything-c-external-commands-list + anything-c-external-commands-list + (setq anything-c-external-commands-list + (let* ((paths (split-string (getenv "PATH") path-separator)) + (cwd (file-name-as-directory + (expand-file-name default-directory))) + (path "") (comps-in-path ()) + (file "") (filepath "") (completions ())) + ;; Go thru each path in the search path, finding completions. + (while paths + (setq path (file-name-as-directory + (expand-file-name (or (car paths) "."))) + comps-in-path + (and (file-accessible-directory-p path) + (file-name-all-completions "" path))) + ;; Go thru each completion found, to see whether it should be + ;; used, e.g. see if it's executable. + (while comps-in-path + (setq file (car comps-in-path) + filepath (concat path file)) + (if (and (not (member file completions)) + (or (string-equal path cwd) + (not (file-directory-p filepath))) + (file-executable-p filepath)) + (setq completions (cons file completions))) + (setq comps-in-path (cdr comps-in-path))) + (setq paths (cdr paths))) + completions)))) + +(defun anything-c-file-buffers (filename) + "Returns a list of those buffer names which correspond to the +file given by FILENAME." + (let (name ret) + (dolist (buf (buffer-list) ret) + (let ((bfn (buffer-file-name buf))) + (when (and bfn + (string= filename bfn)) + (push (buffer-name buf) ret))) + ret))) + +(defun anything-c-delete-file (file) + "Delete the given file after querying the user. Ask to kill +buffers associated with that file, too." + (if (y-or-n-p (format "Really delete file %s? " file)) + (progn + (let ((buffers (anything-c-file-buffers file))) + (delete-file file) + (dolist (buf buffers) + (when (y-or-n-p (format "Kill buffer %s, too? " buf)) + (kill-buffer buf))))) + (message "Nothing deleted."))) + +(defun anything-c-open-file-externally (file) + "Open FILE with an external tool. Query the user which tool to +use." + (start-process "anything-c-open-file-externally" + nil + (completing-read "Program: " + (anything-c-external-commands-list-1)) + file)) + +(defun w32-shell-execute-open-file (file) + (interactive "fOpen file:") + (w32-shell-execute "open" (replace-regexp-in-string ;for UNC paths + "/" "\\" + (replace-regexp-in-string ; strip cygdrive paths + "/cygdrive/\\(.\\)" "\\1:" file nil nil) nil t))) +(defun anything-c-open-file-with-default-tool (file) + "Open FILE with the default tool on this platform." + (if (eq system-type 'windows-nt) + (w32-shell-execute-open-file file) + (start-process "anything-c-open-file-with-default-tool" + nil + (cond ((eq system-type 'gnu/linux) + "xdg-open") + ((or (eq system-type 'darwin) ;; Mac OS X + (eq system-type 'macos)) ;; Mac OS 9 + "open")) + file))) + +(defun anything-c-open-dired (file) + "Opens a dired buffer in FILE's directory. If FILE is a +directory, open this directory." + (if (file-directory-p file) + (dired file) + (dired (file-name-directory file)) + (dired-goto-file file))) + +;;; Action Transformers + +;;;; Files + +(defun anything-c-transform-file-load-el (actions candidate) + "Add action to load the file CANDIDATE if it is an emacs lisp +file. Else return ACTIONS unmodified." + (if (or (string= (file-name-extension candidate) "el") + (string= (file-name-extension candidate) "elc")) + (append actions '(("Load Emacs Lisp File" . load-file))) + actions)) + +(defun anything-c-transform-file-browse-url (actions candidate) + "Add an action to browse the file CANDIDATE if it in a html +file. Else return ACTIONS unmodified." + (if (or (string= (file-name-extension candidate) "htm") + (string= (file-name-extension candidate) "html")) + (append actions '(("Browse with Browser" . browse-url))) + actions)) + +;;;; Function + +(defun anything-c-transform-function-call-interactively (actions candidate) + "Add an action to call the function CANDIDATE interactively if +it is a command. Else return ACTIONS unmodified." + (if (commandp (intern candidate)) + (append actions '(("Call Interactively" + . + (lambda (c) + (call-interactively (intern c)))))) + actions)) + +;;;; S-Expressions + +(defun anything-c-transform-sexp-eval-command-sexp (actions candidate) + "If CANDIDATE's `car' is a command, then add an action to +evaluate it and put it onto the `command-history'." + (if (commandp (car (read candidate))) + ;; Make it first entry + (cons '("Eval and put onto command-history" . + (lambda (sexp) + (let ((sym (read sexp))) + (eval sym) + (setq command-history + (cons sym command-history))))) + actions) + actions)) + +;;; Candidate Transformers + +;;;; Files + +(defvar anything-c-boring-file-regexp + (rx (or + ;; Boring directories + (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol)) + ;; Boring files + (and (or ".class" ".la" ".o" "~") eol))) + "File candidates matching this regular expression will be +filtered from the list of candidates if the +`anything-c-skip-boring-files' candidate transformer is used, or +they will be displayed with face `file-name-shadow' if +`anything-c-shadow-boring-files' is used.") + +(defun anything-c-shadow-boring-files (files) + "Files matching `anything-c-boring-file-regexp' will be +displayed with the `file-name-shadow' face if available." + (mapcar (lambda (file) + ;; Add shadow face property to boring files. + (let ((face (if (facep 'file-name-shadow) + 'file-name-shadow + ;; fall back to default on XEmacs + 'default))) + (if (string-match anything-c-boring-file-regexp file) + (setq file (propertize file 'face face)))) + file) + files)) + +(defun anything-c-skip-boring-files (files) + "Files matching `anything-c-boring-file-regexp' will be +skipped." + (let (filtered-files) + (loop for file in files + do (when (not (string-match anything-c-boring-file-regexp file)) + (push file filtered-files)) + finally (return (nreverse filtered-files))))) + +(defun anything-c-w32-pathname-transformer (args) + "Change undesirable features of windows pathnames to ones more acceptable to +other candidate transformers." + (if (eq system-type 'windows-nt) + (mapcar (lambda (x) + (replace-regexp-in-string "/cygdrive/\\(.\\)" "\\1:" x)) + (mapcar (lambda (y) + (replace-regexp-in-string "\\\\" "/" y)) args)) + args)) + + +(defun anything-c-shorten-home-path (files) + "Replaces /home/user with ~." + (mapcar (lambda (file) + (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows... + (getenv "HOME")))) + (if (string-match home file) + (cons (replace-match "~" nil nil file) file) + file))) + files)) + +;;;; Functions + +(defun anything-c-mark-interactive-functions (functions) + "Mark interactive functions (commands) with (i) after the function name." + (let (list) + (loop for function in functions + do (push (cons (concat function + (when (commandp (intern function)) " (i)")) + function) + list) + finally (return (nreverse list))))) + +;;; Filtered Candidate Transformers + +;;;; Adaptive Sorting of Candidates + +;; User config + +(defvar anything-c-adaptive-history-file "~/.emacs.d/anything-c-adaptive-history" + "Path of file where history information is stored.") + +(defvar anything-c-adaptive-history-length 50 + "Maximum number of candidates stored for a source.") + +;;---------------------------------------------------------------------- + +(defvar anything-c-adaptive-done nil + "nil if history information is not yet stored for the current +selection.") + +(defvar anything-c-adaptive-history nil + "Contains the stored history information. +Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)") + +(defadvice anything-initialize (before anything-c-adaptive-initialize activate) + "Advise `anything-initialize' to reset `anything-c-adaptive-done' +when anything is started." + (setq anything-c-adaptive-done nil)) + +(defadvice anything-exit-minibuffer (before anything-c-adaptive-exit-minibuffer activate) + "Advise `anything-exit-minibuffer' to store history information +when a candidate is selected with RET." + (anything-c-adaptive-store-selection)) + +(defadvice anything-select-action (before anything-c-adaptive-select-action activate) + "Advise `anything-select-action' to store history information +when the user goes to the action list with TAB." + (anything-c-adaptive-store-selection)) + +(defun anything-c-adaptive-store-selection () + "Store history information for the selected candidate." + (unless anything-c-adaptive-done + (setq anything-c-adaptive-done t) + (let* ((source (anything-get-current-source)) + (source-name (or (assoc-default 'type source) + (assoc-default 'name source))) + (source-info (or (assoc source-name anything-c-adaptive-history) + (progn + (push (list source-name) anything-c-adaptive-history) + (car anything-c-adaptive-history)))) + (selection (anything-get-selection)) + (selection-info (progn + (setcdr source-info + (cons + (let ((found (assoc selection (cdr source-info)))) + (if (not found) + ;; new entry + (list selection) + + ;; move entry to the beginning of the + ;; list, so that it doesn't get + ;; trimmed when the history is + ;; truncated + (setcdr source-info + (delete found (cdr source-info))) + found)) + (cdr source-info))) + (cadr source-info))) + (pattern-info (progn + (setcdr selection-info + (cons + (let ((found (assoc anything-pattern (cdr selection-info)))) + (if (not found) + ;; new entry + (cons anything-pattern 0) + + ;; move entry to the beginning of the + ;; list, so if two patterns used the + ;; same number of times then the one + ;; used last appears first in the list + (setcdr selection-info + (delete found (cdr selection-info))) + found)) + (cdr selection-info))) + (cadr selection-info)))) + + ;; increase usage count + (setcdr pattern-info (1+ (cdr pattern-info))) + + ;; truncate history if needed + (if (> (length (cdr selection-info)) anything-c-adaptive-history-length) + (setcdr selection-info + (subseq (cdr selection-info) 0 anything-c-adaptive-history-length)))))) + +(if (file-readable-p anything-c-adaptive-history-file) + (load-file anything-c-adaptive-history-file)) +(add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history) + +(defun anything-c-adaptive-save-history () + "Save history information to file given by +`anything-c-adaptive-history-file'." + (interactive) + (with-temp-buffer + (insert + ";; -*- mode: emacs-lisp -*-\n" + ";; History entries used for anything adaptive display.\n") + (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history) + (current-buffer)) + (insert ?\n) + (write-region (point-min) (point-max) anything-c-adaptive-history-file nil + (unless (interactive-p) 'quiet)))) + +(defun anything-c-adaptive-sort (candidates source) + "Sort the CANDIDATES for SOURCE by usage frequency. +This is a filtered candidate transformer you can use for the +attribute `filtered-candidate-transformer' of a source in +`anything-sources' or a type in `anything-type-attributes'." + (let* ((source-name (or (assoc-default 'type source) + (assoc-default 'name source))) + (source-info (assoc source-name anything-c-adaptive-history))) + (if (not source-info) + ;; if there is no information stored for this source then do nothing + candidates + ;; else... + (let ((usage + ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT) + ;; pairs + (mapcar (lambda (candidate-info) + (let ((count 0)) + (dolist (pattern-info (cdr candidate-info)) + (if (not (equal (car pattern-info) + anything-pattern)) + (incf count (cdr pattern-info)) + + ;; if current pattern is equal to the previously + ;; used one then this candidate has priority + ;; (that's why its count is boosted by 10000) and + ;; it only has to compete with other candidates + ;; which were also selected with the same pattern + (setq count (+ 10000 (cdr pattern-info))) + (return))) + (cons (car candidate-info) count))) + (cdr source-info))) + sorted) + + ;; sort the list in descending order, so candidates with highest + ;; priorty come first + (setq usage (sort usage (lambda (first second) + (> (cdr first) (cdr second))))) + + ;; put those candidates first which have the highest usage count + (dolist (info usage) + (when (member* (car info) candidates + :test 'anything-c-adaptive-compare) + (push (car info) sorted) + (setq candidates (remove* (car info) candidates + :test 'anything-c-adaptive-compare)))) + + ;; and append the rest + (append (reverse sorted) candidates nil))))) + +(defun anything-c-adaptive-compare (x y) + "Compare candidates X and Y taking into account that the +candidate can be in (DISPLAY . REAL) format." + (equal (if (listp x) + (cdr x) + x) + (if (listp y) + (cdr y) + y))) + +;;; Default Configuration + +;;;; Helper Functions + +(defun anything-c-compose (arg-lst func-lst) + "Call each function in FUNC-LST with the arguments specified in +ARG-LST. The result of each function will be the new `car' of +ARG-LST. + +This function allows easy sequencing of transformer functions." + (dolist (func func-lst) + (setcar arg-lst (apply func arg-lst))) + (car arg-lst)) + +;;;; Sources + +(setq anything-sources + (list anything-c-source-buffers + anything-c-source-buffer-not-found + anything-c-source-file-name-history + anything-c-source-info-pages + anything-c-source-man-pages + anything-c-source-locate + anything-c-source-emacs-commands)) + +;;;; Type Attributes + +(setq anything-type-attributes + `((buffer + (action + ,@(if pop-up-frames + '(("Switch to buffer other window" . switch-to-buffer-other-window) + ("Switch to buffer" . switch-to-buffer)) + '(("Switch to buffer" . switch-to-buffer) + ("Switch to buffer other window" . switch-to-buffer-other-window) + ("Switch to buffer other frame" . switch-to-buffer-other-frame))) + ("Display buffer" . display-buffer) + ("Kill buffer" . kill-buffer))) + (file + (action + ,@(if pop-up-frames + '(("Find file other window" . find-file-other-window) + ("Find file" . find-file)) + '(("Find file" . find-file) + ("Find file other window" . find-file-other-window) + ("Find file other frame" . find-file-other-frame))) + ("Open dired in file's directory" . anything-c-open-dired) + ("Delete file" . anything-c-delete-file) + ("Open file externally" . anything-c-open-file-externally) + ("Open file with default tool" . anything-c-open-file-with-default-tool)) + (action-transformer . (lambda (actions candidate) + (anything-c-compose + (list actions candidate) + '(anything-c-transform-file-load-el + anything-c-transform-file-browse-url)))) + (candidate-transformer . (lambda (candidates) + (anything-c-compose + (list candidates) + '(anything-c-w32-pathname-transformer + anything-c-skip-boring-files + anything-c-shorten-home-path))))) + (command (action ("Call interactively" . (lambda (command-name) + (call-interactively (intern command-name)))) + ("Describe command" . (lambda (command-name) + (describe-function (intern command-name)))) + ("Add command to kill ring" . kill-new) + ("Go to command's definition" . (lambda (command-name) + (find-function + (intern command-name))))) + ;; Sort commands according to their usage count. + (filtered-candidate-transformer . anything-c-adaptive-sort)) + (function (action ("Describe function" . (lambda (function-name) + (describe-function (intern function-name)))) + ("Add function to kill ring" . kill-new) + ("Go to function's definition" . (lambda (function-name) + (find-function + (intern function-name))))) + (action-transformer . (lambda (actions candidate) + (anything-c-compose + (list actions candidate) + '(anything-c-transform-function-call-interactively)))) + (candidate-transformer . (lambda (candidates) + (anything-c-compose + (list candidates) + '(anything-c-mark-interactive-functions))))) + (sexp (action ("Eval s-expression" . (lambda (c) + (eval (read c)))) + ("Add s-expression to kill ring" . kill-new)) + (action-transformer . (lambda (actions candidate) + (anything-c-compose + (list actions candidate) + '(anything-c-transform-sexp-eval-command-sexp))))) + (bookmark (action ("Jump to bookmark" . bookmark-jump) + ("Delete bookmark" . bookmark-delete))))) + +;;; Provide anything-config + +(provide 'anything-config) + +;; Local Variables: +;; mode: outline-minor +;; End: + +;;; anything-config.el ends here Index: /dotfiles/emacs/yappo/.emacs.d/elisp/javascript-mode.el =================================================================== --- /dotfiles/emacs/yappo/.emacs.d/elisp/javascript-mode.el (revision 26364) +++ /dotfiles/emacs/yappo/.emacs.d/elisp/javascript-mode.el (revision 26364) @@ -0,0 +1,296 @@ +;; javascript-mode.el --- major mode for editing javascript (.js) files +;; +;; Copyright (C) 1997 Peter Kruse + +;; Author: Peter Kruse +;; Keywords: languages +;; Time-stamp: + +;; This file is *NOT* part of GNU Emacs. + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2 of the License, or +;; (at your option) any later version. + +;; javascript-mode.el is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this file; if not, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; Get the latest version from +;; + +;; Basically this is c-mode, for indentation, that's where the line +;; (load-library "c-mode") comes from. colorization is done via hilit19.el. +;; Actually did not do much programming myself, just wanted to have +;; colorization, indentation and some functions (hm that's what major modes +;; are about?) hey, this is my first try! + +;;; HOW TO INSTALL: +;; Put the following forms in your .emacs to enable autoloading of JavaScript +;; mode, and auto-recognition of ".js" files. +;; +;; (autoload 'javascript-mode "javascript-mode" "JavaScript mode" t) +;; (setq auto-mode-alist (append '(("\\.js$" . javascript-mode)) +;; auto-mode-alist)) +;; +;; This mode requires another lisp file, tempo.el. This can be +;; retrieved from ftp://ftp.lysator.liu.se/pub/emacs/tempo.el +;; +;; You might want to get browse-url.el, for the online help. +;; Get it from +;; http://wombat.doc.ic.ac.uk/emacs/browse-url.el + +;;; Change Log: +;; +;; Sun Apr 12 19:48:48 1998 +;; +;; included a menu +;; +;; Mon Sep 22 20:03:12 MET DST 1997 +;; +;; improvement of Syntax-table +;; +;; Sun Sep 7 17:57:50 MET DST 1997 +;; +;; new variable: javascript-interactive +;; +;; Mon Sep 1 14:52:37 MET DST 1997 +;; +;; javascript online help - all it does, is browse-url to +;; javascript-base-help-href +;; +;; Fri Aug 29 21:01:22 MET DST 1997 Peter Kruse +;; +;; +;; 1st release + + +;;; TODO +;; +;; - online help should work like describe-\(function\|variable\), +;; but get the info from the web. Netscape's documention is in progress, +;; there is no final complete docu on JavaScript1.2, so perhaps we wait. +;; +;; - should include an interface to signing scripts, but zigbert is not +;; available for linux + +;;; Bugs +;; +;; - strings in single-quotes do not highlight + +;;; Code: + +;; user-variables + +(defvar javascript-indentation 4 + "The width for further indentation in JavaScript mode.") + +(defvar javascript-base-help-href "http://developer.netscape.com/library/documentation/communicator/jsguide/" + "URL where the javascript guide can be found.") + +(defvar javascript-browse-url-function 'browse-url-w3 + "how to view online help.") + +(defvar javascript-interactive t + "If t user will be prompted for strings in templates.") + +;;; + +(defvar javascript-mode-map (make-sparse-keymap) + "Keymap for javascript-mode") + +(defvar javascript-mode-syntax-table nil + "Syntax table for javascript-mode.") + +(defvar javascript-mode-hook nil + "*Hook run when javascript-mode is started.") + +(if javascript-mode-syntax-table + () + (setq javascript-mode-syntax-table (make-syntax-table text-mode-syntax-table)) + (modify-syntax-entry ?_ "w" javascript-mode-syntax-table) + (modify-syntax-entry ?' "\"" javascript-mode-syntax-table) + (modify-syntax-entry ?% "_" javascript-mode-syntax-table) + (modify-syntax-entry ?\" "\"" javascript-mode-syntax-table) + (modify-syntax-entry ?\\ "\\" javascript-mode-syntax-table) + (modify-syntax-entry ?. "_" javascript-mode-syntax-table)) + + +(defvar javascript-mode-abbrev-table nil + "Abbrev table used while in javascript-mode.") +(define-abbrev-table 'javascript-mode-abbrev-table ()) + +(require 'tempo) + +(tempo-define-template + "javascript-for" + (list "for (" '(p "initial: ") "; " '(p "condition: ") "; " '(p "increment: ") ") {" 'n> 'p 'n "}" '>) + nil "insert a for loop" nil) + +(tempo-define-template + "javascript-for-in" + (list "for (" '(p "variable: ") " in " '(p "object: ") ") {" '> 'n> 'p 'n "}" '>) + nil "insert a for loop" nil) + +(tempo-define-template + "javascript-if" + (list "if (" '(p "condition: ") ") {" 'n> 'p 'n "}" '>) + nil "insert an if statement" nil) + +(tempo-define-template + "javascript-while" + (list "while (" '(p "condition: ") ") {" 'n> 'p 'n "}" '>) + nil "insert a while statement" nil) + +(tempo-define-template + "javascript-do" + (list "do {" '> 'n> 'p 'n "} while(" '(p "condition: ") ");" '>) + nil "insert a do-while statement" nil) + +(tempo-define-template + "javascript-with" + (list "with (" '(p "with what? ") ") {" 'n> 'p 'n "}" '>) + nil "insert a with statement" nil) + +(tempo-define-template + "javascript-defun" + (list "function " '(p "function name: ") "(" '(p "arguments: ") ") {" 'n> 'p 'n "}" '>) + nil "insert a function definition" nil) + +(tempo-define-template + "javascript-switch" + (list "switch (" '(p "variable: ") ") {" '> 'n> "case '" 'p "' :" '> 'n> "break;" '> 'n> "default :" '> 'n> "}" '>) + nil "insert a switch statement" nil) + +(tempo-define-template + "javascript-case" + (list "case '" 'p "' :" '> 'n> "break;" '>) + nil "insert a case" nil) + +;;; now for the help facility +;;; from man.el + +(defun javascript-help (entry) + "Opens a browser via browse-url with a help entry on the current word." + (interactive + (list (let* ((default-entry (current-word)) + (input (read-string + (format "Help entry%s: " + (if (string= default-entry "") + "" + (format " (default %s)" default-entry)))))) + (if (string= input "") + (if (string= default-entry "") + (error "No entry given") + default-entry) + input)))) + (let ((url (concat javascript-base-help-href "contents.htm" "#" entry)) + (browse-url-browser-function javascript-browse-url-function)) + (if (boundp 'browse-url-browser-function) + (progn + (pop-to-buffer " javascript-help") + (apply browse-url-browser-function (list url))) + (error "browse-url not found")))) + +(modify-frame-parameters (selected-frame) '((menu-bar-lines . 2))) +(define-key javascript-mode-map [menu-bar javascript] + (cons "JavaScript" javascript-mode-map)) +(define-key javascript-mode-map [menu-bar javascript Help] + '("Help" . javascript-help)) +(define-key javascript-mode-map [menu-bar javascript for] + '("for" . tempo-template-javascript-for)) +(define-key javascript-mode-map [menu-bar javascript forin] + '("for .. in" . tempo-template-javascript-for-in)) +(define-key javascript-mode-map [menu-bar javascript if] + '("if" . tempo-template-javascript-if)) +(define-key javascript-mode-map [menu-bar javascript while] + '("while" . tempo-template-javascript-while)) +(define-key javascript-mode-map [menu-bar javascript with] + '("with" . tempo-template-javascript-with)) +(define-key javascript-mode-map [menu-bar javascript switch] + '("switch" . tempo-template-javascript-switch)) +(define-key javascript-mode-map [menu-bar javascript case] + '("case" . tempo-template-javascript-case)) +(define-key javascript-mode-map [menu-bar javascript do] + '("do" . tempo-template-javascript-do)) +(define-key javascript-mode-map [menu-bar javascript function] + '("function" . tempo-template-javascript-defun)) + + +(define-key javascript-mode-map "\C-c\C-h" 'javascript-help) +(define-key javascript-mode-map "\C-c\C-f" 'tempo-template-javascript-for) +(define-key javascript-mode-map "\C-c\C-n" 'tempo-template-javascript-for-in) +(define-key javascript-mode-map "\C-c\C-i" 'tempo-template-javascript-if) +(define-key javascript-mode-map "\C-c\C-w" 'tempo-template-javascript-while) +(define-key javascript-mode-map "\C-c\C-t" 'tempo-template-javascript-with) +(define-key javascript-mode-map "\C-c\C-s" 'tempo-template-javascript-switch) +(define-key javascript-mode-map "\C-c\C-c" 'tempo-template-javascript-case) +(define-key javascript-mode-map "\C-c\C-d" 'tempo-template-javascript-do) +(define-key javascript-mode-map "\C-c(" 'tempo-template-javascript-defun) +(define-key javascript-mode-map "{" 'electric-c-brace) +(define-key javascript-mode-map "}" 'electric-c-brace) + +(defun javascript-mode () + "Major mode for editing javascript code. Basically this is c-mode, +because it does a nice indentation. c-mode gets called via `load-library'. +Colorization is done with hilit19. A few commands are defined through +`tempo.el'. The online help facility gets done through browse-url.el. +\\{javascript-mode-map} +You can set the indentation level by setting the variable +`javascript-indentation' to an integer-value. Default is 4. +The variable javascript-base-help-href sets the URL for the JavaScript guide." + (interactive) + (kill-all-local-variables) + (load-library "c-mode") + (require 'browse-url) + (use-local-map javascript-mode-map) + (setq major-mode 'javascript-mode) + (setq mode-name "JavaScript") + + (set-syntax-table javascript-mode-syntax-table) + + (make-local-variable 'comment-start) + (setq comment-start "// ") + (make-local-variable 'comment-start-skip) + (setq comment-start-skip "/\\*+ *\\|// *") + (make-local-variable 'tempo-interactive) + (setq tempo-interactive javascript-interactive) + (make-local-variable 'indent-line-function) + (setq indent-line-function 'c-indent-line) + (make-local-variable 'c-indent-level) + (setq c-indent-level javascript-indentation) + + (run-hooks 'javascript-mode-hook)) + +;;; + +(if (featurep 'hilit19) + (hilit-set-mode-patterns + 'javascript-mode + '(("/\\*" "\\*/" comment) + ("//" "$" comment) + ("\\\\s +[^0-9]\\w+\\s *([^)]*)" nil defun) + ("\\<\\(abstract\\|boolean\\|break\\|byte\\|case\\|catch\\|char\\|class\\|const\\|continue\\|default\\|delete\\|do\\|double\\|else\\|extends\\|false\\|final\\|finally\\|float\\|for\\|goto\\|if\\|implements\\|in\\|instanceof\\|int\\|interface\\|long\\|native\\|new\\|null\\|package\\|private\\|protected\\|public\\|return\\|short\\|static\\|super\\|switch\\|synchronized\\|this\\|throw\\|throws\\|transient\\|true\\|try\\|typeof\\|var\\|void\\|while\\)\\>" 1 keyword) + ("\\\\s *([^)]*)" nil include) + ("\\<\\(import\\|export\\)\\>\\s +.*" nil include) + ("\"[^\\\"]*\\(\\\\.[^\\\"]*\\)*\"" nil string) + ("^\\s *\\w+\\s *:\\s *$" nil label)) + nil nil) + nil) + + +(provide 'javascript-mode) + +;; javascript-mode.el ends here + +;; Local Variables: +;; local-write-file-hooks:(time-stamp) +;; End: Index: /dotfiles/emacs/yappo/.emacs.d/elisp/perl-completion.el =================================================================== --- /dotfiles/emacs/yappo/.emacs.d/elisp/perl-completion.el (revision 26364) +++ /dotfiles/emacs/yappo/.emacs.d/elisp/perl-completion.el (revision 26364) @@ -0,0 +1,1945 @@ +;;; -*- coding: utf-8; mode: emacs-lisp; -*- +;;; perl-completion.el + +;; Author: Kenji.Imakado +;; Keywords: perl + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;; Prefix: plcmp- + +;;; Commentary: +;; Tested on Emacs 22 + +;; to customize +;; M-x customize-group RET perl-completion RET + + +;; TODO: +;; plcmp-cmd-show-environment +;; plcmp-other-perl-buffer-limit-number can be nil + +;;;code: +(require 'cl) +(require 'anything) ; perl-completion.el uses `anything-aif' macro. +(require 'cperl-mode) +(require 'dabbrev) +(require 'rx) + + +;;; customize-variables +(defgroup perl-completion nil + "" + :group 'perl-completion) + +(defcustom plcmp-lib-directory-re "lib/" + "補完候補収得時に自動的に 環境変数 PERL5LIB に追加するディレクトリを決めるために使われるregexp +編集中のfileから再帰的に親ディレクトリをたどっていき,この変数の値にマッチするディレクトリを見つけると 環境変数 PERL5LIB に追加する. + +デフォルトの値は \"lib/\" で,これは一般的なプロジェクトのディレクトリ構成の場合,うまく動く. +例, ~/c/project/app/hoge/huga.pl を編集中の場合 ~/c/project/lib/ を 環境変数 PERL5LIBに自動的に追加して補完候補を収得する. + +注意!! インストールされているモジュール,メソッド名等はcacheされているため, +最収得したい場合は command `plcmp-cmd-clear-all-caches'を使う必要がある." + :type 'regexp + :group 'perl-completion) + +(defcustom plcmp-use-keymap t + "Non-nil means to use `plcmp-mode-map'" + :group 'perl-completion) + +(defcustom plcmp-extra-using-modules nil + "list of string or alist" + :group 'perl-completion) + +(defcustom plcmp-method-inspecter nil + "Detect how to get methods. +variable is one of the following values: +'class-inspector +'scrape + +'class-inspector, use Class::Inspector +'scrape, open module, then scrape subs. this way is slow. +otherwise, try both" + :group 'perl-completion) + +(defcustom plcmp-perl-buffer-re "\\.[pP][lmLM]$" + "Perlバッファとして扱うファイル名にマッチするregexp" + :type 'regexp + :group 'perl-completion) + +(defcustom plcmp-other-perl-buffer-limit-number 30 + "補完対象にする他のperlバッファの最大数" + :type 'number + :group 'perl-completion) + +(defcustom plcmp-module-filter-list '("strict" "warning") + "補完対象に含めないモジュール名のリスト +このリストに含まれているモジュールのメソッドは補完対象にならない" + :type '(repeat (string :tag "Module name")) + :group 'perl-completion) + +(defcustom plcmp-additional-PERL5LIB-directories nil + "補完候補収得時に 環境変数 PERL5LIB に動的に追加されるディレクトリ文字列のリスト. + +特記事項として,編集中のバッファの上位のディレクトリに customize-variable `plcmp-lib-directory-re' にマッチするディレクトリが存在した場合, +perl-completionはそのディレクトリを自動的に 環境変数 PERL5LIB に追加するのでこの変数に追加する必要はない. + +例として, +customize-variable `plcmp-lib-directory-re' の値が \"lib/\", +編集中のファイルが ~/c/test/app/hoge/huga.pl の場合, +~/c/test/lib が存在すれば補完候補収得時に PERL5LIB に追加される. + + +正確には補完候補を収得する関数の実行中にコピーした `process-environment' の値に変更を加え, +letでダイナミックにバインドしているので実行後に元の値に戻る(`process-environment'を直接変更するのではない)." + :type '(repeat (string :tag "perl lib directory")) + :group 'perl-completion) + + +;;; log util +(defvar plcmp-debug nil) +(defvar plcmp-log-buf-name "*plcmp debug*") +(defun plcmp-log-buf () + (get-buffer-create plcmp-log-buf-name)) +(defsubst plcmp-log (&rest messages) + (ignore-errors + (when plcmp-debug + (require 'pp) + (let* ((str (or (ignore-errors (apply 'format messages)) + (pp-to-string (car messages)))) + (strn (concat str "\n"))) + (with-current-buffer (plcmp-log-buf) + (goto-char (point-max)) + (insert strn)) + str)))) +(defun plcmp-message (&rest args) + (when plcmp-debug + (prog1 (apply 'message args) + (apply 'plcmp-log args)))) + + +;;; variables +(defvar plcmp-version 1.0) + +(defvar plcmp-perl-ident-re "[a-zA-Z_][a-zA-Z_0-9]*") + +(defvar plcmp-sub-re (rx-to-string `(and "sub" + (+ space) + (group + (regexp ,plcmp-perl-ident-re))))) + +(defvar plcmp-perl-package-re "[a-zA-Z_][a-zA-Z0-9_:]*") + +(defvar plcmp-builtin-functions + '("abs" "exec" "glob" "order" "seek" "symlink" "accept" "exists" "gmtime" + "our" "seekdir" "syscall" "alarm" "exit" "goto" "pack" "select" "sysopen" + "atan" "exp" "grep" "package" "semctl" "sysread" "bind" "fcntl" "hex" + "pipe" "semget" "sysseek" "binmode" "fileno" "import" "pop" "semop" + "system" "bless" "flags" "index" "pos" "send" "syswrite" "caller" "flock" + "int" "precision" "setgrent" "tell" "chdir" "fork" "ioctl" "print" "sethostent" + "telldir" "chmod" "format" "join" "printf" "setnetent" "tie" "chomp" "formline" + "keys" "prototype" "setpgrp" "tied" "chop" "getc" "kill" "push" "setpriority" + "time" "chown" "getgrent" "last" "q" "setprotoent" "times" "chr" "getgrgid" + "lc" "qq" "setpwent" "tr" "chroot" "getgrnam" "lcfirst" "qr" "setservent" + "truncate" "close" "gethostbyaddr" "length" "quotemeta" "setsockopt" "uc" + "closedir" "gethostbyname" "link" "qw" "shift" "ucfirst" "connect" "gethostent" + "listen" "qx" "shmctl" "umask" "continue" "getlogin" "local" "rand" "shmget" + "undef" "cos" "getnetbyaddr" "localtime" "read" "shmread" "unlink" "crypt" + "getnetbyname" "lock" "readdir" "shmwrite" "unpack" "dbmclose" "getnetent" + "log" "readline" "shutdown" "unshift" "dbmopen" "getpeername" "lstat" "readlink" + "sin" "untie" "defined" "getpgrp" "m" "readpipe" "size" "use" "delete" "getppid" + "map" "recv" "sleep" "utime" "die" "getpriority" "mkdir" "redo" "socket" "values" + "do" "getprotobyname" "msgctl" "ref" "socketpair" "vec" "dump" "getprotobynumber" + "msgget" "rename" "sort" "vector" "each" "getprotoent" "msgrcv" "require" "splice" + "wait" "endgrent" "getpwent" "msgsnd" "reset" "split" "waitpid" "endhostent" + "getpwnam" "my" "return" "sprintf" "wantarray" "endnetent" "getpwuid" "next" + "reverse" "sqrt" "warn" "endprotoent" "getservbyname" "no" "rewinddir" "srand" + "write" "endpwent" "getservbyport" "oct" "rindex" "stat" "y" "endservent" "getservent" + "open" "rmdir" "study" "eof" "getsockname" "opendir" "s" "sub" "eval" "getsockopt" + "ord" "scalar" "substr")) + +(defvar plcmp-builtin-variables + '("$SIG{expr}" "%SIG" "$ENV{expr}" "%ENV" "%INC" "@_" "@INC" "@F" "ARGVOUT" + "@ARGV" "$ARGV" "ARGV" "$^X" "$EXECUTABLE_NAME" "${^WARNING_BITS}" "$^W" + "$WARNING" "$^V" "$PERL_VERSION" "${^UTF8LOCALE}" "${^UNICODE}" "${^TAINT}" + "$^T" "$BASETIME" "$^S" "$EXCEPTIONS_BEING_CAUGHT" "$^R" + "$LAST_REGEXP_CODE_RESULT" "$^P" "$PERLDB" "${^OPEN}" "$^O" "$OSNAME" "$^M" "$^I" "$INPLACE_EDIT" + "%^H" "$^H" "$^F" "$SYSTEM_FD_MAX" "$^D" "$DEBUGGING" "$^C" "$COMPILING" "$]" + "$[" "$0" "$PROGRAM_NAME" "$)" "$EGID" "$EFFECTIVE_GROUP_ID" "$(" "$GID" "$REAL_GROUP_ID" + "$>" "$EUID" "$EFFECTIVE_USER_ID" "$<" "$UID" "$REAL_USER_ID" "$$" "$PID" "$PROCESS_ID" + "$@" "$EVAL_ERROR" "$^E" "$EXTENDED_OS_ERROR" "%!" "$!" "$ERRNO" "$OS_ERROR" "${^ENCODING}" + "$?" "$CHILD_ERROR" "$^A" "$ACCUMULATOR" "$^L" "$FORMAT_FORMFEED" "IO::Handle->format_formfeed" "$:" + "$FORMAT_LINE_BREAK_CHARACTERS" "IO::Handle->format_line_break_characters" "$^" + "$FORMAT_TOP_NAME" "HANDLE->format_top_name(EXPR)" "$~" + "$FORMAT_NAME" "HANDLE->format_name(EXPR)" "@-" "@LAST_MATCH_START" + "$-" "$FORMAT_LINES_LEFT" "HANDLE->format_lines_left(EXPR)" "$=" + "$FORMAT_LINES_PER_PAGE" "HANDLE->format_lines_per_page(EXPR)" "$%" + "$FORMAT_PAGE_NUMBER" "HANDLE->format_page_number(EXPR)" "$#" "$;" + "$SUBSEP" "$SUBSCRIPT_SEPARATOR" "$\"" "$LIST_SEPARATOR" "$\\" "$ORS" + "$OUTPUT_RECORD_SEPARATOR" "IO::Handle->output_record_separator" "$," "$OFS" + "$OUTPUT_FIELD_SEPARATOR" "IO::Handle->output_field_separator" "$|" + "$OUTPUT_AUTOFLUSH" "HANDLE->autoflush(EXPR)" "$/" "$RS" + "$INPUT_RECORD_SEPARATOR" "IO::Handle->input_record_separator(EXPR)" "$." + "$NR" "$INPUT_LINE_NUMBER" "HANDLE->input_line_number(EXPR)" "$*" "@+" + "@LAST_MATCH_END" "$^N" "$+" "$LAST_PAREN_MATCH" "$'" "$POSTMATCH" "$`" + "$PREMATCH" "$&" "$MATCH" "$" "$b" "$a" "$_" "$ARG")) + +(defvar plcmp--command-cleanup-hook nil "hook run when completion command finished") + +(defvar plcmp--cached-variables nil "list of cached variable. each variable is cleared by function `plcmp-cmd-clear-all-caches'") + +(defvar plcmp-clear-all-caches-hook nil + "hook run when invoke `plcmp-cmd-clear-all-caches'") + +;;; keymap +(defvar plcmp-mode-map + (let ((map (make-sparse-keymap))) + (when plcmp-use-keymap + ;; completion + (define-key map (kbd "C-RET") 'plcmp-cmd-smart-complete) + (define-key map (kbd "C-") 'plcmp-cmd-smart-complete) + (define-key map (kbd "C-M-i") 'plcmp-cmd-smart-complete) + (define-key map (kbd "C-c a") 'plcmp-cmd-complete-arrays) + (define-key map (kbd "C-c i") 'plcmp-cmd-complete-modules) + (define-key map (kbd "C-c v") 'plcmp-cmd-complete-variables) + (define-key map (kbd "C-c f") 'plcmp-cmd-complete-functions) + (define-key map (kbd "C-c h") 'plcmp-cmd-complete-hashes) + (define-key map (kbd "C-c m") 'plcmp-cmd-complete-methods) + (define-key map (kbd "C-c C-c a") 'plcmp-cmd-complete-all) + + ;; doc + (define-key map (kbd "C-c d") 'plcmp-cmd-show-doc) + (define-key map (kbd "C-c s") 'plcmp-cmd-show-doc-at-point) + (define-key map (kbd "C-c M") 'plcmp-cmd-menu) + + ;; other + (define-key map (kbd "C-c c") 'plcmp-cmd-clear-all-caches) + (define-key map (kbd "C-c C-c s") 'plcmp-cmd-show-environment) + (define-key map (kbd "C-c C-c u") 'plcmp-cmd-update-check) + (define-key map (kbd "C-c C-c d") 'plcmp-cmd-set-additional-lib-directory)) + + map)) + +(defvar plcmp-anything-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "O") 'plcmp-acmd-occur) + (define-key map (kbd "D") 'plcmp-acmd-show-doc) + (define-key map (kbd "F") 'plcmp-acmd-open-related-file) + (define-key map (kbd "G") 'plcmp-acmd-goto-looking-point) + (define-key map (kbd "J") 'scroll-other-window) + (define-key map (kbd "K") 'scroll-other-window-down) + (define-key map (kbd "L") 'plcmp-acmd-persistent-look) + (set-keymap-parent map anything-map) + + map)) + + +;;; macros + +;; perl5 lib +;; idea: http://svn.coderepos.org/share/lang/elisp/set-perl5lib/set-perl5lib.el +;; http://d.hatena.ne.jp/sun-basix/20080117/1200528765 (Japanese) + +(defvar plcmp--PERL5LIB-directories nil + "補完候補収得時に環境変数 PERL5LIB に動的に追加されるディレクトリ文字列のリストだが, +この変数はコマンド `plcmp-cmd-set-additional-lib-directory' によって設定される内部変数なので, +ユーザーがlispで直接変更してはならない. + +ユーザーレベルで補完候補収得時に環境変数 PERL5LIBの値にディレクトリを追加したい場合は, +customize-variable `plcmp-additional-PERL5LIB-directories' に設定する.") + + +(defun plcmp--get-lib-path () + "return string(additional library path)" + (let ((dir (plcmp-get-current-directory)) + (lib-re (rx-to-string `(and (group + bol + (* not-newline) + ,plcmp-lib-directory-re))))) + (when (string-match lib-re dir) + (let ((lib-dir (match-string 1 dir))) + (and (stringp lib-dir) + (file-exists-p lib-dir) + (directory-file-name lib-dir)))))) + +(defmacro plcmp-with-set-perl5-lib (&rest body) + "Set each path that value of `plcmp--get-lib-path' to PERL5LIB. +then execute BODY" + `(let ((process-environment (copy-sequence process-environment))) + (require 'env) + (let ((additional-lib-list (append (ignore-errors (mapcar 'expand-file-name plcmp-additional-PERL5LIB-directories)) + plcmp--PERL5LIB-directories + (when (plcmp--get-lib-path) + (list (plcmp--get-lib-path))))) + (old-perl5lib (or (getenv "PERL5LIB") ""))) + (when additional-lib-list + (let* ((additional-lib-str (mapconcat 'identity additional-lib-list path-separator)) + (current-perl5lib (concat additional-lib-str path-separator old-perl5lib)) + (current-perl5lib (replace-regexp-in-string ":$" "" current-perl5lib))) + (when (and (stringp current-perl5lib) + (not (equal "" current-perl5lib))) + (setenv "PERL5LIB" current-perl5lib) + (plcmp-log "plcmp-with-set-perl5-lib PERL5LIB: %s" current-perl5lib))))) + (progn + ,@body))) + + +(defmacro define-plcmp-command (command-name-with-no-prefix args &rest body) + (let* ((prefix "plcmp-cmd-") + (command-str (symbol-name command-name-with-no-prefix)) + (command-name (concat prefix command-str))) + `(defun* ,(intern command-name) ,args + (interactive) + (unwind-protect + (let ((anything-map plcmp-anything-map)) + (plcmp-with-set-perl5-lib + (progn (plcmp-initialize-variables) + ,@body))) + (plcmp-cleanup))))) +(put 'define-plcmp-command 'lisp-indent-function 'defun) +(def-edebug-spec define-plcmp-command defun*) + +(defmacro plcmp-ignore-errors (&rest body) + `(condition-case e (progn ,@body) + (error (plcmp-log "Error plcmp-ignore-errors : %s" (error-message-string e))))) +(def-edebug-spec plcmp-ignore-errors ignore-errors) + +;;; Util functions +(defsubst plcmp-trim (s) + "strip space and newline" + (replace-regexp-in-string + "[ \t\n]*$" "" (replace-regexp-in-string "^[ \t\n]*" "" s))) + +(defsubst plcmp-bit-regexp-p (s) + (string-match "^[/:$@&%(),.?<>+!|^*';\"\\]+$" s)) + +(defsubst plcmp-module-p (s) + (string-match "^[a-zA-Z:]+$" s)) + +(defsubst plcmp-perl-identifier-p (s) + (string-match (concat "^" plcmp-perl-ident-re "$") s)) + +(defsubst plcmp-notfound-p (s) + (anything-aif (string-match "^Can't locate [^ \t]+ in" s) + (prog1 it + (plcmp-log "module notfound errmsg: %s" s)))) + +(defsubst plcmp-tramp-p () + (when (and (featurep 'tramp) + (fboundp 'tramp-tramp-file-p)) + (let* ((dir (plcmp-get-current-directory)) + (tramp? (tramp-tramp-file-p dir))) + (when tramp? + (prog1 tramp? + (plcmp-log "plcmp-tramp-p return non-nil: %s" dir)))))) + +(defsubst plcmp-insert-each-line (los) + (insert (mapconcat 'identity los "\n"))) + +(defun plcmp-get-current-directory () + (file-name-directory + (expand-file-name + (or (buffer-file-name) + default-directory)))) + +;; TODO: need test. +(defsubst plcmp--re-match-sources1 (regexps source) + (when source + (let ((source (if (listp source) source (symbol-value source)))) + (some (lambda (re) + (string-match re (assoc-default 'name source 'eq))) + regexps)))) + +(defun plcmp-re-sort-sources (regexps sources &optional reverse) + (condition-case e + (let* ((regexps (if (stringp regexps) (list regexps) regexps)) + (match-sources) + (unmatch-sources) + (sorted-sources + (loop for source in sources + if (plcmp--re-match-sources1 regexps source) + collect source into match-sources + else + collect source into unmatch-sources + finally return (if reverse + (nconc unmatch-sources match-sources) + (nconc match-sources unmatch-sources))))) + sorted-sources) + (error (plcmp-log "Error: plcmp-re-sort-sources\nregexps: %s\nsources: %s" + regexps + sources) + sources))) + +(defsubst* plcmp-collect-matches + (re &optional (count 0) (match-string-fn 'match-string) + (point-min (point-min)) (point-max (point-max))) + (save-excursion + (loop initially (goto-char point-min) + while (re-search-forward re point-max t) + collect (funcall match-string-fn count)))) + +(defun plcmp-get-occur-fn () + "return `occur-by-moccur if installed color-moccur.el otherwise return `occur" + (if (require 'color-moccur nil t) + 'occur-by-moccur + 'occur)) + + + +;;; initial-input +(defvar plcmp-initial-input "") +(defvar plcmp-real-initial-input "real initial-input if required `anything-match-plugin' initial-input is not real initial-input") + +(defun plcmp--fullname () + (save-excursion + (let ((start (point))) + (skip-chars-backward "a-zA-Z0-9_") + (let ((str (plcmp-preceding-string 2))) + (when (string-equal str "::") + (buffer-substring-no-properties start (point))))))) + + +(defun plcmp-get-initial-real-input-list () + "return list (initial-input real-initial-input)" + (save-excursion + (let* ((start (point)) + (real-initial-input + (cond + ((plcmp--fullname)) + (t + (skip-syntax-backward "w_") + (let* ((preceding-string (char-to-string (preceding-char))) + (end (condition-case e + (cond + ((some (lambda (s) (string-equal s preceding-string)) '("$" "@" "%" "&")) + (backward-char) + (point)) + (t + (point))) + (error (point))))) + (buffer-substring-no-properties start end))))) + (initial-input + (regexp-quote + (concat real-initial-input + (if (and (featurep 'anything-match-plugin) + (not (string-equal real-initial-input ""))) + " " + ""))))) + (prog1 (values initial-input real-initial-input) + (plcmp-log "plcmp-get-initial-real-input-list:\ninitial-input: %s\nreal-initial-input: %s" + initial-input + real-initial-input))))) + + +;;; installed modules +(defvar plcmp-installed-modules nil) +(add-to-list 'plcmp--cached-variables 'plcmp-installed-modules) + +(defun plcmp-get-installed-modules () + (unless (plcmp-tramp-p) + (or plcmp-installed-modules + (setq plcmp-installed-modules + (plcmp--installed-modules-synchronously))))) + +(defun plcmp--installed-modules-synchronously () + (message "fetching installed modules...") + (let* ((modules-str (shell-command-to-string + (concat + "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 " + ))) + (modules (split-string modules-str "\n"))) + (message "done") + (remove-if (lambda (module) + (string-match "No such file or directory$" module)) + modules))) + +(defvar plcmp-installed-modules-buffer-name " *perl-completion installed modules*") +(defun plcmp--installed-modules-set-cache (process event) + "process-sentinel" + (when (string-equal "finished\n" event) + (with-current-buffer plcmp-installed-modules-buffer-name + (unless (zerop (buffer-size)) + (setq plcmp-installed-modules (plcmp-collect-matches plcmp-perl-package-re)) + (message "finished getting installed modules asynchronously.") + (plcmp-log "cached installed modules %s" plcmp-installed-modules))))) + +(defun plcmp--installed-modules-asynchronously () + "start process, set sentinel, return process." + (unless (plcmp-tramp-p) + (message "fetching installed modules...") + (with-current-buffer (get-buffer-create plcmp-installed-modules-buffer-name) + (erase-buffer)) + (let* ((command "find") + (args (concat "`perl -e 'pop @INC; print join(q{ }, @INC);'`" + " -name '*.pm' -type f " + "| xargs grep -E -h -o 'package [a-zA-Z0-9:]+;' " + "| perl -nle 's/package\s+(.+);/$1/; print' " + "| sort " + "| uniq ")) + (proc (start-process-shell-command "installed perl modules" + plcmp-installed-modules-buffer-name + command + args))) + (set-process-sentinel proc 'plcmp--installed-modules-set-cache) + ;; return process + proc))) + + +;;; current package +(defvar plcmp-current-package-name "") +(defun plcmp-get-current-package-name () + "nil or string" + (let ((re (rx-to-string `(and bol + (* space) + "package" + (* space) + (group + (regexp ,plcmp-perl-package-re)) + (* not-newline) + ";")))) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward re nil t) + (match-string-no-properties 1))))) + +;;; using-modules +(defvar plcmp-using-modules nil) +(defun plcmp-get-using-modules () + "return modules" + (let* ((modules (plcmp--get-using-modules-uses-and-requires)) + (modules (plcmp--using-modules-marge-extra-modules modules)) + (modules (plcmp--using-modules-filter modules))) + modules)) + +(defun plcmp--get-using-modules-uses-and-requires () + "list of string" + (let ((re (rx-to-string ` (and bol + (* space) + "use" + (+ space) + (group ;1 package + (regexp ,plcmp-perl-package-re)) + (* not-newline) + ";"))) + (require-re (rx-to-string `(and "require" + (+ space) + (group + (regexp ,plcmp-perl-package-re)))))) + (nunion (plcmp-collect-matches re 1 'match-string-no-properties) + (delete-if-not (lambda (s) + (member s plcmp-installed-modules)) + (plcmp-collect-matches require-re 1 'match-string-no-properties)) + :test 'string-equal))) + +(defun plcmp--using-modules-marge-extra-modules (modules) + (condition-case err + (dolist (ext-module plcmp-extra-using-modules modules) + (cond + ((stringp ext-module) + (add-to-list 'modules ext-module)) + ((consp ext-module) ; alist ("module-name" . "extra-module-name") + (when (and (stringp (car ext-module)) + (stringp (cdr ext-module)) + (member (car ext-module) modules)) + (add-to-list 'modules (cdr ext-module)))))) + (error (prog1 modules + (plcmp-log "Error in plcmp-get-using-modules %s" + (error-message-string err)))))) + + + +(defun plcmp--using-modules-filter (modules) + (set-difference modules + plcmp-module-filter-list + :test 'string-equal)) + + +;;; methods +(defvar plcmp-obj-instance-of-module-maybe-alist nil) +(defun plcmp-get-obj-instance-of-module-maybe-alist (using-modules) + (let* ((using-module-re (regexp-opt using-modules)) + (re (rx-to-string `(and (group "$" ;1 var name + (regexp ,plcmp-perl-ident-re)) + (* space) + "=" + (* space) + (group ;2 module-name + (regexp ,using-module-re)))))) + (save-excursion + (loop initially (goto-char (point-min)) + while (re-search-forward re nil t) + collect `(,(match-string-no-properties 1) . ,(match-string-no-properties 2)))))) + +(defsubst plcmp--make-los (str) + (with-temp-buffer + (insert str) + (plcmp-collect-matches plcmp-perl-ident-re))) + +(defsubst plcmp--inspect-module-class-inspector (module-name) + "Class::Inspectorを使用してモジュールのメソッド調べる。 +モジュール名に使用でき-る文字以外が含まれていた場合はnilを返す +return alist (module-name . list of methods)" + (when (plcmp-module-p module-name) + (let ((modules-str + (shell-command-to-string + (concat "perl -MClass::Inspector -e'use " + module-name + "; print join \"\n\"=>@{Class::Inspector->methods(" + module-name + ")} '")))) + (when (and (not (plcmp-notfound-p modules-str)) + (stringp modules-str)) + (let ((modules (plcmp--make-los modules-str))) + `(,module-name . ,modules)))))) + +(defsubst plcmp-get-buffer-subs () + (plcmp-collect-matches plcmp-sub-re 1 'match-string-no-properties)) + +(defun plcmp-get-module-file-path (module-name) + (plcmp-with-set-perl5-lib + (let* ((path (shell-command-to-string (concat "perldoc -l " (shell-quote-argument module-name)))) + (path (plcmp-trim path))) + (and (stringp path) + (file-exists-p path) + (expand-file-name path))))) + +(defun plcmp--inspect-module-scrape (module-name) + (when (and (stringp module-name) + (plcmp-module-p module-name)) + (let* ((path (plcmp-get-module-file-path module-name))) + (when (and (stringp path) + (file-exists-p path) + (file-readable-p path)) + (let ((modules (with-temp-buffer + (insert-file-contents path) + (plcmp-get-buffer-subs)))) + `(,module-name . ,modules)))))) + +(defsubst plcmp--inspect-module (module-name) + (message "getting methods %s ..." module-name) + (funcall (plcmp--get-inspect-fn) module-name)) + + +(defun plcmp--get-inspect-fn () + (case plcmp-method-inspecter + (class-inspector 'plcmp--inspect-module-class-inspector) + (scrape 'plcmp--inspect-module-scrape) + (otherwise (lambda (module-name) + (or (plcmp--inspect-module-class-inspector module-name) + (plcmp--inspect-module-scrape module-name)))))) + +(defvar plcmp-module-methods-alist nil + "alist, (module-name . (list of methods))") +(add-to-list 'plcmp--cached-variables 'plcmp-module-methods-alist) + + +(defun plcmp-get-module-methods-alist (using-modules) + (dolist (module-name using-modules plcmp-module-methods-alist) + (unless (assoc module-name plcmp-module-methods-alist) + (add-to-list 'plcmp-module-methods-alist + (plcmp--inspect-module module-name))))) + + +;; module-name -> source +(defvar plcmp--mk-module-source-name " Methods") +(defsubst plcmp--mk-module-source (module-name) + (anything-aif (assoc-default module-name plcmp-module-methods-alist) + `((name . ,(concat module-name plcmp--mk-module-source-name)) + (action . (("Insert" . plcmp-insert) + ("Show doc" . + (lambda (candidate) + (let* ((module (plcmp-get-current-module-name)) + (buf (plcmp-get-man-buffer module 'module))) + (save-selected-window + (pop-to-buffer buf))))) + ("Show doc and go" . + (lambda (candidate) + (let* ((module (plcmp-get-current-module-name)) + (buf (plcmp-get-man-buffer module 'module))) + (pop-to-buffer buf)))) + ("Open module file" . + (lambda (method) + (let ((module (plcmp-get-current-module-name))) + (plcmp-open-module-file module)))) + ("Open module file other window" . + (lambda (method) + (let ((module-name (plcmp-get-current-module-name))) + (plcmp-open-module-file module-name 'pop-to-buffer)))) + ("Open module file other frame" . + (lambda (candidate) + (let ((module-name (plcmp-get-current-module-name))) + (plcmp-open-module-file module-name + 'switch-to-buffer-other-frame)))) + ("Occur module file" . + (lambda (candidate) + (let ((module-name (plcmp-get-current-module-name))) + (plcmp-open-module-file module-name + 'switch-to-buffer) + (funcall (plcmp-get-occur-fn) + candidate + nil)))) + ("Add to kill-ring" . kill-new) + ("Insert source name" . + (lambda (candidate) + (let ((name (plcmp-anything-get-current-source-name))) + (and (stringp name) + (insert name))))) + )) + (init . (lambda () + (with-current-buffer (anything-candidate-buffer 'global) + (plcmp-insert-each-line ',it)))) + (candidates-in-buffer) + (persistent-action . (lambda (candidate) + (let ((module-name (plcmp-get-current-module-name))) + (plcmp-open-doc module-name) + (plcmp-re-search-forward-fontify (regexp-quote candidate))))) + ))) + + +;; plcmp-using-modules -> sources +(defun plcmp-get-sources-methods (using-modules) + (loop for module-name in using-modules + collect (plcmp--mk-module-source module-name))) + + +;;; dabbrev +(defvar plcmp-buffer-dabbrevs-re + (rx (>= 4 (or (syntax word) + (syntax symbol))))) + +(defsubst* plcmp-get-buffer-dabbrevs () + (plcmp-collect-matches plcmp-buffer-dabbrevs-re 0 'match-string-no-properties)) + +;;; current buffer words +(defsubst* plcmp--check-face (face-names &optional (point (point))) + (let* ((face (get-text-property point 'face)) + (faces (if (listp face) face (list face)))) + (some (lambda (face-sym) + (memq face-sym faces)) + face-names))) + +(defsubst* plcmp-get-face-words (&optional (faces '(font-lock-variable-name-face + font-lock-function-name-face))) + (let ((hash (make-hash-table :test 'equal)) + (ret nil)) + (save-excursion + (loop initially (goto-char (point-min)) + for next-change = (or (next-property-change (point) (current-buffer)) + (point-max)) + until (eobp) + do (progn (when (plcmp--check-face faces) + (anything-aif (cperl-word-at-point) + (puthash it nil hash))) + (goto-char next-change))) + (maphash (lambda (k v) (push k ret)) hash) ; remove-dups + (nreverse ret)))) + +;;; other buffer words + +(defvar plcmp-other-perl-buffers-words-faces + '(font-lock-function-name-face + font-lock-variable-name-face + font-lock-keyword-face + font-lock-builtin-face + font-lock-type-face + cperl-array-face + cperl-hash-face)) + +;; cache +(defvar plcmp-buffer-tick-hash (make-hash-table :test 'equal)) +(defun* plcmp-buffer-is-modified (&optional (buffer (current-buffer))) + "Return non-nil when BUFFER is modified since `anything' was invoked." + (let* ((key (concat (buffer-name buffer) + "/" + (anything-attr 'name))) + (source-tick (or (gethash key plcmp-buffer-tick-hash) 0)) + (buffer-tick (buffer-chars-modified-tick buffer))) + (prog1 (/= source-tick buffer-tick) + (puthash key buffer-tick plcmp-buffer-tick-hash) + (plcmp-log "plcmp-buffer-is-modified") + (plcmp-log "current-buffer: %s" buffer) + (plcmp-log "source-tick: %s\nbuffer-tick: %s" source-tick buffer-tick)))) + + +(defvar plcmp-other-perl-buffers-cache-hash (make-hash-table :test 'equal)) +(add-hook 'plcmp-clear-all-caches-hook + (lambda () + (setq plcmp-other-perl-buffers-cache-hash + (make-hash-table :test 'equal)))) + +(defun plcmp-add-to-other-perl-buffers-cache-hash (source-name faces buffer-name) + (let ((hash (or (gethash source-name plcmp-other-perl-buffers-cache-hash) + (puthash source-name + (make-hash-table :test 'equal) + plcmp-other-perl-buffers-cache-hash))) + (words (plcmp-get-face-words faces))) + (assert (hash-table-p hash)) + (puthash buffer-name words hash) + (prog1 words + (plcmp-log "\nplcmp-add-to-other-perl-buffers-cache-hash: %s" + words)))) + +(defun plcmp-get-other-perl-buffers-cache (source-name buffer-name) + "return los or nil if not cache ready" + (let ((hash (gethash source-name plcmp-other-perl-buffers-cache-hash))) + (and (hash-table-p hash) + (prog1 (gethash buffer-name hash) + (plcmp-log "plcmp-get-other-perl-buffers-cache: %s" + (gethash buffer-name hash)))))) + +(defun plcmp-other-perl-buffers-get-buffer-name () + "return buffer or nil" + (let ((source-name (anything-attr 'name))) + (when (string-match (rx " *" (group (* not-newline)) "*" eol) + source-name) + (let ((buffer-name (match-string 1 source-name))) + (when (stringp buffer-name) + (let ((buffer (get-buffer buffer-name))) + (and (bufferp buffer) + buffer))))))) + +(defun plcmp-other-perl-buffers-action-open-related-buffer (candidate) + (let ((buffer (plcmp-other-perl-buffers-get-buffer-name))) + (switch-to-buffer buffer))) + +(defun plcmp-other-perl-buffers-action-occur (candidate) + (let ((buffer (plcmp-other-perl-buffers-get-buffer-name))) + (switch-to-buffer buffer) + (funcall (plcmp-get-occur-fn) + (regexp-quote candidate) + nil))) + +(defun plcmp--mk-other-perl-buffer-source (source-name faces buffer-name) + `((name + . ,(concat source-name " *" buffer-name "*")) + (action + . (("Insert" . plcmp-insert) + ("Open related buffer" . plcmp-other-perl-buffers-action-open-related-buffer) + ("Occur" . plcmp-other-perl-buffers-action-occur))) + (init + . (lambda () + (let ((words + (with-current-buffer (get-buffer ,buffer-name) + (anything-aif (and (not (plcmp-buffer-is-modified)) + (plcmp-get-other-perl-buffers-cache ,source-name ,buffer-name)) + (prog1 it + (plcmp-log "return cache buffer: %s source-name: %s " ,buffer-name ,source-name)) + (prog1 (plcmp-add-to-other-perl-buffers-cache-hash ,source-name ',faces ,buffer-name) + (plcmp-log "modified: %s" ,buffer-name)))))) + (with-current-buffer (anything-candidate-buffer 'global) + (plcmp-insert-each-line words))))) + (candidates-in-buffer) + (persistent-action + . (lambda (candidate) + (let ((buffer (plcmp-other-perl-buffers-get-buffer-name))) + (when (bufferp buffer) + (switch-to-buffer buffer) + (plcmp-re-search-forward-fontify (regexp-quote candidate)))))))) + +(defun plcmp--sources-other-perl-buffers (source-name faces) + (let* ((perl-buffers (remove-if-not (lambda (buf) + (string-match plcmp-perl-buffer-re (buffer-name buf))) + (buffer-list))) + (perl-buffers (subseq perl-buffers 0 plcmp-other-perl-buffer-limit-number)) + (sources (loop for buffer in perl-buffers + when (bufferp buffer) + collect (with-current-buffer buffer + (plcmp--mk-other-perl-buffer-source + source-name + faces + (buffer-name buffer)))))) + (prog1 sources + (plcmp-log "plcmp--sources-other-perl-buffers:") + (plcmp-log sources)))) + +(defun plcmp-get-sources-other-perl-buffers-words () + (plcmp--sources-other-perl-buffers "words" plcmp-other-perl-buffers-words-faces)) + +(defun plcmp-get-sources-other-perl-buffers-variable () + (plcmp--sources-other-perl-buffers "variables" '(font-lock-variable-name-face))) + +(defun plcmp-get-sources-other-perl-buffers-hashes () + (plcmp--sources-other-perl-buffers "hashes" '(cperl-hash-face))) + +(defun plcmp-get-sources-other-perl-buffers-arrays () + (plcmp--sources-other-perl-buffers "arrays" '(cperl-array-face))) + +(defun plcmp-get-sources-other-perl-buffers-functions () + (plcmp--sources-other-perl-buffers "functions" '(font-lock-function-name-face))) + +;;; man +(defvar plcmp-man-pages + (ignore-errors + (let ((pages (progn + (require 'woman) + (woman-file-name "") + (mapcar 'car woman-topic-all-completions)))) + (remove-if-not (lambda (s) + (or (member s plcmp-installed-modules) + (string-match "perl" s))) + pages)))) + + +;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +;;;; Document +;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +(defvar plcmp-look-overlay nil "overlay") +(add-hook 'plcmp--command-cleanup-hook + (lambda () + (when (overlayp plcmp-look-overlay) + (delete-overlay plcmp-look-overlay)))) + +(defvar plcmp-look-current-positions nil + "list of (point buffer) +point, after `plcmp-re-search-forward-fontify'") +(add-hook 'plcmp--command-cleanup-hook + (lambda () + (setq plcmp-look-current-positions nil))) + +(defun plcmp-re-search-forward-fontify (regexp) + (if (re-search-forward regexp nil t) + (let ((beg (match-beginning 0)) + (end (match-end 0))) + ;; remember positions + (setq plcmp-look-current-positions (list (point) (current-buffer))) + (plcmp-log "plcmp-look-current-positions: %s" (list (point) (current-buffer))) + (when (and beg end) + (if (overlayp plcmp-look-overlay) + (move-overlay plcmp-look-overlay beg end (current-buffer)) + (setq plcmp-look-overlay (make-overlay beg end))) + (overlay-put plcmp-look-overlay 'face 'highlight) + (recenter 5))) + (goto-char (point-min)))) + + +;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +;;;; Initialize, Cleanup +;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +(defun plcmp-initialize-variables () + (setq plcmp-installed-modules (plcmp-get-installed-modules) + plcmp-current-package-name (plcmp-get-current-package-name) + plcmp-using-modules (plcmp-get-using-modules) + plcmp-module-methods-alist (plcmp-get-module-methods-alist plcmp-using-modules) + plcmp-obj-instance-of-module-maybe-alist (plcmp-get-obj-instance-of-module-maybe-alist plcmp-using-modules)) + (multiple-value-setq + (plcmp-initial-input plcmp-real-initial-input) (plcmp-get-initial-real-input-list))) + +(defun plcmp-cleanup () + (run-hooks 'plcmp--command-cleanup-hook)) + +;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +;;;; Anything +;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +(defun plcmp--anything-get-current-source-name () + "Return the source name for the current selection." + (declare (special source)) + ;; The name `anything-get-current-source' should be used in init function etc. + (if (and (boundp 'anything-source-name) (stringp anything-source-name)) + anything-source-name + (with-current-buffer (anything-buffer-get) + ;; This goto-char shouldn't be necessary, but point is moved to + ;; point-min somewhere else which shouldn't happen. + (goto-char (overlay-start anything-selection-overlay)) + (let* ((header-pos (anything-get-previous-header-pos))) + (save-excursion + (assert header-pos) + (goto-char header-pos) + (prog1 (buffer-substring-no-properties + (line-beginning-position) (line-end-position)) + (plcmp-log "plcmp-anything-get-current-source-name: %s" + (buffer-substring-no-properties + (line-beginning-position) (line-end-position))))))))) + +(defun plcmp-get-current-module-name () + (let* ((module (plcmp--anything-get-current-source-name))) + (when (string-match + (rx-to-string `(and + bol + (group + (regexp ,plcmp-perl-package-re)) + ,plcmp--mk-module-source-name)) + module) + (match-string 1 module)))) + +;;;TODO +(defun plcmp-completion-get-man-buffer (candidate) + "return manpage buffer ,called in completion source action" + (let* ((name (plcmp--anything-get-current-source-name)) + (ret (cond + ((string-equal name "builtin functions") + (plcmp-get-man-buffer candidate 'function)) + ((or (string-equal name "using modules") + (string-equal name "installed modules")) + (plcmp-get-man-buffer candidate)) + ((string-equal name "builtin variables") + (plcmp-get-man-buffer "" 'variables)) + ((string-match (concat plcmp--mk-module-source-name "$") + name) + (plcmp-get-current-module-name))))) + (prog1 ret + (plcmp-log "plcmp-completion-get-man-buffer candidate: %s return: %s" + candidate + ret)))) + + +(defvar plcmp-type-completion + '(plcmp-completion + (action . (("Insert" . plcmp-insert) + ("Show man" . + (lambda (candidate) + (anything-aif (plcmp-completion-get-man-buffer candidate) + (switch-to-buffer it)))) + ("Add to kill-ring" . kill-new) + ("Insert source name" . + (lambda (candidate) + (let ((name (plcmp-anything-get-current-source-name))) + (and (stringp name) + (insert name))))) + )))) +(add-to-list 'anything-type-attributes plcmp-type-completion) + +(defvar plcmp-type-completion-method + '(plcmp-completion-method + (action . (("Insert" . plcmp-insert) + ("Open module file" . + (lambda (method) + (let ((module (plcmp-get-current-module-name))) + (plcmp-open-module-file module)))) + ("Open module file other window" . + (lambda (method) + (let ((module-name (plcmp-get-current-module-name))) + (plcmp-open-module-file module-name 'pop-to-buffer)))) + ("Open module file other frame" . + (lambda (candidate) + (let ((module-name (plcmp-get-current-module-name))) + (plcmp-open-module-file module-name + 'switch-to-buffer-other-frame)))) + ("Add to kill-ring" . kill-new) + ("Insert source name" . + (lambda (candidate) + (let ((name (plcmp-anything-get-current-source-name))) + (and (stringp name) + (insert name))))) + )))) +(add-to-list 'anything-type-attributes plcmp-type-completion-method) + +(defvar plcmp-type-man + '(plcmp-doc + (action . (("Show man" . + (lambda (candidate) + (plcmp-open-doc candidate 'man))) + ("Show man other window" . + (lambda (candidate) + (plcmp-open-doc candidate 'man 'pop-to-buffer))) + ("Show man other window and go" . + (lambda (candidate) + (plcmp-open-doc candidate 'man 'switch-to-buffer-other-window))) + ("Show man other frame and go" . + (lambda (candidate) + (plcmp-open-doc candidate 'man 'switch-to-buffer-other-frame))) + ("Occur man buffer" . + (lambda (candidate) + (when (plcmp-open-doc candidate 'man) + (call-interactively (plcmp-get-occur-fn) + (regexp-quote candidate))))) + ("Insert man name" . insert) + ("Add man name to kill-ring" . kill-new))))) + +(defvar plcmp-type-perldoc + '(plcmp-perldoc + (action . ()))) +(add-to-list 'anything-type-attributes plcmp-type-man) + +(defun plcmp-insert (candidate) + (delete-backward-char (length plcmp-real-initial-input)) + (insert candidate)) + +;;; perldoc +(defun* plcmp-get-man-buffer (topic &optional (type 'module)) + "like `Man-getpage-in-background' but call process synchronously. +return buffer or nil unless process return 0" + (require 'man) + (let* ((manual-program (ecase type + (module "perldoc") + (man manual-program) + (function "perldoc -f") + (variable "perldoc perlvar"))) + (command (if (eq type 'variable) + manual-program + (concat manual-program " " topic))) + (bufname (concat "*perldoc " topic "*")) + (buffer (get-buffer-create bufname))) + (require 'env) + (let ((process-environment (copy-sequence process-environment)) + ;; The following is so Awk script gets \n intact + ;; But don't prevent decoding of the outside. + (coding-system-for-write 'raw-text-unix) + ;; We must decode the output by a coding system that the + ;; system's locale suggests in multibyte mode. + (coding-system-for-read + (if default-enable-multibyte-characters + locale-coding-system 'raw-text-unix)) + ;; Avoid possible error by using a directory that always exists. + (default-directory + (if (and (file-directory-p default-directory) + (not (find-file-name-handler default-directory + 'file-directory-p))) + default-directory + "/"))) + ;; Prevent any attempt to use display terminal fanciness. + (setenv "TERM" "dumb") + (save-window-excursion (shell-command command bufname)) + (get-buffer bufname)))) + +(defun* plcmp-open-doc (topic &optional (type 'module) (show-fn 'switch-to-buffer)) + (require 'man) + (let ((manbuf (plcmp-get-man-buffer topic type))) + (when (and (bufferp manbuf) + (functionp show-fn)) + (funcall show-fn manbuf)))) + + +;;; open module file +(defun plcmp--find-module-file-no-select (module-name) + (when (plcmp-module-p module-name) + (let ((path (plcmp-get-module-file-path module-name))) + (when (and (stringp path) + (file-exists-p path) + (file-readable-p path)) + (find-file-noselect path))))) + +(defun* plcmp-open-module-file (module-name &optional (show-buffer-fn 'switch-to-buffer)) + (anything-aif (plcmp--find-module-file-no-select module-name) + (funcall show-buffer-fn it) + (message "can't find %s" module-name))) + +;;; sources +;; completion +(defvar plcmp-anything-source-completion-using-modules + `((name . "using modules") + (action . (("Insert" . plcmp-insert) + ("Show doc" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'module))) + (save-selected-window + (pop-to-buffer buf))))) + ("Show doc and go" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'module))) + (pop-to-buffer buf)))) + ("Occur" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'module))) + (switch-to-buffer buf) + (call-interactively (plcmp-get-occur-fn))))) + ("Open module file" . + (lambda (candidate) + (plcmp-open-module-file candidate))) + ("Open module file other window" . + (lambda (candidate) + (plcmp-open-module-file candidate 'pop-to-buffer))) + ("Open module file other frame" . + (lambda (candidate) + (plcmp-open-module-file candidate + 'switch-to-buffer-other-frame))) + ("Add to kill-ring" . kill-new))) + (init . (lambda () + (with-current-buffer (anything-candidate-buffer 'global) + (when plcmp-using-modules + (plcmp-insert-each-line plcmp-using-modules))))) + (candidates-in-buffer) + (persistent-action . (lambda (candidate) + (plcmp-open-doc candidate) + (plcmp-re-search-forward-fontify (regexp-quote candidate)))) + )) + +(defvar plcmp-anything-source-completion-builtin-functions + `((name . "builtin functions") + (action . (("Insert" . plcmp-insert) + ("Show doc" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'function))) + (save-selected-window + (pop-to-buffer buf))))) + ("Show doc and go" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'function))) + (switch-to-buffer-other-window buf)))) + ("Occur" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'function))) + (switch-to-buffer buf) + (funcall (plcmp-get-occur-fn) + (regexp-quote candidate) + nil)))) + ("Add to kill-ring" . kill-new))) + (init . (lambda () + (with-current-buffer (anything-candidate-buffer 'global) + (plcmp-insert-each-line plcmp-builtin-functions)))) + (candidates-in-buffer) + (persistent-action . (lambda (candidate) + (plcmp-open-doc candidate 'function) + (plcmp-re-search-forward-fontify (regexp-quote candidate)))) + )) + +(defvar plcmp-anything-source-completion-builtin-variables + `((name . "builtin variables") + (action . (("Insert" . plcmp-insert) + ("Show doc" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'variable)) + (re (rx-to-string `(and bol (= 4 space) + (group (eval ,candidate)) + (syntax whitespace))))) + (with-current-buffer buf + (re-search-forward re nil t)) + (save-selected-window + (pop-to-buffer buf))))) + ("Show doc and go" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'variable)) + (re (rx-to-string `(and bol (= 4 space) + (group (eval ,candidate)) + (syntax whitespace))))) + (switch-to-buffer-other-window buf) + (re-search-forward re nil t)))) + ("Occur" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'variable))) + (switch-to-buffer buf) + (funcall (plcmp-get-occur-fn) + (regexp-quote candidate) + nil)))) + ("Add to kill-ring" . kill-new))) + (init . (lambda () + (with-current-buffer (anything-candidate-buffer 'global) + (plcmp-insert-each-line plcmp-builtin-variables)))) + (candidates-in-buffer) + (search . ((lambda (re arg1 arg2) + (re-search-forward (regexp-quote re) nil t)))) + (persistent-action . (lambda (candidate) + (plcmp-open-doc candidate 'variable) + (plcmp-re-search-forward-fontify (regexp-quote candidate)))) + )) + +(defvar plcmp-anything-source-completion-installed-modules + `((name . "installed modules") + (action . (("Insert" . plcmp-insert) + ("Show doc" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'module))) + (save-selected-window + (pop-to-buffer buf))))) + ("Show doc and go" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'module))) + (pop-to-buffer buf)))) + ("Occur" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'module))) + (switch-to-buffer buf) + (call-interactively (plcmp-get-occur-fn))))) + ("Open module file" . + (lambda (candidate) + (plcmp-open-module-file candidate))) + ("Open module file other window" . + (lambda (candidate) + (plcmp-open-module-file candidate 'pop-to-buffer))) + ("Open module file other frame" . + (lambda (candidate) + (plcmp-open-module-file candidate + 'switch-to-buffer-other-frame))) + ("Add to kill-ring" . kill-new))) + (init . (lambda () + (with-current-buffer (anything-candidate-buffer 'global) + (let ((installed-modules (plcmp-get-installed-modules))) + (when installed-modules + (plcmp-insert-each-line installed-modules)))))) + (candidates-in-buffer) + (persistent-action . (lambda (candidate) + (plcmp-open-doc candidate) + (plcmp-re-search-forward-fontify (regexp-quote candidate)))) + )) + +(defvar plcmp-anything-source-completion-buffer-dabbrevs + `((name . "buffer dabbrevs") + (action . (("Insert" . plcmp-insert) + ("Occur" . + (lambda (candidate) + (funcall (plcmp-get-occur-fn) + (regexp-quote candidate) + nil))) + ("Add to kill-ring" . kill-new))) + (init . (lambda () + (let* ((words (plcmp-get-buffer-dabbrevs)) + (words (delete plcmp-real-initial-input words))) + (with-current-buffer (anything-candidate-buffer 'global) + (plcmp-insert-each-line words))))) + (candidates-in-buffer) + (persistent-action . (lambda (candidate) + (switch-to-buffer anything-current-buffer) + (plcmp-re-search-forward-fontify (regexp-quote candidate)))) + )) + + +;; man, perldoc +(defvar plcmp-anything-source-doc-man-pages + '((name . "perl man pages") + (action . (("Show man" . woman))) + (init . (lambda () + (with-current-buffer (anything-candidate-buffer 'global) + (plcmp-insert-each-line plcmp-man-pages)))) + (candidates-in-buffer) + (persistent-action . (lambda (candidate) + (woman candidate) + (plcmp-re-search-forward-fontify (regexp-quote candidate)))) + )) + +(defvar plcmp-anything-source-doc-using-modules + '((name . "using modules") + (action . (("Show doc" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'module))) + (save-selected-window + (pop-to-buffer buf))))) + ("Show doc and go" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'module))) + (switch-to-buffer buf)))) + ("Occur doc buffer" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'module))) + (switch-to-buffer buf) + (call-interactively (plcmp-get-occur-fn) + (regexp-quote candidate))))) + ("Open module file" . + (lambda (candidate) + (plcmp-open-module-file candidate))) + ("Open module file other window" . + (lambda (candidate) + (plcmp-open-module-file candidate 'pop-to-buffer))) + ("Open module file other frame" . + (lambda (candidate) + (plcmp-open-module-file candidate + 'switch-to-buffer-other-frame))) + ("Add to kill-ring" . kill-new))) + (init . (lambda () + (with-current-buffer (anything-candidate-buffer 'global) + (plcmp-insert-each-line plcmp-using-modules)))) + (candidates-in-buffer) + (persistent-action . (lambda (candidate) + (plcmp-open-doc candidate) + (plcmp-re-search-forward-fontify (regexp-quote candidate)))) + )) + +(defvar plcmp-anything-source-doc-installed-modules + '((name . "installed modules") + (action . (("Show doc" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'module))) + (save-selected-window + (pop-to-buffer buf))))) + ("Show doc and go" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'module))) + (switch-to-buffer buf)))) + ("Occur doc buffer" . + (lambda (candidate) + (let ((buf (plcmp-get-man-buffer candidate 'module))) + (switch-to-buffer buf) + (call-interactively (plcmp-get-occur-fn))))) + ("Open module file" . + (lambda (candidate) + (plcmp-open-module-file candidate))) + ("Open module file other window" . + (lambda (candidate) + (plcmp-open-module-file candidate 'pop-to-buffer))) + ("Open module file other frame" . + (lambda (candidate) + (plcmp-open-module-file candidate + 'switch-to-buffer-other-frame))) + ("Add to kill-ring" . kill-new))) + (init . (lambda () + (with-current-buffer (anything-candidate-buffer 'global) + (plcmp-insert-each-line plcmp-installed-modules)))) + (candidates-in-buffer) + (persistent-action . (lambda (candidate) + (plcmp-open-doc candidate) + (plcmp-re-search-forward-fontify (regexp-quote candidate)))) + )) + + +;; menu +(defun plcmp-menu-cands () + (with-temp-buffer + (let ((re (rx bol + (group (+ not-newline)) + (group "plcmp-cmd-" + (+ not-newline) + eol)))) + (insert (substitute-command-keys (format "\\{%s}" "plcmp-mode-map"))) + (loop initially (goto-char (point-min)) + while (re-search-forward re nil t) + collect (let* ((key (plcmp-trim (match-string 1))) + (command (plcmp-trim (match-string 2))) + (display (concat "[" key "] " command)) + (real command)) + `(,display . ,real)))))) + +(defvar plcmp-anything-source-menu + `((name . "perl-completion menu") + (action ("Call interactively" . (lambda (command-name) + (call-interactively (intern command-name)))) + ("Add command to kill ring" . kill-new) + ("Go to command's definition" . (lambda (command-name) + (find-function + (intern command-name))))) + (candidates . plcmp-menu-cands) + )) + + +;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +;;;; Commands +;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +;; prefix: plcmp-cmd- + +;;; complete-all +(defvar plcmp-completion-all-static-sources + '( + plcmp-anything-source-completion-buffer-dabbrevs + plcmp-anything-source-completion-builtin-variables + plcmp-anything-source-completion-builtin-functions + plcmp-anything-source-completion-using-modules + plcmp-anything-source-completion-installed-modules + )) + +(defun plcmp-get-sources-for-complete-all () + (append + (plcmp-get-sources-methods plcmp-using-modules) + (plcmp-get-sources-other-perl-buffers-variable) + (plcmp-get-sources-other-perl-buffers-hashes) + (plcmp-get-sources-other-perl-buffers-arrays) + (plcmp-get-sources-other-perl-buffers-functions) + plcmp-completion-all-static-sources)) + +(define-plcmp-command complete-all () + (anything (plcmp-get-sources-for-complete-all) plcmp-initial-input)) + + +;;; smart-complete + +(defvar plcmp-completion-smart-complete-static-sources + '( + plcmp-anything-source-completion-buffer-dabbrevs + plcmp-anything-source-completion-builtin-variables + plcmp-anything-source-completion-builtin-functions + plcmp-anything-source-completion-using-modules + plcmp-anything-source-completion-installed-modules + )) + +(defun plcmp--sources-for-smart-complete () + (append + (plcmp-get-sources-methods plcmp-using-modules) + (plcmp-get-sources-other-perl-buffers-words) + plcmp-completion-smart-complete-static-sources)) + +(defsubst* plcmp-preceding-string (&optional (count 1)) + "現在の位置からcount文字前方位置までの文字列を返す +例外を出さない" + (buffer-substring-no-properties + (point) + (condition-case nil + (save-excursion (backward-char count) (point)) + (error (point))))) + +(defsubst plcmp-method-p () + (string-equal "->" (plcmp-preceding-string 2))) + +(defun plcmp--get-context-symbol () + "return list (context-symbol module-name-string) or list (context-symbol) if not module context. +context-symbol is one of the following values: +self +method +variable +array +hash +function +installed-module +otherwise +" + (ignore-errors + (save-excursion + (let* ((start (point)) + (start-input (progn (skip-syntax-backward "w_") ;move point + (buffer-substring-no-properties (point) start))) + (obj-str (buffer-substring-no-properties ;string + (or (ignore-errors (save-excursion (forward-char -2) (point))) + (point)) + (save-excursion (or (ignore-errors (backward-sexp) + (point)) + (point))))) + (context-sym-str-list + (cond + ;; fullname + ;; File::Copy::`!!' + ((save-excursion + (goto-char start) + (skip-chars-backward "a-zA-Z0-9_") + (let ((str (plcmp-preceding-string 2))) + (when (string-equal str "::") + (backward-char 2) + (let* ((start (point)) + (end (progn (skip-syntax-backward "w_") + (point))) + (obj-str (buffer-substring-no-properties + start + end))) + (values 'method obj-str)))))) + ;; package + ;; $self->`!!' + ;; __PACKAGE__->`!!' + ((and (plcmp-method-p) + (string-match (rx bol + (or "$self" + "__PACKAGE__") + eol) + obj-str)) + (list 'package)) + ;; method + ;; Foo->`!!' + ((and (plcmp-method-p) + (stringp obj-str)) + (list 'method obj-str)) + ;; variable + ;; $foo`!!' + ((string-equal "$" (plcmp-preceding-string 1)) + (list 'variable)) + ;; array + ((string-equal "@" (plcmp-preceding-string 1)) + (list 'array)) + ;; hash + ((string-equal "%" (plcmp-preceding-string 1)) + (list 'array)) + ;; function + ((string-equal "&" (plcmp-preceding-string 1)) + (list 'function)) + ;; installed-module + ;; use `!!' + ((string-match (rx bol (* space) "use" (+ space)) + (buffer-substring (point-at-bol) (point))) + (list 'installed-module)) + (t + (list 'otherwise))))) + (prog1 context-sym-str-list + (plcmp-log "plcmp--get-context-symbol: %s" context-sym-str-list)))))) + +;; TODO +(defun plcmp-get-sources-for-smart-complete () + "return sources" + (let* ((context-sym-str-list (plcmp--get-context-symbol)) + (ctx-sym (first context-sym-str-list)) + (module-name (second context-sym-str-list))) + (let ((all-sources (plcmp--sources-for-smart-complete))) + (case ctx-sym + (method (let ((sources (plcmp-re-sort-sources "method" + all-sources))) + (if (stringp module-name) + (let ((obj (assoc-default module-name plcmp-obj-instance-of-module-maybe-alist))) + (if (and obj + (stringp obj)) + (plcmp-re-sort-sources obj sources) + (plcmp-re-sort-sources module-name sources))) + sources))) + (variable (plcmp-re-sort-sources "variable" + all-sources)) + (array (plcmp-re-sort-sources "array" + all-sources)) + (hash (plcmp-re-sort-sources "hash" + all-sources)) + (function (plcmp-re-sort-sources "function" + all-sources)) + (installed-module (plcmp-re-sort-sources "installed modules" + all-sources)) + (otherwise (let* ((sources (plcmp-re-sort-sources "method" + all-sources + t)) + (sources (plcmp-re-sort-sources "dabbrev" + sources))) + sources)))))) + +(define-plcmp-command smart-complete () + (plcmp-log "smart-complete called line: %s`!!'" + (buffer-substring (point-at-bol) (point))) + (anything (plcmp-get-sources-for-smart-complete) plcmp-initial-input)) + + +;;; complete-variables +(defvar plcmp-completion-variable-static-sources + '( + plcmp-anything-source-completion-builtin-variables + )) + +(defun plcmp-get-sources-for-complete-variables () + (append + (plcmp-get-sources-other-perl-buffers-variable) + plcmp-completion-variable-static-sources + )) + +(define-plcmp-command complete-variables () + (anything (plcmp-get-sources-for-complete-variables) plcmp-initial-input)) + +;;; complete-arrays +(define-plcmp-command complete-arrays () + (anything (plcmp-get-sources-other-perl-buffers-arrays) plcmp-initial-input)) + +;;; complete-hashes +(define-plcmp-command complete-hashes () + (anything (plcmp-get-sources-other-perl-buffers-hashes) plcmp-initial-input)) + +;;; complete-functions +(defun plcmp-get-sources-for-complete-functions () + (append + (list plcmp-anything-source-completion-builtin-functions) + (plcmp-get-sources-other-perl-buffers-functions) + (plcmp-get-sources-methods plcmp-using-modules))) + +(define-plcmp-command complete-functions () + (anything (plcmp-get-sources-for-complete-functions) plcmp-initial-input)) + +;;; complete-methods +(define-plcmp-command complete-methods () + (anything (plcmp-get-sources-methods plcmp-using-modules) plcmp-initial-input)) + +;;; complete-modules +(define-plcmp-command complete-modules () + (anything '(plcmp-anything-source-completion-using-modules + plcmp-anything-source-completion-installed-modules) + plcmp-initial-input)) + + +;;; document +(defvar plcmp-show-doc-sources + '( + plcmp-anything-source-doc-using-modules + plcmp-anything-source-doc-man-pages + plcmp-anything-source-doc-installed-modules + )) +(define-plcmp-command show-doc () + (anything plcmp-show-doc-sources)) + +(define-plcmp-command show-doc-at-point () + (anything plcmp-show-doc-sources (or (thing-at-point 'symbol) ""))) +;;; other commands +(defun plcmp-cmd-menu () + (interactive) + (anything '(plcmp-anything-source-menu))) + +(defun plcmp-cmd-clear-all-caches () + (interactive) + (dolist (variable plcmp--cached-variables) + (set variable nil)) + (run-hooks 'plcmp-clear-all-caches-hook) + (or plcmp-installed-modules + (plcmp-with-set-perl5-lib + (plcmp--installed-modules-asynchronously))) + (message "cleared all caches and getting installed modules asynchronously")) + +;; TODO +(defun plcmp-cmd-show-environment () + (interactive) + (require 'custom) + (let* ((decode-fn (lambda (s) + (if enable-multibyte-characters + (decode-coding-string s locale-coding-system t) + s))) + (buf (get-buffer-create "*perl-completion show environment*")) + (customs) + (commands) + (plcmp-symbols (loop for sym being the symbols + for s = (symbol-name sym) + when (and (string-match "^plcmp-" s) + (custom-variable-p sym)) + collect s into custom-syms + when (string-match (concat "^" "plcmp-cmd-") s) + collect s into command-syms + finally do (setq customs custom-syms + commands command-syms))) + (perl5-lib (format "this buffer's PERL5LIB: %s\n\n" + (plcmp-with-set-perl5-lib + (require 'env) + (or (getenv "PERL5LIB") "")))) + (additional-lib-directories (format "plcmp-additional-lib-directories: %S\n" + plcmp--PERL5LIB-directories))) + (with-current-buffer buf + (erase-buffer) + ;; set perl5lib + (insert additional-lib-directories) + (insert perl5-lib) + ;; customize-variables + (insert "customize-variables:\n\n") + (plcmp-insert-each-line customs) + (insert "\n\n") + ;; commands + (insert "commands:\n\n") + (plcmp-insert-each-line commands) + (insert "\n\n") + ;; process-environment + (insert "process-environment:\n\n") + (loop for env in process-environment + do (progn (insert (funcall decode-fn (or env ""))) + (insert "\n"))) + (goto-char (point-min)) + (switch-to-buffer buf)))) + +(defun plcmp-cmd-update-check () + (interactive) + (when (require 'url nil t) + (let* ((uri "http://svn.coderepos.org/share/lang/elisp/perl-completion/trunk/perl-completion.el") + (buf (url-retrieve-synchronously uri)) + (re (rx "plcmp-version " (group (+ (or (any digit) ".")))))) + (with-current-buffer buf + (goto-char (point-min)) + (let ((trunk-version (prog1 (when (re-search-forward re nil t) + (string-to-number (match-string-no-properties 1))) + (kill-buffer buf)))) + (if (< plcmp-version trunk-version) + (when (y-or-n-p "new version available. Open URL in the default browser? ") + (browse-url uri)) + (message "%s is currently the newest version" plcmp-version))))))) + + +;; set-perl5lib +(defun plcmp-cmd-set-additional-lib-directory () + "ask directory, then set directory to `plcmp--PERL5LIB-directories'" + (interactive) + (let* ((dir (read-directory-name "set to PERL5LIB(this buffer only): " nil nil t)) + (dir (expand-file-name dir)) + (dir (directory-file-name dir))) + (when (and (stringp dir) + (file-exists-p dir)) + (add-to-list 'plcmp--PERL5LIB-directories dir) + (message "added %s to PERL5LIB" dir)))) + +;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +;;;; Anything commands +;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +;; prefix: plcmp-acmd- +;; plcmp-acmd == plcmp-anything-command + +;; util +(defun plcmp-re-select-action (action-name-re) + (let* ((actions (anything-attr 'action)) + (action (assoc-if (lambda (s) (string-match action-name-re s)) + actions))) + (cond + ((and action (cdr action)) + (setq anything-saved-action (cdr action)) + (anything-exit-minibuffer)) + (t + (message "no action-name %s current source %s" action-name-re (anything-attr 'name)))))) + +(defun plcmp-acmd-occur () + (interactive) + (plcmp-re-select-action "^Occur")) + +(defun plcmp-acmd-show-doc () + (interactive) + (plcmp-re-select-action "^show")) + +(defun plcmp-acmd-open-related-file () + (interactive) + (plcmp-re-select-action "^open")) + +(defun plcmp-acmd-persistent-look () + (interactive) + (anything-execute-persistent-action)) + +(defun plcmp-acmd-goto-looking-point (&optional pop-to-buffer) + (interactive "P") + (lexical-let ((looking-point (first plcmp-look-current-positions)) + (buffer (second plcmp-look-current-positions)) + (show-fn (or pop-to-buffer 'pop-to-buffer 'switch-to-buffer))) + (if (and (numberp looking-point) + (bufferp buffer)) + (progn (setq anything-saved-action + (lambda (ignore) + (funcall show-fn buffer) + (goto-char looking-point))) + (anything-exit-minibuffer)) + (message "not looking buffer")))) + + +;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +;;; Mode +;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +(define-minor-mode perl-completion-mode "" nil " PLCompletion" plcmp-mode-map + (or plcmp-installed-modules + (plcmp-with-set-perl5-lib + (plcmp--installed-modules-asynchronously)))) + + +;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +;;; auto-complete.el +;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +;; ac == auto-complete +(defvar plcmp-ac-candidates-limit 1000) +(defvar ac-source-perl-completion + '((candidates . plcmp-ac-candidates))) + +(defun plcmp-ac-candidates () + (plcmp-ignore-errors + (when (and (eq major-mode 'cperl-mode) + (boundp 'perl-completion-mode) + perl-completion-mode) + (plcmp-initialize-variables) + (let ((words (plcmp-ac-make-cands))) + (plcmp-log "plcmp-ac-candidates words: %S" words) + (let ((cands (loop with count = 0 + with ret + for w in words + when (and (stringp w) + (string-match (concat "^" ac-target) w)) + do (progn (push w ret) + (incf count) + (when (= count plcmp-ac-candidates-limit) + (return (nreverse ret)))) + finally return (nreverse ret)))) + (prog1 cands + (plcmp-log "plcmp-ac-candidates return: %s" cands))))))) + +(defun plcmp-ac-make-cands () + (multiple-value-bind (ctx module-name) (plcmp--get-context-symbol) + (case ctx + (method + (append + (plcmp-ac-methods) + (plcmp-get-buffer-dabbrevs) + plcmp-builtin-functions + plcmp-builtin-variables + plcmp-using-modules + plcmp-installed-modules)) + (otherwise + (append + (plcmp-get-buffer-dabbrevs) + plcmp-builtin-functions + plcmp-builtin-variables + plcmp-using-modules + plcmp-installed-modules + (plcmp-ac-methods)))))) + +(defun plcmp-ac-methods () + (loop for module-name in plcmp-using-modules + append (assoc-default module-name plcmp-module-methods-alist))) + +;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +;;;; Test +;;;; %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +(dont-compile + (when (fboundp 'expectations) + (expectations + (desc "plcmp-get-face-words") + (expect nil + (let ((b (get-buffer-create "*plcmp-test*"))) + (with-current-buffer b + (cperl-mode) + (plcmp-get-face-words)))) + (expect "$test" + (let ((b (get-buffer-create "*plcmp-test*"))) + (with-current-buffer b + (erase-buffer) + (insert "my $test = 'hoge';\n") + (cperl-mode) + (font-lock-mode t) + (font-lock-fontify-region (point-min) (point-max)) + (prog1 (car (plcmp-get-face-words)) + (kill-buffer b))))) + (desc "plcmp--mk-module-source") + (expect nil + (plcmp--mk-module-source nil)) + (expect nil + (let ((plcmp-module-methods-alist nil)) + (plcmp--mk-module-source "test"))) + (expect '((name . "module Methods") (action ("Insert" . plcmp-insert) ("Show doc" lambda (candidate) (let* ((module (plcmp-get-current-module-name)) (buf (plcmp-get-man-buffer module (quote module)))) (save-selected-window (pop-to-buffer buf)))) ("Show doc and go" lambda (candidate) (let* ((module (plcmp-get-current-module-name)) (buf (plcmp-get-man-buffer module (quote module)))) (pop-to-buffer buf))) ("Open module file" lambda (method) (let ((module (plcmp-get-current-module-name))) (plcmp-open-module-file module))) ("Open module file other window" lambda (method) (let ((module-name (plcmp-get-current-module-name))) (plcmp-open-module-file module-name (quote pop-to-buffer)))) ("Open module file other frame" lambda (candidate) (let ((module-name (plcmp-get-current-module-name))) (plcmp-open-module-file module-name (quote switch-to-buffer-other-frame)))) ("Occur module file" lambda (candidate) (let ((module-name (plcmp-get-current-module-name))) (plcmp-open-module-file module-name (quote switch-to-buffer)) (funcall (plcmp-get-occur-fn) candidate nil))) ("Add to kill-ring" . kill-new) ("Insert source name" lambda (candidate) (let ((name (plcmp-anything-get-current-source-name))) (and (stringp name) (insert name))))) (init lambda nil (with-current-buffer (anything-candidate-buffer (quote global)) (plcmp-insert-each-line (quote ("method" "method2"))))) (candidates-in-buffer) (persistent-action lambda (candidate) (let ((module-name (plcmp-get-current-module-name))) (plcmp-open-doc module-name) (plcmp-re-search-forward-fontify (regexp-quote candidate))))) + (let ((plcmp-module-methods-alist '(("module" . ("method" "method2"))))) + (plcmp--mk-module-source "module"))) + + (desc "plcmp-tramp-p") + (expect t + (require 'tramp) + (stub plcmp-get-current-directory => "/tramp:path/to/") + (when (plcmp-tramp-p) + t)) + + (desc "plcmp-sort-sources") + (expect 'plcmp-anything-source-completion-builtin-variables + (car (plcmp-re-sort-sources "variables" plcmp-completion-all-static-sources))) + + (desc "plcmp--get-lib-path") + (expect "~/c/test/lib" + (stub file-exists-p => t) + (stub plcmp-get-current-directory => "~/c/test/lib/Test/TT/Test/") + (plcmp--get-lib-path)) + (expect "~/c/test/lib" + (stub file-exists-p => t) + (stub plcmp-get-current-directory => "~/c/test/lib/Test/TT/Test") + (plcmp--get-lib-path)) + (expect "~/c/hoge/test/lib/Test/TT/Test/lib" + (stub plcmp-get-current-directory => "~/c/hoge/test/lib/Test/TT/Test/lib/test") + (stub file-exists-p => t) + (plcmp--get-lib-path)) + (expect "~/c/hoge/test/lib/Test/TT/Test/lib" + (stub plcmp-get-current-directory => "~/c/hoge/test/lib/Test/TT/Test/lib/test/") + (stub file-exists-p => t) + (plcmp--get-lib-path)) + (expect nil + (stub plcmp-get-current-directory => "") + (plcmp--get-lib-path)) + (desc "plcmp-extra-using-modules") + (expect '("LWP::UserAgent") + (stub plcmp--get-using-modules-uses-and-requires => nil) + (let ((plcmp-extra-using-modules '("LWP::UserAgent"))) + (plcmp--using-modules-marge-extra-modules (plcmp--get-using-modules-uses-and-requires)))) + (expect '("HTTP::Response" "LWP::UserAgent") + (stub plcmp--get-using-modules-uses-and-requires => '("LWP::UserAgent")) + (let ((plcmp-extra-using-modules '(("LWP::UserAgent" . "HTTP::Response")))) + (plcmp--using-modules-marge-extra-modules (plcmp--get-using-modules-uses-and-requires)))) + (desc "plcmp--using-modules-filter") + (expect '("b" "a") + (let ((ls '("a" "strict" "b")) + (plcmp-module-filter-list '("strict"))) + (plcmp--using-modules-filter ls))) + (expect nil + (let ((ls '("strict")) + (plcmp-module-filter-list '("strict"))) + (plcmp--using-modules-filter ls))) + (expect '("LWP::UserAgent") + (let ((ls '("strict" "LWP::UserAgent")) + (plcmp-module-filter-list '("strict" "warning"))) + (plcmp--using-modules-filter ls))) + + ))) + +(provide 'perl-completion) +;;; perl-completion.el ends here Index: /dotfiles/emacs/yappo/.emacs.d/elisp/auto-complete.el =================================================================== --- /dotfiles/emacs/yappo/.emacs.d/elisp/auto-complete.el (revision 26364) +++ /dotfiles/emacs/yappo/.emacs.d/elisp/auto-complete.el (revision 26364) @@ -0,0 +1,856 @@ +;;; auto-complete.el --- Auto completion with popup menu + +;; Copyright (C) 2008 MATSUYAMA Tomohiro + +;; Author: MATSUYAMA Tomohiro +;; Keywords: convenience +;; Version: 0.1.0 + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This extension provides a way to select a completion with +;; popup menu. +;; +;; I checked that this extension can work properly on GNU Emacs 22 or higher. + +;; To use this extension, locate this file to load-path directory, +;; and add the following code to your .emacs. +;; ------------------------------ +;; (require 'auto-complete) +;; (global-auto-complete-mode t) +;; ------------------------------ + +;; After installation, you can try this: +;; +;; 1. Switch to emacs-lisp-mode buffer such as .emacs +;; 2. Goto anywhere +;; 3. Type "def" +;; 4. You may see a pop menu after the cursor like: +;; def-!- +;; +-----------------+ +;; |defun | <- highlight +;; |defvar | +;; |defmacro | +;; | ... | +;; +-----------------+ +;; 5. You can complete by seleting the menu item +;; by pressing TAB, , , and RET. + +;;; Tips: +;; +;; ================================ +;; Use C-n/C-p to select candidates +;; ================================ +;; +;; Add following code to your .emacs. +;; +;; ------------------------------ +;; (define-key ac-complete-mode-map "\C-n" 'ac-next) +;; (define-key ac-complete-mode-map "\C-p" 'ac-previous) +;; ------------------------------ +;; +;; +;; ==================================== +;; Don't start completion automatically +;; ==================================== +;; +;; Add following code to your .emacs. +;; +;; ------------------------------ +;; (setq ac-auto-start nil) +;; (global-set-key "\M-/" 'ac-start) +;; ------------------------------ +;; +;; Or +;; +;; ------------------------------ +;; ;; start completion when entered 3 characters +;; (setq ac-auto-start 3) +;; ------------------------------ +;; +;; +;; ================= +;; Completion by TAB +;; ================= +;; +;; Add following code to your .emacs. +;; +;; ------------------------------ +;; (define-key ac-complete-mode-map "\t" 'ac-complete) +;; (define-key ac-complete-mode-map "\r" nil) +;; ------------------------------ +;; +;; +;; =================== +;; Do What I Mean mode +;; =================== +;; +;; If DWIM (Do What I Mean) mode is enabled, +;; the following features is available: +;; +;; a. TAB (ac-expand) behave as completion (ac-complete) +;; when only one candidate is left +;; b. TAB (ac-expand) behave as completion (ac-complete) +;; after you select candidate +;; +;; DWIM mode is enabled by default. +;; You can disable this feature by +;; setting `ac-dwim' to nil. + +;; This extension is so simple that you can extend +;; how Emacs find a target and how Emacs enumerate +;; candidates. +;; I don't have intention to implement heavy functions :-) +;; +;; Enjoy! + +;;; History: + +;; 2008-11-26 MATSUYAMA Tomohiro +;; +;; * auto-complete.el 0.1.0 released +;; +;; 2008-11-19 MATSUYAMA Tomohiro +;; +;; * thanks for Taiki SUGAWARA +;; * added source ac-source-abbrev +;; * added source ac-source-symbols +;; * added ac-expand-common to expand common part +;; +;; 2008-11-18 MATSUYAMA Tomohiro +;; +;; * added ac-auto-start switch +;; * added ac-dwim switch +;; * changed menu popup behavior at end of window +;; * thanks rubikitch , kazu-yamamoto. +;; * fixed canceler bug +;; * changed to use overriding-local-map instead of minor mode map +;; * changed default key bindings +;; +;; 2008-11-16 MATSUYAMA Tomohiro +;; +;; * supported candidates by using sources +;; * added automatically start swtich +;; * fixed some bug +;; * added source ac-source-files-in-current-dir +;; * added source ac-source-words-in-buffer +;; * added source ac-source-yasnippet +;; * renamed ac-enum-candidates-function to ac-candidate-function +;; * renamed ac-find-target-function to ac-find-function +;; * ac-find-function and ac-candidate-function is not buffer local variable now +;; * made candidates visible when you are end of line +;; +;; 2008-11-11 MATSUYAMA Tomohiro +;; +;; * by reporting from rubikitch +;; * renamed hook name +;; * registered backward-delete-char as special command +;; * fixed code for creating candidates +;; * made auto-complete disabled when isearch-mode enabled +;; * added some major-mode into ac-modes +;; +;; 2008-11-09 MATSUYAMA Tomohiro +;; +;; * auto-complete.el 0.0.1 released +;; * fixed double-width character displaying problem +;; * fixed menu position following tab character +;; * made candidates visible when you are end of window + +;;; TODO: +;; +;; - performance issue (cache issue) +;; - single source mode +;; - fix narrowing bug (reported by Yuto Hayamizu ) +;; - care about undo (buffer-disable-undo) +;; - support scroll in menu +;; - use double candidate menu +;; - omni completion +;; - show description +;; - demo movie (YouTube) +;; - backward menu in tiny buffer +;; - dictionary +;; - semantic + +;;; Code: + + + +(defgroup auto-complete nil + "Auto completion with popup menu" + :group 'convenience + :prefix "auto-complete-") + +(defcustom ac-candidate-menu-width 25 + "Max width of candidate menu." + :type 'number + :group 'auto-complete) + +(defcustom ac-candidate-menu-height 10 + "Max height of candidate menu." + :type 'number + :group 'auto-complete) + +(defcustom ac-candidate-max 10 + "Max of number of candidates." + :type 'number + :group 'auto-complete) + +(defcustom ac-modes + '(emacs-lisp-mode lisp-interaction-mode + c-mode cc-mode c++-mode java-mode + perl-mode cperl-mode python-mode ruby-mode + ecmascript-mode javascript-mode php-mode css-mode + makefile-mode sh-mode fortran-mode f90-mode ada-mode + xml-mode sgml-mode) + "Major modes `auto-complete-mode' can run on." + :type '(list symbol) + :group 'auto-complete) + +(defcustom ac-auto-start t + "Non-nil means completion will be started automatically. +Positive integer means if a length of a word you entered is larger than the value, +completion will be started automatically. +If you specify `nil', never be started automatically." + :group 'auto-complete) + +(defcustom ac-dwim t + "Non-nil means `auto-complete' works based on Do What I Mean." + :type 'boolean + :group 'auto-complete) + +(defface ac-selection-face + '((t (:background "blue" :foreground "white"))) + "Face for the selected candidate." + :group 'auto-complete) + +(defface ac-menu-face + '((t (:background "lightgray" :foreground "black"))) + "Face for candidate menu." + :group 'auto-complete) + +(defvar auto-complete-mode-hook nil + "Hook for `auto-complete-mode'.") + +(defvar ac-menu nil + "Menu instance.") + +(defvar ac-menu-direction 1 + "Positive integer means `ac-menu' grows forward. +Or, `ac-menu' grows backward.") + +(defvar ac-menu-offset 0 + "Offset to contents.") + +(defvar ac-completing nil + "Non-nil means `auto-complete-mode' is now working on completion.") + +(defvar ac-saved-window-start nil + "Saved window start value for restore.") + +(defvar ac-saved-window-hscroll nil + "Saved window hscroll value for restore.") + +(defvar ac-point nil + "Start point of target.") + +(defvar ac-target nil + "Target string.") + +(defvar ac-limit 0 + "Limit of number of candidates.") + +(defvar ac-candidates nil + "Current candidates.") + +(defvar ac-selection nil + "Current candidate index.") + +(defvar ac-dwim-enable nil + "Non-nil means DWIM completion will be allowed.") + +(defvar ac-find-function 'ac-default-find + "When `auto-complete-mode' finds it can start completion +or update candidates, it will call this function to find a +start point of the completion target. + +If this function returns an integer, `auto-complete-mode' +will set the substring between the point and current point to `ac-target'. +And also it will start completion or update candidates by using +the `ac-target'. + +If this function returns `nil', `auto-complete-mode' +ignore starting completion or stop completing.") + +(defvar ac-init-function 'ac-sources-init + "This function will be called when candidate menu is setupped.") + +(defvar ac-candidate-function 'ac-sources-candidate + "This function can return candidates as list by +using the `TARGET' that is given as a first argument.") + +(defvar ac-complete-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\t" 'ac-expand) + (define-key map "\r" 'ac-complete) + + (define-key map [down] 'ac-next) + (define-key map [up] 'ac-previous) + + map) + "Keymap for completion.") + +(or (assq 'ac-completing minor-mode-map-alist) + (push (cons 'ac-completing ac-complete-mode-map) minor-mode-map-alist)) + +(defvar ac-saved-local-map nil + "Old keymap before `auto-complete' activated.") + + + +;;;; Auto completion + +(defun ac-setup (point) + "Setup popup menu." + (save-excursion + (goto-char point) + (let ((column (current-column)) + (line (line-number-at-pos))) + (setq ac-saved-window-start (window-start)) + (setq ac-saved-window-hscroll (window-hscroll)) + (setq ac-menu-direction + (if (and (> line ac-candidate-max) + (> ac-candidate-max + (- + (max 1 (- (window-height) + (if mode-line-format 1 0) + (if header-line-format 1 0))) + (1+ (count-lines (window-start) (point)))))) + -1 + 1)) + (let ((window-width (window-width)) + (right (- (+ column ac-candidate-menu-width) + (window-hscroll)))) + (if (and (> right window-width) + (>= right ac-candidate-menu-width)) + (setq column (- column ac-candidate-menu-width)))) + (if (> ac-menu-direction 0) + (progn + (forward-line) + (if (eq line (line-number-at-pos)) + (newline) + (forward-line -1)) + (setq ac-menu (ac-menu-create (1+ line) column ac-candidate-menu-width ac-candidate-menu-height)) + (setq ac-point point)) + (setq ac-menu (ac-menu-create (- line ac-candidate-max) column ac-candidate-menu-width ac-candidate-menu-height)) + (setq ac-point point))))) + +(defun ac-cleanup () + "Destroy popup menu." + (ac-deactivate-mode-map) + (when ac-menu + (ac-menu-delete ac-menu) + (set-window-start (selected-window) ac-saved-window-start) + (set-window-hscroll (selected-window) ac-saved-window-hscroll)) + (setq ac-menu nil) + (setq ac-completing nil) + (setq ac-point nil) + (setq ac-candidates nil) + (setq ac-selection 0)) + +(defun ac-activate-mode-map () + "Activate `ac-complete-mode-map'." + (setq ac-saved-local-map overriding-terminal-local-map) + (if (eq ac-saved-local-map ac-complete-mode-map) + ;; maybe never reach here + (setq ac-saved-local-map nil)) + (setq overriding-terminal-local-map ac-complete-mode-map)) + +(defun ac-deactivate-mode-map () + "Deactivate `ac-complete-mode-map'." + (when (eq overriding-terminal-local-map ac-complete-mode-map) + (setq overriding-terminal-local-map ac-saved-local-map) + (setq ac-saved-local-map nil))) + +(defun ac-next () + "Select next candidate." + (interactive) + (if (interactive-p) + (setq ac-dwim-enable t)) + (if ac-candidates + (ac-select-candidate + (let ((selection (1+ ac-selection))) + (if (= selection (+ ac-menu-offset (min ac-candidate-menu-height (length ac-candidates)))) + ac-menu-offset + selection))))) + +(defun ac-previous () + "Select previous candidate." + (interactive) + (if (interactive-p) + (setq ac-dwim-enable t)) + (if ac-candidates + (ac-select-candidate + (let ((selection (1- ac-selection))) + (if (< selection ac-menu-offset) + (1- (+ ac-menu-offset (min ac-candidate-menu-height (length ac-candidates)))) + selection))))) + +(defun ac-expand-1 () + "Try expansion." + (let ((string (overlay-get (ac-menu-line-overlay ac-menu ac-selection) 'real-string))) + (delete-region ac-point (point)) + (insert string) + (setq ac-target string))) + +(defun ac-expand () + "Try expansion but select next if expanded twice." + (interactive) + (if (and ac-dwim ac-dwim-enable) + (ac-complete) + (let ((target ac-target) + (string (ac-expand-1))) + (when (equal target string) + (ac-next) + (ac-expand-1))))) + +(defun ac-expand-common () + "Try expansion common part." + (interactive) + (let ((common (try-completion ac-target ac-candidates))) + (when (stringp common) + (delete-region ac-point (point)) + (insert common) + (setq ac-target common)))) + +(defun ac-complete () + "Try completion." + (interactive) + (let* ((string (overlay-get (ac-menu-line-overlay ac-menu ac-selection) 'real-string)) + (source (get-text-property 0 'source string)) + (complete-function (and source (cdr-safe (assq 'action source))))) + (ac-expand-1) + (if complete-function + (funcall complete-function)) + (ac-abort))) + +(defun ac-abort () + "Abort completion." + (ac-cleanup)) + +(defun ac-update-candidates (candidates) + "Update candidates of popup menu." + (setq ac-menu-offset (if (> ac-menu-direction 0) + 0 + (- ac-candidate-menu-height + (min ac-candidate-menu-height + (length candidates))))) + (setq ac-selection ac-menu-offset) + (setq ac-candidates candidates) + (setq ac-dwim-enable (= (length candidates) 1)) + (if candidates + (progn + (setq ac-completing t) + (ac-activate-mode-map)) + (setq ac-completing nil) + (ac-deactivate-mode-map)) + (let ((i ac-menu-offset)) + ;; show line and set string to the line + (mapcar + (lambda (candidate) + (when (< i ac-candidate-menu-height) + (ac-menu-show-line ac-menu i) + (ac-menu-set-line-string ac-menu i candidate (if (= i ac-selection) 'ac-selection-face)) + (setq i (1+ i)))) + candidates) + ;; ensure lines visible + (if (and (> ac-menu-direction 0) + (> i (- + (max 1 (- (window-height) + (if mode-line-format 1 0) + (if header-line-format 1 0))) + (1+ (count-lines (window-start) (point)))))) + (recenter (- (1+ i)))) + (if (> i ac-menu-offset) + (let ((window-width (window-width)) + (right (- (+ (ac-menu-column ac-menu) ac-candidate-menu-width) + (window-hscroll)))) + (if (> right window-width) + (scroll-left (- right window-width))))) + ;; hide remaining lines + (if (> ac-menu-direction 0) + (while (< i ac-candidate-menu-height) + (ac-menu-hide-line ac-menu i) + (setq i (1+ i))) + (dotimes (i ac-menu-offset) + (ac-menu-hide-line ac-menu i))))) + +(defun ac-select-candidate (selection) + "Select candidate pointed by `SELECTION'." + (when ac-candidates + (ac-menu-set-line-string ac-menu ac-selection (nth (- ac-selection ac-menu-offset) ac-candidates)) + (ac-menu-set-line-string ac-menu selection (nth (- selection ac-menu-offset) ac-candidates) 'ac-selection-face) + (setq ac-selection selection))) + +(defun ac-default-find () + "Default implemention for `ac-find-function'." + (require 'thingatpt) + (car-safe (bounds-of-thing-at-point 'symbol))) + +(defun ac-start () + "Start completion." + (interactive) + (let ((point (funcall ac-find-function))) + (if (or (null point) + (and ac-menu + (/= point ac-point))) + (ac-abort) + (when (null ac-menu) + (ac-setup point) + (funcall ac-init-function)) + (setq ac-target (buffer-substring-no-properties point (point))) + (setq ac-limit ac-candidate-max) + (ac-update-candidates + (if (or ac-completing + (not (integerp ac-auto-start)) + (>= (length ac-target) ac-auto-start)) + (funcall ac-candidate-function)))))) + +(defun ac-trigger-command-p () + "Return non-nil if `this-command' is a trigger command." + (or (eq this-command 'self-insert-command) + (and ac-completing + (memq this-command + '(delete-backward-char + backward-delete-char + backward-delete-char-untabify))))) + +(defun ac-on-pre-command () + (if (and (not (ac-trigger-command-p)) + (or (not (symbolp this-command)) + (not (string-match "^ac-" (symbol-name this-command))))) + (ac-abort))) + +(defun ac-on-post-command () + (if (and ac-auto-start + (not isearch-mode) + (ac-trigger-command-p)) + (ac-start))) + +(defun auto-complete-mode-maybe () + "What buffer `auto-complete-mode' prefers." + (if (and (not (minibufferp (current-buffer))) + (memq major-mode ac-modes)) + (auto-complete-mode 1))) + +(require 'easy-mmode) + +(define-minor-mode auto-complete-mode + "AutoComplete mode" + :lighter " AC" + :group 'auto-complete + (if auto-complete-mode + (progn + (add-hook 'post-command-hook 'ac-on-post-command nil t) + (add-hook 'pre-command-hook 'ac-on-pre-command nil t) + (run-hooks 'auto-complete-mode-hook)) + (remove-hook 'post-command-hook 'ac-on-post-command t) + (remove-hook 'pre-command-hook 'ac-on-pre-command t) + (ac-abort))) + +(if (fboundp 'define-global-minor-mode) + (define-global-minor-mode global-auto-complete-mode + auto-complete-mode auto-complete-mode-maybe + :group 'auto-complete)) + + + +;;;; Sources implementation + +(defvar ac-sources '(ac-source-words-in-buffer) + "Sources.") + +(defun ac-sources-init () + "Implementation for `ac-init-function' by sources." + (dolist (source ac-sources) + (if (symbolp source) + (setq source (symbol-value source))) + (let ((init-function (cdr-safe (assq 'init source)))) + (if init-function + (funcall init-function))))) + +(defun ac-sources-candidate () + "Implementation for `ac-cadidates-function' by sources." + (when (> (length ac-target) 0) + (let (candidates) + (dolist (source ac-sources) + (if (symbolp source) + (setq source (symbol-value source))) + (let* ((ac-limit (or (cdr-safe (assq 'limit source)) ac-limit)) + (requires (cdr-safe (assq 'requires source))) + cand) + (if (or (null requires) + (>= (length ac-target) requires)) + (setq cand + (delq nil + (mapcar (lambda (candidate) + (propertize candidate 'source source)) + (funcall (cdr (assq 'candidates source))))))) + (if (and (> ac-limit 1) + (> (length cand) ac-limit)) + (setcdr (nthcdr (1- ac-limit) cand) nil)) + (setq candidates (append candidates cand)))) + (delete-dups candidates)))) + +(defun ac-candidate-words-in-buffer () + "Default implemention for `ac-candidate-function'." + (if (> (length ac-target) 0) + (let ((i 0) + candidate + candidates + (regexp (concat "\\b" (regexp-quote ac-target) "\\(\\s_\\|\\sw\\)*\\b"))) + (save-excursion + ;; search backward + (goto-char ac-point) + (while (and (< i ac-limit) + (re-search-backward regexp nil t)) + (setq candidate (match-string-no-properties 0)) + (unless (member candidate candidates) + (push candidate candidates) + (setq i (1+ i)))) + ;; search backward + (goto-char (+ ac-point (length ac-target))) + (while (and (< i ac-limit) + (re-search-forward regexp nil t)) + (setq candidate (match-string-no-properties 0)) + (unless (member candidate candidates) + (push candidate candidates) + (setq i (1+ i)))) + (nreverse candidates))))) + +(defvar ac-source-words-in-buffer + '((candidates . ac-candidate-words-in-buffer)) + "Simple source like dabbrev.") + +(defvar ac-source-symbols + '((candidates + . (lambda () + (all-completions ac-target obarray)))) + "Source for Emacs lisp symbols.") + +(defvar ac-source-abbrev + `((candidates + . (lambda () + (all-completions ac-target local-abbrev-table))) + (action + . expand-abbrev)) + "Source for abbrev.") + +(defvar ac-source-files-in-current-dir + '((candidates + . (lambda () (all-completions ac-target (directory-files default-directory))))) + "Source for listing files in current directory.") + +(defvar ac-imenu-index nil + "Imenu index.") + +(defun ac-imenu-candidate () + (require 'imenu) + (let ((i 0) + (stack ac-imenu-index) + candidates + node) + (while (and stack + (< i ac-limit)) + (setq node (pop stack)) + (when (consp node) + (let ((car (car node)) + (cdr (cdr node))) + (if (consp cdr) + (mapcar (lambda (child) + (push child stack)) + cdr) + (when (and (stringp car) + (string-match (concat "^" (regexp-quote ac-target)) car)) + (push car candidates) + (setq i (1+ i))))))) + (nreverse candidates))) + +(defvar ac-source-imenu + '((init + . (lambda () + (require 'imenu) + (setq ac-imenu-index + (condition-case nil + (imenu--make-index-alist) + (error nil))))) + (candidates . ac-imenu-candidate)) + "Source for imenu.") + +(defun ac-yasnippet-candidate-1 (table) + (let ((hashtab (yas/snippet-table-hash table)) + (parent (yas/snippet-table-parent table)) + candidates) + (maphash (lambda (key value) + (push key candidates)) + hashtab) + (setq candidates (all-completions ac-target (nreverse candidates))) + (if parent + (setq candidates + (append candidates (ac-yasnippet-candidate-1 parent)))) + candidates)) + +(defun ac-yasnippet-candidate () + (require 'yasnippet) + (let ((table (yas/snippet-table major-mode))) + (if table + (ac-yasnippet-candidate-1 table)))) + +(defvar ac-source-yasnippet + '((candidates . ac-yasnippet-candidate) + (action . yas/expand) + (limit . 3)) + "Source for Yasnippet.") + + + +;;;; Popup menu + +(defun ac-menu-line (menu) + "Line number of `MENU'." + (nth 0 menu)) + +(defun ac-menu-column (menu) + "Column of `MENU'." + (nth 1 menu)) + +(defun ac-menu-width (menu) + "Popup menu width of `MENU'." + (nth 2 menu)) + +(defun ac-menu-height (menu) + "Popup menu height of `MENU'." + (nth 3 menu)) + +(defun ac-menu-overlays (menu) + "Overlays that `MENU' contains." + (nth 4 menu)) + +(defun ac-menu-line-overlay (menu line) + "Return a overlay of `MENU' at `LINE'." + (aref (ac-menu-overlays menu) line)) + +(defun ac-menu-hide-line (menu line) + "Hide `LINE' in `MENU'." + (let ((overlay (ac-menu-line-overlay menu line))) + (overlay-put overlay 'invisible nil) + (overlay-put overlay 'after-string nil))) + +(defun ac-menu-show-line (menu line) + "Show `LINE' in `MENU'." + (let ((overlay (ac-menu-line-overlay menu line))) + (overlay-put overlay 'invisible t))) + +(defun ac-menu-set-line-string (menu line string &optional face) + "Set contents of `LINE' in `MENU'." + (let ((overlay (ac-menu-line-overlay menu line))) + (overlay-put overlay 'real-string string) + (funcall (overlay-get overlay 'set-string-function) overlay string face))) + +(defun ac-menu-create-line-string (menu string) + "Adjust `STRING' into `MENU'." + (let ((length 0) + (width 0) + (menu-width (ac-menu-width menu)) + (chars (append string nil))) + (while (and + chars + (<= (setq width (+ width (char-width (car chars)))) menu-width)) + (setq length (1+ length)) + (setq chars (cdr chars))) + (if (< length (length string)) + (setq string (substring string 0 length))) + (let ((string-width (string-width string))) + (if (< string-width menu-width) + (setq string (concat string + (make-string (- menu-width string-width) ? ))))) + string)) + +(defun ac-menu-hide (menu) + "Hide `MENU'." + (dotimes (i (ac-menu-height menu)) + (ac-menu-hide-line menu i))) + +(defun ac-menu-last-line-of-buffer () + (save-excursion + (not (eq (forward-line) 0)))) + +(defun ac-menu-create (line column width height) + "Create popup menu." + (save-excursion + (let ((overlays (make-vector height nil)) + (window (selected-window))) + (goto-line line) + (dotimes (i height) + (move-to-column column) + (let (overlay begin w current-column (prefix "") (postfix "")) + (setq current-column (current-column)) + (cond + ((> current-column column) + (backward-char) + (setq current-column (current-column)) + (if (< current-column column) + (setq prefix (make-string (- column current-column) ? )))) + ((< current-column column) + (setq prefix (make-string (- column current-column) ? )))) + + (setq begin (point)) + (setq w (+ width (length prefix))) + (while (and (not (eolp)) + (> w 0)) + (setq w (- w (char-width (char-after)))) + (forward-char)) + (if (< w 0) + (setq postfix (make-string (- w) ? ))) + (if (ac-menu-last-line-of-buffer) + (setq postfix (concat postfix "\n"))) + + (setq overlay (make-overlay begin (point))) + (overlay-put overlay 'window window) + (overlay-put overlay 'prefix prefix) + (overlay-put overlay 'postfix postfix) + (overlay-put overlay 'width width) + (overlay-put overlay 'set-string-function + (lambda (overlay string &optional face) + (overlay-put overlay + 'after-string + (concat (overlay-get overlay 'prefix) + (propertize (ac-menu-create-line-string menu string) 'face (or face 'ac-menu-face)) + (overlay-get overlay 'postfix))))) + (aset overlays i overlay)) + (forward-line)) + (let ((i 100)) + (mapcar (lambda (overlay) + (overlay-put overlay 'priority i) + (setq i (1+ i))) + (nreverse (append overlays nil)))) + (list line column width height overlays)))) + +(defun ac-menu-delete (menu) + "Delete `MENU'." + (mapcar 'delete-overlay (ac-menu-overlays menu))) + +(provide 'auto-complete) +;;; auto-complete.el ends here