anything-el-1.287/0000755000175000017500000000000011447337241013266 5ustar takayatakayaanything-el-1.287/anything-match-plugin.el0000644000175000017500000012445211447253044020025 0ustar takayatakaya;;; anything-match-plugin.el --- Humane match plug-in for anything ;; $Id: anything-match-plugin.el,v 1.27 2010-03-24 11:11:28 rubikitch Exp $ ;; Copyright (C) 2008 rubikitch ;; Author: rubikitch ;; Keywords: anything, matching ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything-match-plugin.el ;; 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: ;; Change anything.el matching algorithm humanely. ;; It gives anything.el search refinement functionality. ;; exact match -> prefix match -> multiple regexp match ;;; Commands: ;; ;; Below are complete command list: ;; ;; ;;; Customizable Options: ;; ;; Below are customizable option list: ;; ;; `anything-grep-candidates-fast-directory-regexp' ;; *Directory regexp where a RAM disk (or tmpfs) is mounted. ;; default = nil ;; A query of multiple regexp match is space-delimited string. ;; Anything displays candidates which matches all the regexps. ;; A regexp with "!" prefix means not matching the regexp. ;; To include spaces to a regexp, prefix "\" before space, ;; it is controlled by `anything-mp-space-regexp' variable. ;; If multiple regexps are specified, first one also tries to match the source name. ;; If you want to disable this feature, evaluate ;; (setq anything-mp-match-source-name nil) . ;; This file highlights patterns like `occur'. Note that patterns ;; longer than `anything-mp-highlight-threshold' are highlighted. And ;; region out of screen is highlighted after ;; `anything-mp-highlight-delay' seconds. ;; ;; Highlight in Emacs is time-consuming process for slow computers. To ;; disable it is to set nil to `anything-mp-highlight-delay'. ;; Just require it to use. ;;; History: ;; $Log: anything-match-plugin.el,v $ ;; Revision 1.27 2010-03-24 11:11:28 rubikitch ;; Added :group keyword to `defface anything-match' ;; ;; Revision 1.26 2010/03/24 10:48:55 rubikitch ;; grep-candidates plug-in: document / imply `delayed' attribute ;; ;; Revision 1.25 2010/03/24 10:38:48 rubikitch ;; grep-candidates plugin: grep-candidates attribute can also accept variable/function name. ;; ;; Revision 1.24 2010/03/22 09:01:22 rubikitch ;; grep-candidates plugin released ;; ;; Revision 1.23 2010/03/22 08:02:11 rubikitch ;; grep-candidates plugin prototype ;; ;; Revision 1.22 2009/03/03 10:21:45 rubikitch ;; * Remove highlight.el dependency. ;; * Very faster highlight. ;; ;; Revision 1.21 2009/03/03 08:51:23 rubikitch ;; New variable: `anything-mp-highlight-threshold' ;; ;; Revision 1.20 2009/03/03 07:29:24 rubikitch ;; Highlight matches! ;; ;; Revision 1.19 2008/09/08 06:58:59 rubikitch ;; changed default `anything-mp-space-regexp' to "[\\ ] " ;; ;; Revision 1.18 2008/09/07 12:09:01 rubikitch ;; *** empty log message *** ;; ;; Revision 1.17 2008/09/07 07:48:12 rubikitch ;; Append commentary. ;; Multiple regexp match with regexp negation. ;; ;; Revision 1.16 2008/09/07 06:58:11 rubikitch ;; Added mp-3p match: permutation with prefix match ;; ;; Revision 1.15 2008/09/07 05:23:07 rubikitch ;; New variable: `anything-mp-space-regexp' ;; ;; Revision 1.14 2008/09/03 03:33:09 rubikitch ;; anything-exact-*, anything-prefix-*: memoize ;; ;; Revision 1.13 2008/09/02 10:56:50 rubikitch ;; anything-mp-3-*: MUCH MUCH FASTER ;; changed algorithm ;; ;; Revision 1.12 2008/09/01 13:41:57 rubikitch ;; search functions for search-from-end ;; ;; Revision 1.11 2008/08/24 20:40:27 rubikitch ;; prevent the unit test from being byte-compiled. ;; ;; Revision 1.10 2008/08/24 17:48:53 rubikitch ;; Add commentary ;; ;; Revision 1.9 2008/08/24 08:23:16 rubikitch ;; Rename `anything-candidates-buffer' -> `anything-candidate-buffer' ;; ;; Revision 1.8 2008/08/22 21:25:44 rubikitch ;; *** empty log message *** ;; ;; Revision 1.7 2008/08/22 21:17:58 rubikitch ;; exact, prefix match: faster ;; ;; Revision 1.6 2008/08/22 19:40:22 rubikitch ;; exact -> prefix -> mp-3 by default because of speed ;; ;; Revision 1.5 2008/08/22 19:04:53 rubikitch ;; reimplemented ;; ;; Revision 1.4 2008/08/20 00:10:15 rubikitch ;; *** empty log message *** ;; ;; Revision 1.3 2008/08/19 23:30:39 rubikitch ;; exact match support ;; ;; Revision 1.2 2008/08/19 23:02:29 rubikitch ;; candidates-in-buffer hack ;; ;; Revision 1.1 2008/08/19 19:45:11 rubikitch ;; Initial revision ;; ;;; Code: (require 'anything) (require 'cl) (let ((version "1.283")) (when (and (string= "1." (substring version 0 2)) (string-match "1\.\\([0-9]+\\)" anything-version) (< (string-to-number (match-string 1 anything-version)) (string-to-number (substring version 2)))) (error "Please update anything.el!! http://www.emacswiki.org/cgi-bin/wiki/download/anything.el or M-x install-elisp-from-emacswiki anything.el"))) (defcustom anything-grep-candidates-fast-directory-regexp nil "*Directory regexp where a RAM disk (or tmpfs) is mounted. If non-nil, grep-candidates plugin gets faster because it uses grep as synchronous process. ex. (setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\")" :type 'string :group 'anything) ;;;; multiple patterns (defvar anything-use-multiple-patterns t "If non-nil, enable anything-use-multiple-patterns.") (defvar anything-mp-space-regexp "[\\ ] " "Regexp to represent space itself in multiple regexp match.") (defvar anything-mp-match-source-name t "If non-nil, first query in space-delimited pattern try to match the source name. It needs at least two queries. For example, to list candidats of \"foo\" source, input pattern as \"foo .\".") (defun amp-mp-make-regexps (pattern) (if (string= pattern "") '("") (loop for s in (split-string (replace-regexp-in-string anything-mp-space-regexp "\000\000" pattern) " " t) collect (replace-regexp-in-string "\000\000" " " s)))) (defun amp-mp-1-make-regexp (pattern) (mapconcat 'identity (amp-mp-make-regexps pattern) ".*")) (defmacro amp-define-memoizer (prefix pattern-expr) (let ((pattern-str (intern (concat prefix "pattern-str"))) (pattern-real (intern (concat prefix "pattern-real"))) (get-pattern (intern (concat prefix "get-pattern")))) `(progn (defvar ,pattern-str nil) (defvar ,pattern-real nil) (defsubst ,get-pattern (pattern) (unless (equal pattern ,pattern-str) (setq ,pattern-str pattern ,pattern-real ,pattern-expr)) ,pattern-real)))) (defmacro amp-define (prefix pattern-expr) (let ((get-pattern (intern (concat prefix "get-pattern"))) (match (intern (concat prefix "match"))) (search (intern (concat prefix "search"))) (search-backward (intern (concat prefix "search-backward")))) `(progn (amp-define-memoizer ,prefix ,pattern-expr) (defun* ,match (str &optional (pattern anything-pattern)) (string-match (,get-pattern pattern) str)) (defun ,search (pattern &rest ignore) (re-search-forward (,get-pattern pattern) nil t)) (defun ,search-backward (pattern &rest ignore) (re-search-backward (,get-pattern pattern) nil t))))) ;; exact match ;(amp-define "anything-exact-" (concat (anything-prefix-get-pattern pattern) "$")) (amp-define-memoizer "anything-exact-" (concat "\n" pattern "\n")) (defun anything-exact-match (str &optional pattern) (string= str (or pattern anything-pattern))) (defun anything-exact-search (pattern &rest ignore) (and (search-forward (anything-exact-get-pattern pattern) nil t) (forward-line -1))) (defun anything-exact-search-backward (pattern &rest ignore) (and (search-backward (anything-exact-get-pattern pattern) nil t) (forward-line 1))) ;; prefix match ;;(amp-define "anything-prefix-" (concat "^" (regexp-quote pattern))) (amp-define-memoizer "anything-prefix-" (concat "\n" pattern)) (defun anything-prefix-match (str &optional pattern) (setq pattern (or pattern anything-pattern)) (let ((len (length pattern))) (and (<= len (length str)) (string= (substring str 0 len) pattern )))) (defun anything-prefix-search (pattern &rest ignore) (search-forward (anything-prefix-get-pattern pattern) nil t)) (defun anything-prefix-search-backward (pattern &rest ignore) (and (search-backward (anything-prefix-get-pattern pattern) nil t) (forward-line 1))) ;; multiple regexp patterns 1 (order is preserved / prefix) (amp-define "anything-mp-1-" (concat "^" (amp-mp-1-make-regexp pattern))) ;; multiple regexp patterns 2 (order is preserved / partial) (amp-define "anything-mp-2-" (concat "^.+" (amp-mp-1-make-regexp pattern))) ;;;; multiple regexp patterns 3 (permutation) (defvar anything-mp-3-pattern-str nil) (defvar anything-mp-3-pattern-list nil) (defsubst anything-mp-3-get-patterns (pattern) (unless (equal pattern anything-mp-3-pattern-str) (setq anything-mp-3-pattern-str pattern anything-mp-3-pattern-list (anything-mp-3-get-patterns-internal pattern))) anything-mp-3-pattern-list) (defun anything-mp-3-get-patterns-internal (pattern) (loop for pat in (amp-mp-make-regexps pattern) collect (if (string= "!" (substring pat 0 1)) (cons 'not (substring pat 1)) (cons 'identity pat)))) (defun anything-mp-handle-source-name-maybe (pattern self else) (when (stringp pattern) (setq pattern (anything-mp-3-get-patterns pattern))) ;; PATTERN is list of (pred . re) now. (when pattern (destructuring-bind ((first-pred . first-re) . rest) pattern (if (and anything-mp-match-source-name (stringp anything-source-name) (eq 'identity first-pred)) (let (anything-mp-match-source-name) (or (and (string-match first-re anything-source-name) (funcall self rest)) (funcall self pattern))) (funcall else))))) (defun* anything-mp-3-match (str &optional (pattern anything-pattern)) (anything-mp-handle-source-name-maybe pattern (apply-partially 'anything-mp-3-match str) (lambda () (loop for (pred . re) in pattern always (funcall pred (string-match re str)))))) (defmacro anything-mp-3-search-base (searchfn1 searchfn2 b e) `(loop with pat = (if (stringp pattern) (anything-mp-3-get-patterns pattern) pattern) while (,searchfn1 (or (cdar pat) "") nil t) for bol = (point-at-bol) for eol = (point-at-eol) if (loop for (pred . s) in (cdr pat) always (progn (goto-char ,b) (funcall pred (,searchfn2 s ,e t)))) do (goto-char ,e) (return t) else do (goto-char ,e) finally (return nil))) (defun anything-mp-3-search (pattern &rest ignore) (anything-mp-handle-source-name-maybe pattern 'anything-mp-3-search (lambda () (anything-mp-3-search-base re-search-forward re-search-forward bol eol)))) (defun anything-mp-3-search-backward (pattern &rest ignore) (anything-mp-handle-source-name-maybe pattern 'anything-mp-3-search-backward (lambda () (anything-mp-3-search-base re-search-backward re-search-backward eol bol)))) ;; mp-3p- (multiple regexp pattern 3 with prefix search) (defun* anything-mp-3p-match (str &optional (pattern anything-pattern)) (anything-mp-handle-source-name-maybe pattern (apply-partially 'anything-mp-3p-match str) (lambda () (declare (special first-pred first-re)) (and (funcall first-pred (anything-prefix-match str first-re)) (loop for (pred . re) in rest always (funcall pred (string-match re str))))))) (defun anything-mp-3p-search (pattern &rest ignore) (anything-mp-handle-source-name-maybe pattern 'anything-mp-3p-search (lambda () (anything-mp-3-search-base anything-prefix-search re-search-forward bol eol)))) (defun anything-mp-3p-search-backward (pattern &rest ignore) (anything-mp-handle-source-name-maybe pattern 'anything-mp-3p-search-backward (lambda () (anything-mp-3-search-base anything-prefix-search-backward re-search-backward eol bol)))) ;;;; Highlight matches (defface anything-match '((t (:inherit match))) "Face used to highlight matches." :group 'anything) (defvar anything-mp-highlight-delay 0.7 "Highlight matches with `anything-match' face after this many seconds. If nil, no highlight. ") (defvar anything-mp-highlight-threshold 2 "Minimum length of pattern to highlight. The smaller this value is, the slower highlight is.") (defun anything-mp-highlight-match () "Highlight matches after `anything-mp-highlight-delay' seconds." (when (and anything-mp-highlight-delay (not (string= anything-pattern ""))) (anything-mp-highlight-match-internal (window-end (anything-window))) (run-with-idle-timer anything-mp-highlight-delay nil 'anything-mp-highlight-match-internal (with-current-buffer anything-buffer (point-max))))) (add-hook 'anything-update-hook 'anything-mp-highlight-match) (defun anything-mp-highlight-region (start end regexp face) (save-excursion (goto-char start) (let (me) (while (and (setq me (re-search-forward regexp nil t)) (< (point) end) (< 0 (- (match-end 0) (match-beginning 0)))) (put-text-property (match-beginning 0) me 'face face))))) (defun* anything-mp-highlight-match-internal (end) (when (anything-window) (set-buffer anything-buffer) (let ((requote (regexp-quote anything-pattern))) (when (>= (length requote) anything-mp-highlight-threshold) (anything-mp-highlight-region (point-min) end requote 'anything-match))) (loop for (pred . re) in (anything-mp-3-get-patterns anything-pattern) when (and (eq pred 'identity) (>= (length re) anything-mp-highlight-threshold)) do (anything-mp-highlight-region (point-min) end re 'anything-match)))) ;;;; source compier (defvar anything-mp-default-match-functions '(anything-exact-match anything-mp-3p-match anything-mp-3-match)) (defvar anything-mp-default-search-functions '(anything-exact-search anything-mp-3p-search anything-mp-3-search)) (defvar anything-mp-default-search-backward-functions '(anything-exact-search-backward anything-mp-3p-search-backward anything-mp-3-search-backward)) (defun anything-compile-source--match-plugin (source) (let ((searchers (if (assoc 'search-from-end source) anything-mp-default-search-backward-functions anything-mp-default-search-functions))) `(,(if (or (assoc 'candidates-in-buffer source) (equal '(identity) (assoc-default 'match source))) '(match identity) `(match ,@anything-mp-default-match-functions ,@(assoc-default 'match source))) (search ,@searchers ,@(assoc-default 'search source)) ,@source))) (add-to-list 'anything-compile-source-functions 'anything-compile-source--match-plugin t) ;;;; grep-candidates plug-in (defun agp-candidates (&optional filter) "Normal version of grep-candidates candidates function. Grep is run by asynchronous process." (start-process-shell-command "anything-grep-candidates" nil (agp-command-line-2 filter))) (defun agp-candidates-synchronous-grep (&optional filter) "Faster version of grep-candidates candidates function. Grep is run by synchronous process. It is faster when candidate files are in ramdisk." (split-string (shell-command-to-string (agp-command-line-2 filter)) "\n")) (defun agp-candidates-synchronous-grep--direct-insert-match (&optional filter) "[EXPERIMENTAL]Fastest version of grep-candidates candidates function at the cost of absense of transformers. Grep is run by synchronous process. It is faster when candidate files are in ramdisk. If (direct-insert-match) is in the source, this function is used." (with-current-buffer (anything-candidate-buffer 'global) (call-process-shell-command (agp-command-line-2 filter) nil t))) (defun agp-command-line (query files &optional limit filter) "Build command line used by grep-candidates from QUERY, FILES, LIMIT, and FILTER." (with-temp-buffer (if (string= query "") (insert "cat " (mapconcat (lambda (f) (shell-quote-argument (expand-file-name f))) files " ")) (loop for (flag . re) in (anything-mp-3-get-patterns-internal query) for i from 0 do (setq re (replace-regexp-in-string "^-" "\\-" re)) (unless (zerop i) (insert " | ")) (insert "grep -ih " (if (eq flag 'identity) "" "-v ") (shell-quote-argument re)) (when (zerop i) (insert " " (mapconcat (lambda (f) (shell-quote-argument (expand-file-name f))) files " "))))) (when limit (insert (format " | head -n %d" limit))) (when filter (insert " | " filter)) (buffer-string))) (defun agp-command-line-2 (filter) "Build command line used by grep-candidates from FILTER and current source." (agp-command-line anything-pattern (anything-mklist (anything-interpret-value (anything-attr 'grep-candidates))) (anything-candidate-number-limit (anything-get-current-source)) filter)) (defun anything-compile-source--grep-candidates (source) (anything-aif (assoc-default 'grep-candidates source) (append source (let ((use-fast-directory (and anything-grep-candidates-fast-directory-regexp (string-match anything-grep-candidates-fast-directory-regexp (or (car (anything-mklist (anything-interpret-value it))) ""))))) (cond ((not (anything-interpret-value it)) nil) ((and use-fast-directory (assq 'direct-insert-match source)) (anything-log "fastest version (use-fast-directory and direct-insert-match)") `((candidates . agp-candidates-synchronous-grep--direct-insert-match) (match identity) (volatile) (requires-pattern))) (use-fast-directory (anything-log "faster version (use-fast-directory)") `((candidates . agp-candidates-synchronous-grep) (match identity) (volatile) (requires-pattern))) (t (anything-log "normal version") '((candidates . agp-candidates) (delayed)))))) source)) (add-to-list 'anything-compile-source-functions 'anything-compile-source--grep-candidates) (anything-document-attribute 'grep-candidates "grep-candidates plug-in" "grep-candidates plug-in provides anything-match-plugin.el feature with grep and head program. It is MUCH FASTER than normal match-plugin to search from vary large (> 1MB) candidates. Make sure to install these programs. It expands `candidates' and `delayed' attributes. `grep-candidates' attribute accepts a filename or list of filename. It also accepts 0-argument function name or variable name.") ;; (anything '(((name . "grep-test") (grep-candidates . "~/.emacs.el") (action . message)))) ;; (let ((a "~/.emacs.el")) (anything '(((name . "grep-test") (grep-candidates . a) (action . message) (delayed))))) ;; (let ((a "~/.emacs.el")) (anything '(((name . "grep-test") (grep-candidates . (lambda () a)) (action . message) (delayed))))) ;; (anything '(((name . "grep-test") (grep-candidates . "~/.emacs.el") (action . message) (delayed) (candidate-number-limit . 2)))) ;; (let ((anything-candidate-number-limit 2)) (anything '(((name . "grep-test") (grep-candidates . "~/.emacs.el") (action . message) (delayed))))) ;;;; Compatibility (unless (fboundp 'apply-partially) (defun apply-partially (fun &rest args) "Return a function that is a partial application of FUN to ARGS. ARGS is a list of the first N arguments to pass to FUN. The result is a new function which does the same as FUN, except that the first N arguments are fixed at the values with which this function was called." (lexical-let ((fun fun) (args1 args)) (lambda (&rest args2) (apply fun (append args1 args2)))))) ;;;; 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 "amp-mp-make-regexps") (expect '("") (amp-mp-make-regexps "")) (expect '("foo" "bar") (amp-mp-make-regexps "foo bar")) (expect '("foo" "bar") (amp-mp-make-regexps " foo bar")) (expect '("foo" "bar") (amp-mp-make-regexps " foo bar ")) (expect '("foo bar" "baz") (let ((anything-mp-space-regexp "\\\\ ")) (amp-mp-make-regexps "foo\\ bar baz"))) (desc "anything-mp-3-get-patterns-internal") (expect '((identity . "foo")) (anything-mp-3-get-patterns-internal "foo")) (expect '((identity . "foo") (identity . "bar")) (anything-mp-3-get-patterns-internal "foo bar")) (expect '((identity . "foo") (not . "bar")) (anything-mp-3-get-patterns-internal "foo !bar")) (desc "agp-command-line") (expect "grep -ih foo /f1" (agp-command-line "foo" '("/f1"))) (expect "grep -ih foo /f1 | grep -ih bar" (agp-command-line "foo bar" '("/f1"))) (expect "grep -ih foo /f1 | grep -ih -v bar" (agp-command-line "foo !bar" '("/f1"))) (expect "grep -ih foo /f1 /f\\ 2 | grep -ih -v bar | grep -ih baz" (agp-command-line "foo !bar baz" '("/f1" "/f 2"))) (expect (concat "grep -ih foo " (expand-file-name "~/.emacs.el")) (agp-command-line "foo" '("~/.emacs.el"))) (expect "grep -ih f\\ o /f\\ 1" (agp-command-line "f o" '("/f 1"))) (expect "grep -ih foo /f1 | head -n 5" (agp-command-line "foo" '("/f1") 5)) (expect "grep -ih foo /f1 | head -n 5 | nkf -w" (agp-command-line "foo" '("/f1") 5 "nkf -w")) (desc "anything-exact-match") (expect (non-nil) (anything-exact-match "thunder" "thunder")) (expect nil (anything-exact-match "thunder" "fire")) (desc "anything-exact-search") (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-exact-search "thunder" nil t))) (expect (non-nil) (with-temp-buffer (insert "\nfire\nthunder\n") (goto-char 1) (anything-exact-search "fire" nil t))) (desc "anything-prefix-search") (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char (point-min)) (anything-prefix-search "thund" nil t))) (expect nil (with-temp-buffer (insert "fire\nthunder\n") (goto-char (point-min)) (anything-prefix-search "hund" nil t))) (desc "anything-prefix-search-backward") (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char (point-max)) (anything-prefix-search-backward "thund" nil t))) (expect nil (with-temp-buffer (insert "fire\nthunder\n") (goto-char (point-max)) (anything-prefix-search-backward "hund" nil t))) (desc "amp-mp-1-make-regexp") (expect "a.*b" (amp-mp-1-make-regexp "a b")) (expect "a b" (let ((anything-mp-space-regexp "\\\\ ")) (amp-mp-1-make-regexp "a\\ b"))) (expect "a.*b c" (let ((anything-mp-space-regexp "\\\\ ")) (amp-mp-1-make-regexp "a b\\ c"))) (expect "" (amp-mp-1-make-regexp "")) (desc "anything-mp-1-search") (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-mp-1-search "th+ r" nil t))) (desc "anything-mp-2-search") (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-mp-2-search "h+ r" nil t))) (expect nil (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-mp-2-search "th+ r" nil t))) (desc "anything-mp-3-search") (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-mp-3-search "h+ r" nil t))) (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-mp-3-search "th+ r" nil t))) (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-mp-3-search "r th+" nil t))) (expect nil (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-mp-3-search "under hue" nil t))) (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-mp-3-search "r th+ n" nil t))) (desc "anything-mp-3-search") (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-mp-3-search "th der" nil t))) (expect nil (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-mp-3-search "th ders" nil t))) (desc "anything-mp-3-search not") (expect t (with-temp-buffer (insert "threshold\nthunder\n") (goto-char 1) (anything-mp-3-search "h !der" nil t))) (expect t (with-temp-buffer (insert "threshold\nthunder\n") (goto-char 1) (anything-mp-3-search "th !der" nil t))) (desc "anything-mp-3p-search") (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-mp-3p-search "th der" nil t))) (expect nil (with-temp-buffer (insert "fire\nthunder\n") (goto-char 1) (anything-mp-3p-search "h ders" nil t))) (desc "anything-mp-3p-search not") (expect t (with-temp-buffer (insert "\nthreshold\nthunder\n") (goto-char 1) (anything-mp-3p-search "th !der" nil t))) (expect nil (with-temp-buffer (insert "threshold\nthunder\n") (goto-char 1) (anything-mp-3p-search "h !der" nil t))) (desc "anything-mp-3-search-backward") (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char (point-max)) (anything-mp-3-search-backward "h der" nil t))) (expect nil (with-temp-buffer (insert "fire\nthunder\n") (goto-char (point-max)) (anything-mp-3-search-backward "th ders" nil t))) (desc "anything-mp-3-search-backward not") (expect t (with-temp-buffer (insert "threshold\nthunder\n") (goto-char (point-max)) (anything-mp-3-search-backward "h !der" nil t))) (expect t (with-temp-buffer (insert "threshold\nthunder\n") (goto-char (point-max)) (anything-mp-3-search-backward "th !der" nil t))) (desc "anything-mp-3p-search-backward") (expect (non-nil) (with-temp-buffer (insert "fire\nthunder\n") (goto-char (point-max)) (anything-mp-3p-search-backward "th der" nil t))) (expect nil (with-temp-buffer (insert "fire\nthunder\n") (goto-char (point-max)) (anything-mp-3p-search-backward "h der" nil t))) (desc "anything-mp-3p-search-backward not") (expect t (with-temp-buffer (insert "\nthreshold\nthunder\n") (goto-char (point-max)) (anything-mp-3p-search-backward "th !der" nil t))) (expect nil (with-temp-buffer (insert "threshold\nthunder\n") (goto-char (point-max)) (anything-mp-3p-search-backward "h !der" nil t))) (desc "anything-mp-1-match") (expect (non-nil) (anything-mp-1-match "thunder" "th+ r")) (desc "anything-mp-2-match") (expect (non-nil) (anything-mp-2-match "thunder" "h+ r")) (expect nil (anything-mp-2-match "thunder" "th+ r")) (desc "anything-mp-3-match") (expect (non-nil) (anything-mp-3-match "thunder" "h+ r")) (expect (non-nil) (anything-mp-3-match "thunder" "th+ r")) (expect (non-nil) (anything-mp-3-match "thunder" "r th+")) (expect nil (anything-mp-3-match "thunder" "under hue")) (expect (non-nil) (anything-mp-3-match "thunder" "r th+ n")) (desc "anything-mp-3-match not") (expect (non-nil) (anything-mp-3-match "threshold" "th !der")) (desc "anything-prefix-match") (expect (non-nil) (anything-prefix-match "fobar" "fo")) (expect nil (anything-prefix-match "xfobar" "fo")) (desc "anything-mp-3-match") (expect (non-nil) (anything-mp-3-match "thunder" "h der")) (expect nil (anything-mp-3-match "thunder" "h ders")) (desc "anything-mp-3p-match") (expect (non-nil) (anything-mp-3p-match "thunder" "th der")) (expect nil (anything-mp-3p-match "thunder" "h der")) (desc "anything-mp-3p-match not") (expect (non-nil) (anything-mp-3p-match "threshold" "th !der")) (expect nil (anything-mp-3p-match "threshold" "h !der")) (desc "with identity match") (expect '(identity) (assoc-default 'match (car (anything-compile-sources '(((name . "FOO") (candidates-in-buffer))) '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin))))) (expect '(identity) (assoc-default 'match (car (anything-compile-sources '(((name . "FOO") (match identity))) '(anything-compile-source--match-plugin))))) (desc "functional") (expect '(("FOO" ("thunder"))) (anything-test-candidates '(((name . "FOO") (candidates "fire" "thunder"))) "th r" '(anything-compile-source--match-plugin))) (expect '(("FOO" ("one two"))) (let ((anything-mp-space-regexp "\\\\ ")) (anything-test-candidates '(((name . "FOO") (candidates "one two" "three four"))) "e\\ t" '(anything-compile-source--match-plugin)))) (expect '(("FOO" ("one two"))) (let ((anything-mp-space-regexp " ")) (anything-test-candidates '(((name . "FOO") (candidates "one two" "three four"))) "e t" '(anything-compile-source--match-plugin)))) (expect '(("FOO" ("thunder"))) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "fire\nthunder\nthanks\n")))) (candidates-in-buffer))) "th r" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin))) (expect '(("FOO" ("foo" "foobar"))) (anything-test-candidates '(((name . "FOO") (candidates "foobar" "foo"))) "foo" '(anything-compile-source--match-plugin))) (expect '(("FOO" ("foo" "foobar"))) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "foobar\nfoo\n")))) (candidates-in-buffer))) "foo" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin))) (expect '(("FOO" ("foo"))) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "foo\n")))) (candidates-in-buffer))) "foo" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin))) (expect '(("FOO" ("foo"))) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "bar\nfoo\ntest\n")))) (candidates-in-buffer))) "foo" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin))) (expect '(("FOO" ("foobar" "foo"))) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "foobar\nfoo\n")))) (candidates-in-buffer))) "" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin))) (expect '(("FOO" ("foo" "foobar"))) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "foobar\nfoo\n")))) (candidates-in-buffer) (search-from-end))) "foo" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin))) (expect '(("FOO" ("elisp" "elp"))) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "elp\nelisp\n")))) (candidates-in-buffer) (search-from-end))) "el p" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin))) (expect '(("FOO" ("elisp" ))) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "elp\nelisp\n")))) (candidates-in-buffer) (search-from-end))) "el+ isp" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin))) ;; prefix multi -> multi (expect '(("FOO" ("elisp-info" "info.el"))) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "info.el\nelisp-info\n")))) (candidates-in-buffer) )) "el info" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin))) ;; multi not (expect '(("FOO" ("info.el"))) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "info.el\nelisp-info\n")))) (candidates-in-buffer) )) "info !elisp" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin))) ;; anything-mp-match-source-name (expect '(("SourceName" ("foo"))) (let ((anything-mp-match-source-name t)) (anything-test-candidates '(((name . "SourceName") (candidates "foo" "bar"))) "source f" '(anything-compile-source--match-plugin)))) (expect '(("SourceName cib" ("foo"))) (let ((anything-mp-match-source-name t)) (anything-test-candidates '(((name . "SourceName cib") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "foo\nbar\n")))) (candidates-in-buffer))) "source f" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin)))) (expect '(("SourceName cib search-from-end" ("bar"))) (let ((anything-mp-match-source-name t)) (anything-test-candidates '(((name . "SourceName cib search-from-end") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "foo\nbar\n")))) (search-from-end) (candidates-in-buffer))) "source b" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin)))) (expect '(("SourceName" ("foo" "bar"))) (let ((anything-mp-match-source-name t)) (anything-test-candidates '(((name . "SourceName") (candidates "foo" "bar"))) "source ." '(anything-compile-source--match-plugin)))) (expect '(("SourceName cib" ("foo" "bar"))) (let ((anything-mp-match-source-name t)) (anything-test-candidates '(((name . "SourceName cib") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "foo\nbar\n")))) (candidates-in-buffer))) "source ." '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin)))) (expect '(("SourceName cib search-from-end" ("bar" "foo"))) (let ((anything-mp-match-source-name t)) (anything-test-candidates '(((name . "SourceName cib search-from-end") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "foo\nbar\n")))) (search-from-end) (candidates-in-buffer))) "source ." '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin)))) ))) ;; (anything-compile-sources '(((name . "test"))) anything-compile-source-functions) (provide 'anything-match-plugin) ;; How to save (DO NOT REMOVE!!) ;; (progn (magit-push) (emacswiki-post "anything-match-plugin.el")) ;;; anything-match-plugin.el ends here anything-el-1.287/anything-complete.el0000644000175000017500000015716411447253044017253 0ustar takayatakaya;;; anything-complete.el --- completion with anything ;; $Id: anything-complete.el,v 1.86 2010-03-31 23:14:13 rubikitch Exp $ ;; Copyright (C) 2008, 2009, 2010 rubikitch ;; Author: rubikitch ;; Keywords: matching, convenience, anything ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything-complete.el ;; 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: ;; Completion with Anything interface. ;;; Commands: ;; ;; Below are complete command list: ;; ;; `alcs-update-restart' ;; Update lisp symbols and restart current `anything' session. ;; `anything-lisp-complete-symbol' ;; `lisp-complete-symbol' replacement using `anything'. ;; `anything-lisp-complete-symbol-partial-match' ;; `lisp-complete-symbol' replacement using `anything' (partial match). ;; `anything-apropos' ;; `apropos' replacement using `anything'. ;; `anything-read-file-name-follow-directory' ;; Follow directory in `anything-read-file-name'. ;; `anything-read-string-mode' ;; If this minor mode is on, use `anything' version of `completing-read' and `read-file-name'. ;; `anything-complete-shell-history' ;; Select a command from shell history and insert it. ;; `anything-execute-extended-command' ;; Replacement of `execute-extended-command'. ;; `anything-find-file' ;; Replacement of `find-file'. ;; ;;; Customizable Options: ;; ;; Below are customizable option list: ;; ;; `anything-complete-sort-candidates' ;; *Whether to sort completion candidates. ;; default = nil ;; `anything-execute-extended-command-use-kyr' ;; *Use `anything-kyr' (context-aware commands) in `anything-execute-extended-command'. ;; default = t ;; * `anything-lisp-complete-symbol', `anything-lisp-complete-symbol-partial-match': ;; `lisp-complete-symbol' with `anything' ;; * `anything-apropos': `apropos' with `anything' ;; * `anything-complete-shell-history': complete from .*sh_history ;; * Many read functions: ;; `anything-read-file-name', `anything-read-buffer', `anything-read-variable', ;; `anything-read-command', `anything-completing-read' ;; * `anything-read-string-mode' replaces default read functions with anything ones. ;; * Many anything sources: ;; [EVAL IT] (occur "defvar anything-c-source") ;;; Installation: ;; Put anything-complete.el to your load-path. ;; The load-path is usually ~/elisp/. ;; It's set in your ~/.emacs like this: ;; (add-to-list 'load-path (expand-file-name "~/elisp")) ;; ;; Then install dependencies. ;; ;; Install anything-match-plugin.el (must). ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/anything-match-plugin.el ;; ;; shell-history.el / shell-command.el would help you (optional). ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/shell-history.el ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/shell-command.el ;; ;; If you want `anything-execute-extended-command' to show ;; context-aware commands, use anything-kyr.el and ;; anything-kyr-config.el (optional). ;; ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/anything-kyr.el ;; M-x install-elisp http://www.emacswiki.org/cgi-bin/wiki/download/anything-kyr-config.el ;; And the following to your ~/.emacs startup file. ;; ;; (require 'anything-complete) ;; ;; Automatically collect symbols by 150 secs ;; (anything-lisp-complete-symbol-set-timer 150) ;; (define-key emacs-lisp-mode-map "\C-\M-i" 'anything-lisp-complete-symbol-partial-match) ;; (define-key lisp-interaction-mode-map "\C-\M-i" 'anything-lisp-complete-symbol-partial-match) ;; ;; replace completion commands with `anything' ;; (anything-read-string-mode 1) ;; ;; Bind C-o to complete shell history ;; (anything-complete-shell-history-setup-key "\C-o") ;;; History: ;; $Log: anything-complete.el,v $ ;; Revision 1.86 2010-03-31 23:14:13 rubikitch ;; `anything-completing-read': Fix a case when HIST is a cons. ;; ;; Revision 1.85 2010/03/31 03:22:29 rubikitch ;; anything attribute completion from M-x anything-lisp-complete-symbol(-partial-match) ;; ;; Revision 1.84 2010/03/27 02:43:45 rubikitch ;; Use `anything-force-update' feature ;; ;; Revision 1.83 2010/03/22 06:10:40 rubikitch ;; tidy ;; ;; Revision 1.82 2010/03/22 05:57:57 rubikitch ;; New sources: ;; `anything-c-source-complete-emacs-faces', ;; `anything-c-source-apropos-emacs-faces', ;; `anything-c-source-emacs-face-at-point' ;; `anything-lisp-complete-symbol', `anything-apropos': Search faces too ;; ;; Revision 1.81 2010/02/20 10:38:31 rubikitch ;; More strict version check. ;; ;; Revision 1.80 2010/02/20 10:16:30 rubikitch ;; * `ac-new-input-source': remove unnecessary attributes ;; * version check ;; ;; Revision 1.79 2010/02/06 23:38:21 rubikitch ;; * `alcs-update-restart': use `anything-update' instead ;; * Minor fix in `anything-execute-extended-command-sources' ;; ;; Revision 1.78 2010/02/04 19:27:07 rubikitch ;; Added docstrings ;; ;; Revision 1.77 2010/01/29 09:20:33 rubikitch ;; update Copyright ;; ;; Revision 1.76 2010/01/29 09:19:21 rubikitch ;; New option: `anything-execute-extended-command-use-kyr' ;; ;; Revision 1.75 2010/01/29 09:15:24 rubikitch ;; Make `anything-execute-extended-command' faster ;; * eliminate "Commands (by prefix)", which makes it slow down ;; * `C-c C-u' to update commands instead ;; ;; Revision 1.74 2010/01/23 04:18:18 rubikitch ;; `ac-new-input-source': temporarily disable shortcuts ;; ;; Revision 1.73 2009/12/25 01:35:59 rubikitch ;; Adjust `anything-noresume' to latest version of `anything' ;; ;; Revision 1.72 2009/12/14 00:13:28 rubikitch ;; New command: `alcs-update-restart' ;; ;; Pressing `C-c C-u' in `anything-lisp-complete-symbol' and `anything-lisp-complete-symbol-partial-match' recollects symbols and reexecutes this command. ;; ;; Revision 1.71 2009/12/13 23:34:19 rubikitch ;; Show timestamp of lisp symbols ;; ;; Revision 1.70 2009/12/13 23:17:18 rubikitch ;; Make alcs-make-candidates timer singleton ;; ;; Revision 1.69 2009/12/13 23:06:34 rubikitch ;; New variable `anything-lisp-complete-symbol-add-space-on-startup': ;; ;; If non-nil, `anything-lisp-complete-symbol' and `anything-lisp-complete-symbol-partial-match' adds space on startup. ;; It utilizes anything-match-plugin's feature. ;; ;; Revision 1.68 2009/11/11 19:01:09 rubikitch ;; Bug fix when completing at right side ;; ;; Revision 1.67 2009/11/11 18:03:49 rubikitch ;; New implementation of `alcs-current-physical-column' ;; ;; Revision 1.66 2009/10/26 09:38:39 rubikitch ;; `anything-completing-read': Show default source first when require-match and default is specified. ;; ;; Revision 1.65 2009/10/22 08:54:58 rubikitch ;; `anything-complete-shell-history-setup-key': Use `minibuffer-local-shell-command-map' if any ;; ;; Revision 1.64 2009/10/13 05:40:51 rubikitch ;; `anything-completing-read': Show completions first when require-match == t ;; ;; Revision 1.63 2009/10/11 20:27:22 rubikitch ;; `alcs-transformer-prepend-spacer': use physical column instead of logical column ;; ;; Revision 1.62 2009/10/10 03:27:33 rubikitch ;; New variable: `anything-complete-sort-candidates' ;; ;; Revision 1.61 2009/10/08 17:06:35 rubikitch ;; `anything-complete-shell-history': taller window ;; ;; Revision 1.60 2009/10/08 05:12:27 rubikitch ;; If anything-show-completion.el is available, candidates are shown near the point. ;; ;; Revision 1.59 2009/10/07 10:29:34 rubikitch ;; `anything-find-file': use `anything-other-buffer' instead of `anything-complete' ;; ;; Revision 1.58 2009/10/01 03:07:44 rubikitch ;; Fix an error in `anything-find-file'. Thanks to troter. ;; http://d.hatena.ne.jp/troter/20090929/1254199115 ;; ;; Revision 1.57 2009/08/02 04:19:52 rubikitch ;; New variable: `anything-complete-persistent-action' ;; ;; Revision 1.56 2009/07/26 21:25:04 rubikitch ;; New variable: `anything-completing-read-use-default' ;; New variable: `anything-completing-read-history-first' ;; `anything-completing-read', `anything-read-file-name': history order bug fix ;; ;; Revision 1.55 2009/07/19 07:33:33 rubikitch ;; `anything-execute-extended-command': adjust to keyboard macro command ;; ;; Revision 1.54 2009/06/29 15:13:02 rubikitch ;; New function: `anything-complete-shell-history-setup-key' ;; ;; Revision 1.53 2009/06/24 15:37:50 rubikitch ;; `anything-c-source-complete-shell-history': require bug fix ;; ;; Revision 1.52 2009/05/30 05:04:30 rubikitch ;; Set `anything-execute-action-at-once-if-one' to t ;; ;; Revision 1.51 2009/05/25 18:57:22 rubikitch ;; Removed experimental tags ;; ;; Revision 1.50 2009/05/06 12:34:45 rubikitch ;; `anything-complete': target is default input. ;; ;; Revision 1.49 2009/05/04 14:51:18 rubikitch ;; use `define-anything-type-attribute' to add `anything-type-attributes' entry. ;; ;; Revision 1.48 2009/05/03 19:07:22 rubikitch ;; anything-complete: `enable-recursive-minibuffers' = t ;; ;; Revision 1.47 2009/05/03 18:42:23 rubikitch ;; Remove *-partial-match sources. ;; They are aliased for compatibility. ;; ;; Revision 1.46 2009/05/03 18:33:35 rubikitch ;; Remove dependency of `ac-candidates-in-buffer' ;; ;; Revision 1.45 2009/04/20 16:24:33 rubikitch ;; Set anything-samewindow to nil for in-buffer completion. ;; ;; Revision 1.44 2009/04/18 10:07:35 rubikitch ;; * auto-document. ;; * Use anything-show-completion.el if available. ;; ;; Revision 1.43 2009/02/27 14:45:26 rubikitch ;; Fix a read-only bug in `alcs-make-candidates'. ;; ;; Revision 1.42 2009/02/19 23:04:33 rubikitch ;; * update doc ;; * use anything-kyr if any ;; ;; Revision 1.41 2009/02/19 22:54:29 rubikitch ;; refactoring ;; ;; Revision 1.40 2009/02/06 09:19:08 rubikitch ;; Fix a bug when 2nd argument of `anything-read-file-name' (DIR) is not a directory. ;; ;; Revision 1.39 2009/01/28 20:33:31 rubikitch ;; add persistent-action for `anything-read-file-name' and `anything-read-buffer'. ;; ;; Revision 1.38 2009/01/08 19:28:33 rubikitch ;; `anything-completing-read': fixed a bug when COLLECTION is a non-nested list. ;; ;; Revision 1.37 2009/01/02 15:08:03 rubikitch ;; `anything-execute-extended-command': show commands which are not collected. ;; ;; Revision 1.36 2008/11/27 08:12:36 rubikitch ;; `anything-read-buffer': accept empty buffer name ;; ;; Revision 1.35 2008/11/02 06:30:06 rubikitch ;; `anything-execute-extended-command': fixed a bug ;; ;; Revision 1.34 2008/10/30 18:45:27 rubikitch ;; `arfn-sources': use `file-name-history' instead ;; ;; Revision 1.33 2008/10/30 16:39:17 rubikitch ;; *** empty log message *** ;; ;; Revision 1.32 2008/10/30 11:09:17 rubikitch ;; New command: `anything-find-file' ;; ;; Revision 1.31 2008/10/30 10:29:56 rubikitch ;; `ac-new-input-source', `ac-default-source', `acr-sources', `arfn-sources', `arb-sources': changed args ;; ;; Revision 1.30 2008/10/30 09:33:50 rubikitch ;; `anything-execute-extended-command': fixed a bug ;; ;; Revision 1.29 2008/10/27 10:55:55 rubikitch ;; New command: `anything-execute-extended-command' ;; ;; Revision 1.28 2008/10/27 10:41:33 rubikitch ;; use linkd tag (no code change) ;; ;; Revision 1.27 2008/10/21 18:02:39 rubikitch ;; `anything-noresume': restore `anything-last-buffer' ;; ;; Revision 1.26 2008/10/03 09:55:45 rubikitch ;; anything-read-file-name bug fix ;; ;; Revision 1.25 2008/09/30 22:49:22 rubikitch ;; `anything-completing-read': handle empty input. ;; ;; Revision 1.24 2008/09/22 09:15:03 rubikitch ;; *** empty log message *** ;; ;; Revision 1.23 2008/09/22 09:12:42 rubikitch ;; set `anything-input-idle-delay'. ;; ;; Revision 1.22 2008/09/20 20:27:46 rubikitch ;; s/anything-attr/anything-attr-defined/ because of `anything-attr' change ;; ;; Revision 1.21 2008/09/15 17:31:34 rubikitch ;; *** empty log message *** ;; ;; Revision 1.20 2008/09/14 15:20:12 rubikitch ;; set `anything-input-idle-delay'. ;; ;; Revision 1.19 2008/09/12 02:56:33 rubikitch ;; Complete functions using `anything' restore `anything-last-sources' ;; and `anything-compiled-sources' now, because resuming ;; `anything'-complete session is useless. ;; ;; Revision 1.18 2008/09/10 23:27:09 rubikitch ;; Use *anything complete* buffer instead ;; ;; Revision 1.17 2008/09/10 09:59:22 rubikitch ;; arfn-sources: bug fix ;; ;; Revision 1.16 2008/09/10 09:40:31 rubikitch ;; arfn-sources: paren bug fix ;; ;; Revision 1.15 2008/09/09 01:19:49 rubikitch ;; add (require 'shell-history) ;; ;; Revision 1.14 2008/09/05 13:59:39 rubikitch ;; bugfix ;; ;; Revision 1.13 2008/09/05 13:50:14 rubikitch ;; * Use `keyboard-quit' when anything-read-* is quit. ;; * Change keybinding of `anything-read-file-name-follow-directory' to Tab ;; * `anything-read-file-name-follow-directory': smarter behavior ;; ;; Revision 1.12 2008/09/05 12:46:27 rubikitch ;; bugfix ;; ;; Revision 1.11 2008/09/05 03:15:26 rubikitch ;; *** empty log message *** ;; ;; Revision 1.10 2008/09/05 01:49:56 rubikitch ;; `anything-completing-read' supports list collection only. ;; ;; Revision 1.9 2008/09/05 00:09:46 rubikitch ;; New functions: moved from anything.el ;; `anything-completing-read', `anything-read-file-name', `anything-read-buffer', ;; `anything-read-variable', `anything-read-command', `anything-read-string-mode'. ;; ;; Revision 1.8 2008/09/04 16:54:59 rubikitch ;; add commentary ;; ;; Revision 1.7 2008/09/04 08:36:08 rubikitch ;; fixed a bug when `symbol-at-point' is nil. ;; ;; Revision 1.6 2008/09/04 08:29:40 rubikitch ;; remove unneeded code. ;; ;; Revision 1.5 2008/09/04 08:12:05 rubikitch ;; absorb anything-lisp-complete-symbol.el v1.13. ;; ;; Revision 1.4 2008/09/04 07:36:23 rubikitch ;; Use type plug-in instead. ;; ;; Revision 1.3 2008/09/03 04:13:23 rubikitch ;; `anything-c-source-complete-shell-history': deleted requires-pattern ;; ;; Revision 1.2 2008/09/01 22:27:45 rubikitch ;; *** empty log message *** ;; ;; Revision 1.1 2008/09/01 22:23:55 rubikitch ;; Initial revision ;; ;;; Code: (defvar anything-complete-version "$Id: anything-complete.el,v 1.86 2010-03-31 23:14:13 rubikitch Exp $") (require 'anything-match-plugin) (require 'thingatpt) ;; version check (let ((version "1.263")) (when (and (string= "1." (substring version 0 2)) (string-match "1\.\\([0-9]+\\)" anything-version) (< (string-to-number (match-string 1 anything-version)) (string-to-number (substring version 2)))) (error "Please update anything.el!! http://www.emacswiki.org/cgi-bin/wiki/download/anything.el or M-x install-elisp-from-emacswiki anything.el"))) ;; (@* "overlay") (when (require 'anything-show-completion nil t) (dolist (f '(anything-complete anything-lisp-complete-symbol anything-lisp-complete-symbol-partial-match)) (use-anything-show-completion f '(length anything-complete-target)))) ;; (@* "core") (defvar anything-complete-target "") (defun ac-insert (candidate) (let ((pt (point))) (when (and (search-backward anything-complete-target nil t) (string= (buffer-substring (point) pt) anything-complete-target)) (delete-region (point) pt))) (insert candidate)) (define-anything-type-attribute 'complete '((candidates-in-buffer) (action . ac-insert))) ;; Warning: I'll change this function's interface. DON'T USE IN YOUR PROGRAM! (defun anything-noresume (&optional any-sources any-input any-prompt any-resume any-preselect any-buffer) (let (anything-last-sources anything-compiled-sources anything-last-buffer) (anything any-sources any-input any-prompt 'noresume any-preselect any-buffer))) (defun anything-complete (sources target &optional limit idle-delay input-idle-delay) "Basic completion interface using `anything'." (let ((anything-candidate-number-limit (or limit anything-candidate-number-limit)) (anything-idle-delay (or idle-delay anything-idle-delay)) (anything-input-idle-delay (or input-idle-delay anything-input-idle-delay)) (anything-complete-target target) (anything-execute-action-at-once-if-one t) (enable-recursive-minibuffers t) anything-samewindow) (anything-noresume sources target nil nil nil "*anything complete*"))) ;; (@* "`lisp-complete-symbol' and `apropos' replacement") (defvar anything-lisp-complete-symbol-input-idle-delay 0.1 "`anything-input-idle-delay' for `anything-lisp-complete-symbol', `anything-lisp-complete-symbol-partial-match' and `anything-apropos'.") (defvar anything-lisp-complete-symbol-add-space-on-startup t "If non-nil, `anything-lisp-complete-symbol' and `anything-lisp-complete-symbol-partial-match' adds space on startup. It utilizes anything-match-plugin's feature.") (defun alcs-create-buffer (name) (let ((b (get-buffer-create name))) (with-current-buffer b (buffer-disable-undo) (erase-buffer) b))) (defvar alcs-variables-buffer " *variable symbols*") (defvar alcs-functions-buffer " *function symbols*") (defvar alcs-commands-buffer " *command symbols*") (defvar alcs-faces-buffer " *face symbols*") (defvar alcs-symbol-buffer " *other symbols*") (defvar alcs-symbols-time nil "Timestamp of collected symbols") (defun alcs-make-candidates () (message "Collecting symbols...") ;; To ignore read-only property. (let ((inhibit-read-only t)) (setq alcs-symbols-time (current-time)) (alcs-create-buffer alcs-variables-buffer) (alcs-create-buffer alcs-functions-buffer) (alcs-create-buffer alcs-commands-buffer) (alcs-create-buffer alcs-faces-buffer) (alcs-create-buffer alcs-symbol-buffer) (mapatoms (lambda (sym) (let ((name (symbol-name sym)) (bp (boundp sym)) (fbp (fboundp sym))) (cond ((commandp sym) (set-buffer alcs-commands-buffer) (insert name "\n")) (fbp (set-buffer alcs-functions-buffer) (insert name "\n"))) (cond (bp (set-buffer alcs-variables-buffer) (insert name "\n"))) (cond ((facep sym) (set-buffer alcs-faces-buffer) (insert name "\n")) ((not (or bp fbp)) (set-buffer alcs-symbol-buffer) (insert name "\n"))))))) (message "Collecting symbols...done")) (defun alcs-header-name (name) (format "%s at %s (Press `C-c C-u' to update)" name (format-time-string "%H:%M:%S" alcs-symbols-time))) (defvar alcs-make-candidates-timer nil) (defun anything-lisp-complete-symbol-set-timer (update-period) "Update Emacs symbols list when Emacs is idle, used by `anything-lisp-complete-symbol-set-timer' and `anything-apropos'" (when alcs-make-candidates-timer (cancel-timer alcs-make-candidates-timer)) (setq alcs-make-candidates-timer (run-with-idle-timer update-period t 'alcs-make-candidates))) (defvar alcs-physical-column-at-startup nil) (defun alcs-init (bufname) (declare (special anything-dabbrev-last-target)) (setq alcs-physical-column-at-startup nil) (setq anything-complete-target (if (loop for src in (anything-get-sources) thereis (string-match "^dabbrev" (assoc-default 'name src))) anything-dabbrev-last-target (anything-aif (symbol-at-point) (symbol-name it) ""))) (anything-candidate-buffer (get-buffer bufname))) (defcustom anything-complete-sort-candidates nil "*Whether to sort completion candidates." :type 'boolean :group 'anything-complete) (defcustom anything-execute-extended-command-use-kyr t "*Use `anything-kyr' (context-aware commands) in `anything-execute-extended-command'. " :type 'boolean :group 'anything-complete) (defun alcs-sort-maybe (candidates source) (if anything-complete-sort-candidates (sort candidates #'string<) candidates)) (defun alcs-fontify-face (candidates source) (mapcar (lambda (facename) (propertize facename 'face (intern-soft facename))) candidates)) ;;; borrowed from pulldown.el (defun alcs-current-physical-column () "Current physical column. (not logical column)" ;; (- (point) (save-excursion (vertical-motion 0) (point))) (car (posn-col-row (posn-at-point)))) (defun alcs-transformer-prepend-spacer (candidates source) "Prepend spaces according to `current-column' for each CANDIDATES." (setq alcs-physical-column-at-startup (or alcs-physical-column-at-startup (with-current-buffer anything-current-buffer (save-excursion (backward-char (string-width anything-complete-target)) (alcs-current-physical-column))))) (mapcar (lambda (cand) (cons (concat (make-string alcs-physical-column-at-startup ? ) cand) cand)) candidates)) (defun alcs-transformer-prepend-spacer-maybe (candidates source) ;; `anything-show-completion-activate' is defined in anything-show-completion.el (if (and (boundp 'anything-show-completion-activate) anything-show-completion-activate) (alcs-transformer-prepend-spacer candidates source) candidates)) (defun alcs-describe-function (name) (describe-function (anything-c-symbolify name))) (defun alcs-describe-variable (name) (describe-variable (anything-c-symbolify name))) (defun alcs-describe-face (name) (describe-face (anything-c-symbolify name))) (defun alcs-customize-face (name) (customize-face (anything-c-symbolify name))) (defun alcs-find-function (name) (find-function (anything-c-symbolify name))) (defun alcs-find-variable (name) (find-variable (anything-c-symbolify name))) (defvar anything-c-source-complete-emacs-functions '((name . "Functions") (init . (lambda () (alcs-init alcs-functions-buffer))) (candidates-in-buffer) (type . complete-function))) (defvar anything-c-source-complete-emacs-commands '((name . "Commands") (init . (lambda () (alcs-init alcs-commands-buffer))) (candidates-in-buffer) (type . complete-function))) (defvar anything-c-source-complete-emacs-variables '((name . "Variables") (init . (lambda () (alcs-init alcs-variables-buffer))) (candidates-in-buffer) (type . complete-variable))) (defvar anything-c-source-complete-emacs-faces '((name . "Faces") (init . (lambda () (alcs-init alcs-faces-buffer))) (candidates-in-buffer) (type . complete-face))) (defvar anything-c-source-complete-emacs-other-symbols '((name . "Other Symbols") (init . (lambda () (alcs-init alcs-symbol-buffer))) (candidates-in-buffer) (filtered-candidate-transformer . alcs-sort-maybe) (action . ac-insert))) (defvar anything-c-source-apropos-emacs-functions '((name . "Apropos Functions") (init . (lambda () (alcs-init alcs-functions-buffer))) (candidates-in-buffer) (requires-pattern . 3) (type . apropos-function))) (defvar anything-c-source-apropos-emacs-commands '((name . "Apropos Commands") (init . (lambda () (alcs-init alcs-commands-buffer))) (candidates-in-buffer) (requires-pattern . 3) (type . apropos-function))) (defvar anything-c-source-apropos-emacs-variables '((name . "Apropos Variables") (init . (lambda () (alcs-init alcs-variables-buffer))) (candidates-in-buffer) (requires-pattern . 3) (type . apropos-variable))) (defvar anything-c-source-apropos-emacs-faces '((name . "Apropos Faces") (init . (lambda () (alcs-init alcs-faces-buffer))) (candidates-in-buffer) (requires-pattern . 3) (type . apropos-face))) (defvar anything-c-source-emacs-function-at-point '((name . "Function at point") (candidates . (lambda () (with-current-buffer anything-current-buffer (anything-aif (function-called-at-point) (list (symbol-name it)))))) (type . apropos-function))) (defvar anything-c-source-emacs-variable-at-point '((name . "Variable at point") (candidates . (lambda () (with-current-buffer anything-current-buffer (anything-aif (variable-at-point) (unless (equal 0 it) (list (symbol-name it))))))) (type . apropos-variable))) (defvar anything-c-source-emacs-face-at-point '((name . "Face at point") (candidates . (lambda () (with-current-buffer anything-current-buffer (anything-aif (face-at-point) (unless (equal 0 it) (list (symbol-name it))))))) (type . apropos-variable))) (defvar anything-lisp-complete-symbol-sources '(anything-c-source-complete-anything-attributes anything-c-source-complete-emacs-commands anything-c-source-complete-emacs-functions anything-c-source-complete-emacs-variables anything-c-source-complete-emacs-faces)) (defvar anything-apropos-sources '(anything-c-source-apropos-emacs-commands anything-c-source-apropos-emacs-functions anything-c-source-apropos-emacs-variables anything-c-source-apropos-emacs-faces)) (define-anything-type-attribute 'apropos-function '((filtered-candidate-transformer . alcs-sort-maybe) (header-name . alcs-header-name) (persistent-action . alcs-describe-function) (update . alcs-make-candidates) (action ("Describe Function" . alcs-describe-function) ("Find Function" . alcs-find-function)))) (define-anything-type-attribute 'apropos-variable '((filtered-candidate-transformer . alcs-sort-maybe) (header-name . alcs-header-name) (persistent-action . alcs-describe-variable) (update . alcs-make-candidates) (action ("Describe Variable" . alcs-describe-variable) ("Find Variable" . alcs-find-variable)))) (define-anything-type-attribute 'apropos-face '((filtered-candidate-transformer alcs-sort-maybe alcs-fontify-face) (get-line . buffer-substring) (header-name . alcs-header-name) (update . alcs-make-candidates) (persistent-action . alcs-describe-face) (action ("Customize Face" . alcs-customize-face) ("Describe Face" . alcs-describe-face)))) (define-anything-type-attribute 'complete-function '((filtered-candidate-transformer alcs-sort-maybe alcs-transformer-prepend-spacer-maybe) (header-name . alcs-header-name) (action . ac-insert) (update . alcs-make-candidates) (persistent-action . alcs-describe-function))) (define-anything-type-attribute 'complete-variable '((filtered-candidate-transformer alcs-sort-maybe alcs-transformer-prepend-spacer-maybe) (header-name . alcs-header-name) (action . ac-insert) (update . alcs-make-candidates) (persistent-action . alcs-describe-variable))) (define-anything-type-attribute 'complete-face '((filtered-candidate-transformer alcs-sort-maybe alcs-transformer-prepend-spacer-maybe) (header-name . alcs-header-name) (action . ac-insert) (update . alcs-make-candidates) (persistent-action . alcs-describe-face))) (defvar alcs-this-command nil) (defun* anything-lisp-complete-symbol-1 (update sources input &optional (buffer "*anything complete*")) (setq alcs-this-command this-command) (when (or update (null (get-buffer alcs-variables-buffer))) (alcs-make-candidates)) (let (anything-samewindow (anything-input-idle-delay (or anything-lisp-complete-symbol-input-idle-delay anything-input-idle-delay))) (funcall (if (equal buffer "*anything complete*") 'anything-noresume 'anything) sources input nil nil nil buffer))) ;; Test alcs-update-restart (with-current-buffer alcs-commands-buffer (erase-buffer)) ;; Test alcs-update-restart (kill-buffer alcs-commands-buffer) (defun alcs-update-restart () "Update lisp symbols and restart current `anything' session." (interactive) (alcs-make-candidates) (anything-update)) (defun alcs-initial-input (partial-match) (anything-aif (symbol-at-point) (format "%s%s%s" (if partial-match "" "^") it (if anything-lisp-complete-symbol-add-space-on-startup " " "")) "")) (defun anything-lisp-complete-symbol (update) "`lisp-complete-symbol' replacement using `anything'." (interactive "P") (anything-lisp-complete-symbol-1 update anything-lisp-complete-symbol-sources (alcs-initial-input nil))) (defun anything-lisp-complete-symbol-partial-match (update) "`lisp-complete-symbol' replacement using `anything' (partial match)." (interactive "P") (anything-lisp-complete-symbol-1 update anything-lisp-complete-symbol-sources (alcs-initial-input t))) (defun anything-apropos (update) "`apropos' replacement using `anything'." (interactive "P") (anything-lisp-complete-symbol-1 update anything-apropos-sources nil "*anything apropos*")) ;; (@* "anything attribute completion") (defvar anything-c-source-complete-anything-attributes '((name . "Anything Attributes") (candidates . acaa-candidates) (action . ac-insert) (persistent-action . acaa-describe-anything-attribute) (filtered-candidate-transformer alcs-sort-maybe alcs-transformer-prepend-spacer-maybe) (header-name . alcs-header-name) (action . ac-insert))) ;; (anything 'anything-c-source-complete-anything-attributes) (defun acaa-describe-anything-attribute (str) (anything-describe-anything-attribute (anything-c-symbolify str))) (defun acaa-candidates () (with-current-buffer anything-current-buffer (when (and (require 'yasnippet nil t) (acaa-completing-attribute-p (point))) (mapcar 'symbol-name anything-additional-attributes)))) (defvar acaa-anything-commands-regexp (concat "(" (regexp-opt '("anything" "anything-other-buffer")) " ")) (defun acaa-completing-attribute-p (point) (save-excursion (goto-char point) (ignore-errors (or (save-excursion (backward-up-list 3) (looking-at (concat "(defvar anything-c-source-" "\\|" acaa-anything-commands-regexp))) (save-excursion (backward-up-list 4) (looking-at acaa-anything-commands-regexp)))))) ;; (anything '(ini ;;;; 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 "acaa-completing-attribute-p") (expect t (with-temp-buffer (insert "(anything '(((na") (acaa-completing-attribute-p (point)))) (expect t (with-temp-buffer (insert "(anything '((na") (acaa-completing-attribute-p (point)))) (expect nil (with-temp-buffer (insert "(anything-hoge '((na") (acaa-completing-attribute-p (point)))) (expect nil (with-temp-buffer (insert "(anything-hoge '(((na") (acaa-completing-attribute-p (point)))) (expect t (with-temp-buffer (insert "(defvar anything-c-source-hoge '((na") (acaa-completing-attribute-p (point)))) ))) ;; (@* "anything-read-string-mode / read-* compatibility functions") ;; moved from anything.el (defun anything-compile-source--default-value (source) (anything-aif (assoc-default 'default-value source) (append source `((candidates ,it) (filtered-candidate-transformer . (lambda (cands source) (if (string= anything-pattern "") cands nil))))) source)) (add-to-list 'anything-compile-source-functions 'anything-compile-source--default-value) (defun ac-new-input-source (prompt require-match &optional additional-attrs) (unless require-match `((name . ,prompt) (dummy) ,@additional-attrs))) (defun* ac-default-source (default &optional accept-empty (additional-attrs '((action . identity)))) `((name . "Default") (default-value . ,(or default (and accept-empty ""))) ,@additional-attrs ,(if accept-empty '(accept-empty)))) ;; (ac-default-source "a") ;; (ac-default-source "a" t) ;; (ac-default-source nil t) ;; (ac-default-source nil) ;; (@* "`completing-read' compatible read function ") (defvar anything-use-original-function nil "If non-nil, use original implementation not anything version.") (defun anything-completing-read (prompt collection &optional predicate require-match initial hist default inherit-input-method) (if (or anything-use-original-function (arrayp collection) (functionp collection)) (anything-old-completing-read prompt collection predicate require-match initial hist default inherit-input-method) ;; support only collection list. (setq hist (or (car-safe hist) hist)) (let* (anything-input-idle-delay (result (or (anything-noresume (acr-sources prompt collection predicate require-match initial hist default inherit-input-method) initial prompt nil nil "*anything complete*") (keyboard-quit)))) (when (stringp result) (prog1 result (setq hist (or hist 'minibuffer-history)) (set hist (cons result (ignore-errors (delete result (symbol-value hist)))))))))) ;; TODO obarray/predicate hacks: command/variable/symbol (defvar anything-completing-read-use-default t "Whether to use default value source.") (defvar anything-completing-read-history-first nil "Whether to display history source first.") (defvar anything-complete-persistent-action nil "Persistent action function used by `anything-completing-read'. It accepts one argument, selected candidate.") (defun* acr-sources (prompt collection predicate require-match initial hist default inherit-input-method &optional (additional-attrs '((action . identity)))) "`anything' replacement for `completing-read'." (let* ((transformer-func (if predicate `(candidate-transformer . (lambda (cands) (remove-if-not (lambda (c) (,predicate (if (listp c) (car c) c))) cands))))) (persistent-action (if anything-complete-persistent-action '(persistent-action . (lambda (cand) (funcall anything-complete-persistent-action cand))))) (new-input-source (ac-new-input-source prompt require-match additional-attrs)) (histvar (or hist 'minibuffer-history)) (history-source (when (and (boundp histvar) (not require-match)) `((name . "History") (candidates . ,histvar) ,persistent-action ,@additional-attrs))) (default-source (and anything-completing-read-use-default (ac-default-source default t))) (main-source `((name . "Completions") (candidates . ,(mapcar (lambda (x) (or (car-safe x) x)) collection)) ,@additional-attrs ,persistent-action ,transformer-func))) (cond ((and require-match default) (list default-source main-source)) (require-match (list main-source default-source)) (anything-completing-read-history-first (list default-source history-source main-source new-input-source)) (t (list default-source main-source history-source new-input-source))))) ;; (anything-completing-read "Command: " obarray 'commandp t) ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil nil nil 'hoge-history) ;; hoge-history ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil nil nil) ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil t) ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil t nil nil "foo") ;; (let ((anything-complete-persistent-action 'message)) (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil t)) ;; (anything-old-completing-read "Test: " '(("hoge")("foo")("bar")) nil t) ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil nil "f" nil) ;; (completing-read "Test: " '(("hoge")("foo")("bar")) nil nil "f" nil nil t) ;; (anything-completing-read "Test: " '(("hoge")("foo")("bar")) nil nil nil nil "nana") ;; (anything-completing-read "Test: " '("hoge" "foo" "bar")) ;; (@* "`read-file-name' compatible read function ") (defvar anything-read-file-name-map nil) (defvar arfn-followed nil) (defvar arfn-dir nil) (defun anything-read-file-name-map () "Lazy initialization of `anything-read-file-name-map'." (unless anything-read-file-name-map (setq anything-read-file-name-map (copy-keymap anything-map)) (define-key anything-read-file-name-map "\C-i" 'anything-read-file-name-follow-directory) (define-key anything-read-file-name-map [tab] 'anything-read-file-name-follow-directory)) anything-read-file-name-map) (defun anything-read-file-name-follow-directory () "Follow directory in `anything-read-file-name'." (interactive) ;; These variables are bound by `arfn-sources' or `anything-find-file'. (declare (special prompt default-filename require-match predicate additional-attrs)) (setq arfn-followed t) (let* ((sel (anything-get-selection)) (f (expand-file-name sel arfn-dir))) (cond ((and (file-directory-p f) (not (string-match "/\\.$" sel))) (with-selected-window (minibuffer-window) (delete-minibuffer-contents)) (setq anything-pattern "") ;;(setq arfn-dir f) (anything-set-sources (arfn-sources prompt f default-filename require-match nil predicate additional-attrs)) (anything-update)) ((string-match "^\\(.+\\)/\\([^/]+\\)$" sel) (with-selected-window (minibuffer-window) (delete-minibuffer-contents) (insert (match-string 2 sel))) (anything-set-sources (arfn-sources prompt (expand-file-name (match-string 1 sel) arfn-dir) nil require-match (match-string 2 sel) predicate additional-attrs)) (anything-update))))) (defun* anything-read-file-name (prompt &optional dir default-filename require-match initial-input predicate (additional-attrs '((action . identity)))) "`anything' replacement for `read-file-name'." (setq arfn-followed nil) (let* ((anything-map (anything-read-file-name-map)) anything-input-idle-delay (result (or (anything-noresume (arfn-sources prompt dir default-filename require-match initial-input predicate additional-attrs) initial-input prompt nil nil "*anything complete*") (keyboard-quit)))) (when (and require-match (not (and (file-exists-p result) (funcall (or predicate 'identity) result)))) (error "anything-read-file-name: file `%s' is not matched" result)) (when (stringp result) (prog1 result (add-to-list 'file-name-history result) (setq file-name-history (cons result (delete result file-name-history))))))) (defun arfn-candidates (dir) (if (file-directory-p dir) (loop for (f _ _ _ _ _ _ _ _ perm _ _ _) in (directory-files-and-attributes dir t) for basename = (file-name-nondirectory f) when (string= "d" (substring perm 0 1)) collect (cons (concat basename "/") f) else collect (cons basename f)))) (defun* arfn-sources (prompt dir default-filename require-match initial-input predicate &optional (additional-attrs '((action . identity)))) (setq arfn-dir dir) (let* ((dir (or dir default-directory)) (transformer-func (if predicate `(candidate-transformer . (lambda (cands) (remove-if-not (lambda (c) (,predicate (if (consp c) (cdr c) c))) cands))))) (new-input-source (ac-new-input-source prompt nil (append '((display-to-real . (lambda (f) (expand-file-name f arfn-dir)))) additional-attrs))) (history-source (unless require-match `((name . "History") (candidates . file-name-history) (persistent-action . find-file) ,@additional-attrs)))) `(((name . "Default") (candidates . ,(if default-filename (list default-filename))) (persistent-action . find-file) (filtered-candidate-transformer . (lambda (cands source) (if (and (not arfn-followed) (string= anything-pattern "")) cands nil))) (display-to-real . (lambda (f) (expand-file-name f ,dir))) ,@additional-attrs) ((name . ,dir) (candidates . (lambda () (arfn-candidates ,dir))) (persistent-action . find-file) ,@additional-attrs ,transformer-func) ,new-input-source ,history-source))) ;; (anything-read-file-name "file: " "~" ".emacs") ;; (anything-read-file-name "file: " "~" ".emacs" t) ;; (anything-read-file-name "file: " "~" ) ;; (anything-read-file-name "file: ") ;; (read-file-name "file: " "/tmp") ;; (@* "`read-buffer' compatible read function ") (defun anything-read-buffer (prompt &optional default require-match start matches-set) "`anything' replacement for `read-buffer'." (let (anything-input-idle-delay) (or (anything-noresume (arb-sources prompt (if (bufferp default) (buffer-name default) default) require-match start matches-set) start prompt nil nil "*anything complete*") (keyboard-quit)))) (defun* arb-sources (prompt default require-match start matches-set &optional (additional-attrs '((action . identity)))) `(,(ac-default-source default t) ((name . ,prompt) (persistent-action . switch-to-buffer) (candidates . (lambda () (mapcar 'buffer-name (buffer-list)))) ,@additional-attrs) ,(ac-new-input-source prompt require-match additional-attrs))) ;; (anything-read-buffer "test: " nil) ;; (anything-read-buffer "test: " "*scratch*" t) ;; (anything-read-buffer "test: " "*scratch*" t "*") ;; (read-variable "variable: " "find-file-hooks") ;; (read-variable "variable: " 'find-file-hooks) ;; (read-variable "variable: " ) (defun anything-read-symbol-1 (prompt buffer default-value) (let (anything-input-idle-delay anything-samewindow) (intern (or (anything-noresume `(,(ac-default-source (if default-value (format "%s" default-value))) ((name . ,prompt) (init . (lambda () (alcs-init ,buffer))) (candidates-in-buffer) (action . identity))) nil prompt nil nil "*anything complete*") (keyboard-quit))))) ;; (@* "`read-variable' compatible read function ") (defun anything-read-variable (prompt &optional default-value) (anything-read-symbol-1 prompt alcs-variables-buffer default-value)) ;; (anything-read-variable "variable: " 'find-file-hooks) ;; (@* "`read-command' compatible read function ") (defun anything-read-command (prompt &optional default-value) (anything-read-symbol-1 prompt alcs-commands-buffer default-value)) ;; (anything-read-variable "command: ") ;; (@* "`anything-read-string-mode' initialization") (defvar anything-read-string-mode nil) (unless anything-read-string-mode (defalias 'anything-old-completing-read (symbol-function 'completing-read)) (defalias 'anything-old-read-file-name (symbol-function 'read-file-name)) (defalias 'anything-old-read-buffer (symbol-function 'read-buffer)) (defalias 'anything-old-read-variable (symbol-function 'read-variable)) (defalias 'anything-old-read-command (symbol-function 'read-command)) (put 'anything-read-string-mode 'orig-read-buffer-function read-buffer-function)) ;; (progn (anything-read-string-mode -1) anything-read-string-mode) ;; (progn (anything-read-string-mode 1) anything-read-string-mode) ;; (progn (anything-read-string-mode 0) anything-read-string-mode) ;; (progn (anything-read-string-mode '(string buffer variable command)) anything-read-string-mode) (defvar anything-read-string-mode-flags '(string file buffer variable command) "Saved ARG of `anything-read-string-mode'.") (defun anything-read-string-mode (arg) "If this minor mode is on, use `anything' version of `completing-read' and `read-file-name'. ARG also accepts a symbol list. The elements are: string: replace `completing-read' file: replace `read-file-name' and `find-file' buffer: replace `read-buffer' variable: replace `read-variable' command: replace `read-command' and M-x So, (anything-read-string-mode 1) and (anything-read-string-mode '(string file buffer variable command) are identical." (interactive "P") (when (consp anything-read-string-mode) (anything-read-string-mode-uninstall)) (setq anything-read-string-mode (cond ((consp arg) (setq anything-read-string-mode-flags arg)) ; not interactive (arg (> (prefix-numeric-value arg) 0)) ; C-u M-x (t (not anything-read-string-mode)))) ; M-x (when (eq anything-read-string-mode t) (setq anything-read-string-mode anything-read-string-mode-flags)) (if anything-read-string-mode (anything-read-string-mode-install) (anything-read-string-mode-uninstall))) (defun anything-read-string-mode-install () ;; redefine to anything version (when (memq 'string anything-read-string-mode) (defalias 'completing-read (symbol-function 'anything-completing-read))) (when (memq 'file anything-read-string-mode) (defalias 'read-file-name (symbol-function 'anything-read-file-name)) (substitute-key-definition 'find-file 'anything-find-file global-map)) (when (memq 'buffer anything-read-string-mode) (setq read-buffer-function 'anything-read-buffer) (defalias 'read-buffer (symbol-function 'anything-read-buffer))) (when (memq 'variable anything-read-string-mode) (defalias 'read-variable (symbol-function 'anything-read-variable))) (when (memq 'command anything-read-string-mode) (defalias 'read-command (symbol-function 'anything-read-command)) (substitute-key-definition 'execute-extended-command 'anything-execute-extended-command global-map)) (message "Installed anything version of read functions.")) (defun anything-read-string-mode-uninstall () ;; restore to original version (defalias 'completing-read (symbol-function 'anything-old-completing-read)) (defalias 'read-file-name (symbol-function 'anything-old-read-file-name)) (setq read-buffer-function (get 'anything-read-string-mode 'orig-read-buffer-function)) (defalias 'read-buffer (symbol-function 'anything-old-read-buffer)) (defalias 'read-variable (symbol-function 'anything-old-read-variable)) (defalias 'read-command (symbol-function 'anything-old-read-command)) (substitute-key-definition 'anything-execute-extended-command 'execute-extended-command global-map) (substitute-key-definition 'anything-find-file 'find-file global-map) (message "Uninstalled anything version of read functions.")) ;; (@* " shell history") (defun anything-complete-shell-history () "Select a command from shell history and insert it." (interactive) (let ((anything-show-completion-minimum-window-height (/ (frame-height) 2))) (anything-complete 'anything-c-source-complete-shell-history (or (word-at-point) "") 20))) (defun anything-complete-shell-history-setup-key (key) ;; for Emacs22 (when (and (not (boundp 'minibuffer-local-shell-command-map)) (require 'shell-command nil t) (boundp 'shell-command-minibuffer-map)) (shell-command-completion-mode) (define-key shell-command-minibuffer-map key 'anything-complete-shell-history)) ;; for Emacs23 (when (boundp 'minibuffer-local-shell-command-map) (define-key minibuffer-local-shell-command-map key 'anything-complete-shell-history)) (when (require 'background nil t) (define-key background-minibuffer-map key 'anything-complete-shell-history)) (require 'shell) (define-key shell-mode-map key 'anything-complete-shell-history)) (defvar zsh-p nil) (defvar anything-c-source-complete-shell-history '((name . "Shell History") (init . (lambda () (require 'shell-history) (with-current-buffer (anything-candidate-buffer (shell-history-buffer)) (revert-buffer t t) (set (make-local-variable 'zsh-p) (shell-history-zsh-extended-history-p))))) (get-line . acsh-get-line) (search-from-end) (type . complete))) (defun acsh-get-line (s e) (let ((extended-history (string= (buffer-substring s (+ s 2)) ": ")) (single-line (not (string= (buffer-substring (1- e) e) "\\")))) (cond ((not zsh-p) (buffer-substring s e)) ((and extended-history single-line) (buffer-substring (+ s 15) e)) (extended-history ;zsh multi-line / 1st line (goto-char e) (let ((e2 (1- (if (re-search-forward "^: [0-9]+:[0-9];" nil t) (match-beginning 0) (point-max))))) (prog1 (replace-regexp-in-string "\\\\\n" ";" (buffer-substring (+ s 15) e2)) (goto-char s)))) (t ; zsh multi-line history / not 1st line (goto-char s) (re-search-backward "^: [0-9]+:[0-9];" nil t) (let ((s2 (match-end 0)) e2) (goto-char s2) (setq e2 (1- (if (re-search-forward "^: [0-9]+:[0-9];" nil t) (match-beginning 0) (point-max)))) (prog1 (replace-regexp-in-string "\\\\\n" ";" (buffer-substring s2 e2)) (goto-char s2))))))) ;; I do not want to make anything-c-source-* symbols because they are ;; private in `anything-execute-extended-command'. (defvar anything-execute-extended-command-sources '(((name . "Emacs Commands History") (candidates . extended-command-history) (action . identity) (update . alcs-make-candidates) (persistent-action . alcs-describe-function)) ((name . "Commands") (header-name . alcs-header-name) (init . (lambda () (anything-candidate-buffer (get-buffer-create alcs-commands-buffer)))) (candidates-in-buffer) (action . identity) (update . alcs-make-candidates) (persistent-action . alcs-describe-function)))) ;; (with-current-buffer " *command symbols*" (erase-buffer)) (defun anything-execute-extended-command () "Replacement of `execute-extended-command'." (interactive) (setq alcs-this-command this-command) (let* ((cmd (anything (if (and anything-execute-extended-command-use-kyr (require 'anything-kyr-config nil t)) (cons anything-c-source-kyr anything-execute-extended-command-sources) anything-execute-extended-command-sources)))) (when cmd (setq extended-command-history (cons cmd (delete cmd extended-command-history))) (setq cmd (intern cmd)) (if (or (stringp (symbol-function cmd)) (vectorp (symbol-function cmd))) (execute-kbd-macro (symbol-function cmd)) (setq this-command cmd) (call-interactively cmd))))) (defvar anything-find-file-additional-sources nil) (defun anything-find-file () "Replacement of `find-file'." (interactive) (let ((anything-map (anything-read-file-name-map)) ;; anything-read-file-name-follow-directory uses these variables (prompt "Find File: ") default-filename require-match predicate (additional-attrs '(;; because anything-c-skip-boring-files cannot ;; handle (display . real) candidates (candidate-transformer) (type . file)))) (anything-other-buffer (append (arfn-sources prompt default-directory nil nil nil nil additional-attrs) anything-find-file-additional-sources) "*anything find-file*"))) ;;(anything-find-file) (add-hook 'after-init-hook 'alcs-make-candidates) ;;;; 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 "acsh-get-line command") (expect "ls" (let ((zsh-p t)) (with-temp-buffer (insert ": 1118554690:0;cat ~/.zsh_history\n" ": 1118554690:0;ls\n") (forward-line -1) (acsh-get-line (point-at-bol) (point-at-eol))))) (expect "cd;ls -l" (let ((zsh-p t)) (with-temp-buffer (insert ": 1118554690:0;cat ~/.zsh_history\n" ": 1118554690:0;cd\\\n" "ls -l\n" ": 1118554690:0;hoge\n") (forward-line -2) (acsh-get-line (point-at-bol) (point-at-eol))))) (expect "cd;ls -l" (let ((zsh-p t)) (with-temp-buffer (insert ": 1118554690:0;cat ~/.zsh_history\n" ": 1118554690:0;cd\\\n" "ls -l\n" ": 1118554690:0;hoge\n") (forward-line -3) (acsh-get-line (point-at-bol) (point-at-eol))))) (expect "cd;ls -l" (let ((zsh-p t)) (with-temp-buffer (insert ": 1118554690:0;cat ~/.zsh_history\n" ": 1118554690:0;cd\\\n" "ls -l\n") (forward-line -1) (acsh-get-line (point-at-bol) (point-at-eol))))) (expect "cd;ls -l" (let ((zsh-p t)) (with-temp-buffer (insert ": 1118554690:0;cat ~/.zsh_history\n" ": 1118554690:0;cd\\\n" "ls -l\n") (forward-line -2) (acsh-get-line (point-at-bol) (point-at-eol))))) (expect "pwd" (let ((zsh-p nil)) (with-temp-buffer (insert "foo\n" "pwd\n") (forward-line -1) (acsh-get-line (point-at-bol) (point-at-eol))))) (desc "acsh-get-line lineno") (expect 2 (let ((zsh-p t)) (with-temp-buffer (insert ": 1118554690:0;cat ~/.zsh_history\n" ": 1118554690:0;cd\\\n" "ls -l\n" ": 1118554690:0;hoge\n") (forward-line -2) (acsh-get-line (point-at-bol) (point-at-eol)) (line-number-at-pos)))) (expect 2 (let ((zsh-p t)) (with-temp-buffer (insert ": 1118554690:0;cat ~/.zsh_history\n" ": 1118554690:0;cd\\\n" "ls -l\n" ": 1118554690:0;hoge\n") (forward-line -3) (acsh-get-line (point-at-bol) (point-at-eol)) (line-number-at-pos)))) ))) ;;; for compatibility (defvaralias 'anything-c-source-complete-emacs-variables-partial-match 'anything-c-source-complete-emacs-variables) (defvaralias 'anything-c-source-complete-emacs-commands-partial-match 'anything-c-source-complete-emacs-commands) (defvaralias 'anything-c-source-complete-emacs-functions-partial-match 'anything-c-source-complete-emacs-functions) (provide 'anything-complete) ;; How to save (DO NOT REMOVE!!) ;; (progn (magit-push) (emacswiki-post "anything-complete.el")) ;;; anything-complete.el ends here anything-el-1.287/anything-startup.el0000644000175000017500000000374011447253044017133 0ustar takayatakaya;;; anything-startup.el --- anything.el startup file ;;; $Id: anything-startup.el,v 1.10 2010-02-04 19:57:31 rubikitch Exp $ ;;;; Installation ;;; anything.el is just a framework and predefined configuration is in ;;; anything-config.el. You need install both to use anything ;;; practically. ;;; ;;; Note: anything-config.el loads anything.el. (require 'anything-config) ;;; anything-match-plugin.el extends pattern matching. Some Anything ;;; Applications requires it. It is a must-have plugin now. ;;; (require 'anything-match-plugin) ;;; If you use Japanese, you should install Migemo and anything-migemo.el. ;;; ;;; Migemo http://0xcc.net/migemo/ (and (equal current-language-environment "Japanese") (require 'anything-migemo nil t)) ;;; anything-complete.el replaces various completion with anything ;;; (like Icicles). Use Anything power for normal completion. (when (require 'anything-complete nil t) ;; Automatically collect symbols by 150 secs (anything-lisp-complete-symbol-set-timer 150) (define-key emacs-lisp-mode-map "\C-\M-i" 'anything-lisp-complete-symbol-partial-match) (define-key lisp-interaction-mode-map "\C-\M-i" 'anything-lisp-complete-symbol-partial-match) ;; Comment if you do not want to replace completion commands with `anything'. (anything-read-string-mode 1) ) ;;; anything-show-completion.el shows current selection prettily. (require 'anything-show-completion) ;;; anything-auto-install.el integrates auto-install.el with anything. (require 'anything-auto-install nil t) ;;; descbinds-anything.el replaces describe-bindings with anything interface. (when (require 'descbinds-anything nil t) ;; Comment if you do not want to replace `describe-bindings' with `anything'. (descbinds-anything-install) ) ;;; `anything-grep' replaces standard `grep' command. (require 'anything-grep nil t) (provide 'anything-startup) ;; How to save (DO NOT REMOVE!!) ;; (progn (magit-push) (emacswiki-post "anything-startup.el")) ;;; anything-startup.el ends here anything-el-1.287/anything-menu.el0000644000175000017500000001270611447253044016377 0ustar takayatakaya;;;; anything-menu.el --- anything.el candidate selection outside Emacs ;; $Id: anything-menu.el,v 1.6 2010/04/01 12:10:35 rubikitch Exp $ ;; Copyright (C) 2010 rubikitch ;; Author: rubikitch ;; Keywords: menu, tools, convenience, anything ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything-menu.el ;; 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 file provides anything.el candidate selection outside ;; Emacs. You have to enable emacsserver or gnuserv by M-x ;; server-start or M-x gnuserv-start. ;; ;; [EVAL IT] (describe-function 'anything-menu) ;; [EVAL IT] (describe-function 'anything-menu-select) ;; [EVAL IT] (describe-function 'anything-menu-select-from-file) ;; ;; First you have to install anything-menu script, which takes one argument, candidate file. ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything-menu ;; ;; To demonstrate anything-menu, execute the following from shell ;; $ anything-menu ~/.emacs ;; ;;; Commands: ;; ;; Below are complete command list: ;; ;; `anything-menu' ;; Call `anything' outside Emacs. ;; ;;; Customizable Options: ;; ;; Below are customizable option list: ;; ;;; Installation: ;; ;; Put anything-menu.el to your load-path. ;; The load-path is usually ~/elisp/. ;; It's set in your ~/.emacs like this: ;; (add-to-list 'load-path (expand-file-name "~/elisp")) ;; ;; And the following to your ~/.emacs startup file. ;; ;; (require 'anything-menu) ;; ;; No need more. ;;; Customize: ;; ;; ;; All of the above can customize by: ;; M-x customize-group RET anything-menu RET ;; ;;; History: ;; $Log: anything-menu.el,v $ ;; Revision 1.6 2010/04/01 12:10:35 rubikitch ;; * document ;; * `anything-menu': ANY-KEYMAP argument ;; ;; Revision 1.5 2010/02/23 20:39:41 rubikitch ;; add `make-frame-visible' ;; ;; Revision 1.4 2010/02/23 16:48:41 rubikitch ;; migemized ;; ;; Revision 1.3 2010/02/23 10:23:52 rubikitch ;; New function `anything-menu-select-from-file' ;; ;; Revision 1.2 2010/02/23 10:10:34 rubikitch ;; implemented ;; ;; Revision 1.1 2010/02/23 09:44:09 rubikitch ;; initial ;; ;;; Code: (defvar anything-menu-version "$Id: anything-menu.el,v 1.6 2010/04/01 12:10:35 rubikitch Exp $") (require 'anything) (defgroup anything-menu nil "anything-menu" :group 'emacs) (defvar am/tmp-file "/tmp/.am-tmp-file") (defvar am/frame nil) (defun am/set-frame () (unless (and am/frame (frame-live-p am/frame)) (setq am/frame (make-frame '((name . "anything menu") (title . "anything menu"))))) (select-frame am/frame) (make-frame-visible am/frame) (sit-for 0)) (defun am/close-frame () (ignore-errors (make-frame-invisible am/frame)) (when (fboundp 'do-applescript) (funcall 'do-applescript "tell application \"iTerm\" activate end"))) (defun am/write-result (line) (write-region (or line "") nil am/tmp-file)) (defun anything-menu (&optional any-sources any-input any-prompt any-resume any-preselect any-buffer any-keymap) "Call `anything' outside Emacs. Arguments are the same as `anything'. Pop up anything frame and close it after session." (interactive) (am/set-frame) (unwind-protect (let ((anything-samewindow t) (anything-display-function 'anything-default-display-buffer)) (anything any-sources any-input any-prompt any-resume any-preselect any-buffer any-keymap)) (am/close-frame))) (defun anything-menu-select (am-prompt &rest am-selections) "Select from a list AM-SELECTIONS and write selection to /tmp/.am-tmp-file, the default file of `am/tmp-file'. " (anything-menu `(((name . ,am-prompt) (candidates . am-selections) (migemo) (action . am/write-result))) nil (concat am-prompt ": ") nil nil "*anything menu select*")) (defun* anything-menu-select-from-file (am-filename &optional (am-prompt "selection")) "Select a candidate in file AM-FILENAME and write selection to /tmp/.am-tmp-file, the default file of `am/tmp-file'. The anything-menu script calls this function and print selection to stdout." (anything-menu `(((name . ,am-prompt) (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert-file-contents am-filename)))) (candidates-in-buffer) (migemo) (action . am/write-result))) nil (concat am-prompt ": ") nil nil "*anything menu select*")) (provide 'anything-menu) ;; (save-window-excursion (bg2 "gnudoit '(anything-menu-select \"selections\" \"a\" \"b\")'")) ;; (find-sh0 "cat /tmp/.am-tmp-file") ;; How to save (DO NOT REMOVE!!) ;; (emacswiki-post "anything-menu.el") ;;; anything-menu.el ends here anything-el-1.287/anything-migemo.el0000644000175000017500000003474711447253044016721 0ustar takayatakaya;;; anything-migemo.el --- Migemo plug-in for anything ;; $Id: anything-migemo.el,v 1.18 2009-06-07 17:52:22 rubikitch Exp $ ;; Copyright (C) 2007, 2008, 2009 rubikitch ;; Author: rubikitch ;; Keywords: anything, convenience, tools, i18n, japanese ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything-migemo.el ;; 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 3, 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: ;; Migemo extension of `anything'. Use `anything-migemo' instead of ;; `anything'. If `anything-migemo' is invoked with prefix argument, ;; `anything' is migemo-ized. This means that pattern matching of ;; `anything' candidates is done by migemo-expanded `anything-pattern'. ;;; Commands: ;; ;; Below are complete command list: ;; ;; `anything-migemo' ;; `anything' with migemo extension. ;; ;;; Customizable Options: ;; ;; Below are customizable option list: ;; ;; If you want to use migemo search source-locally, add (migemo) to ;; the source. It sets match and search attribute appropriately for ;; migemo. ;;; Setting: ;; (require 'anything-config) ;; (require 'anything-migemo) ;; (define-key global-map [(control ?:)] 'anything-migemo) ;;; Bug: ;; Simultaneous use of (candidates-in-buffer), (search ;; . migemo-forward) and (delayed) scrambles *anything* buffer. Maybe ;; because of collision of `migemo-process' and `run-with-idle-timer' ;;; History: ;; $Log: anything-migemo.el,v $ ;; Revision 1.18 2009-06-07 17:52:22 rubikitch ;; New macro `anything-migemize-command'. ;; ;; Revision 1.17 2009/06/04 20:32:00 rubikitch ;; migemo is soft-required now; this file has no effect unless migemo is installed. ;; ;; Revision 1.16 2008/10/03 20:43:18 rubikitch ;; Use with anything-match-plugin.el ;; ;; Revision 1.15 2008/10/03 20:01:46 rubikitch ;; refactoring ;; ;; Revision 1.14 2008/08/25 08:29:02 rubikitch ;; `anything-migemo': anything-args ;; ;; Revision 1.13 2008/08/24 20:39:53 rubikitch ;; prevent the unit test from being byte-compiled. ;; ;; Revision 1.12 2008/08/24 18:01:25 rubikitch ;; *** empty log message *** ;; ;; Revision 1.11 2008/08/24 08:23:30 rubikitch ;; Rename `anything-candidates-buffer' -> `anything-candidate-buffer' ;; ;; Revision 1.10 2008/08/24 01:54:21 rubikitch ;; migemo attribute ;; ;; Revision 1.9 2008/08/19 21:38:09 rubikitch ;; match attribute bug fix ;; ;; Revision 1.8 2008/08/19 21:30:29 rubikitch ;; plug-in ;; ;; Revision 1.7 2008/08/10 22:45:02 rubikitch ;; Bug info ;; ;; Revision 1.6 2008/08/08 03:40:51 rubikitch ;; require migemo ;; ;; Revision 1.5 2008/08/08 03:38:34 rubikitch ;; add search attribute ;; unit tests ;; ;; Revision 1.4 2007/12/26 08:36:01 rubikitch ;; changed match priority ;; ;; Revision 1.3 2007/12/25 19:55:59 rubikitch ;; patch is not needed anymore. ;; ;; Revision 1.2 2007/12/25 13:05:46 rubikitch ;; speed up by memoization ;; ;; Revision 1.1 2007/12/25 12:03:25 rubikitch ;; Initial revision ;; ;;; Code: (eval-when-compile (require 'anything)) (require 'migemo nil t) (require 'anything-match-plugin nil t) (defvar anything-use-migemo nil "[Internal] If non-nil, `anything' is migemo-ized.") (defun anything-migemo (with-migemo &rest anything-args) "`anything' with migemo extension. With prefix arugument, `anything-pattern' is migemo-ized, otherwise normal `anything'." (interactive "P") (let ((anything-use-migemo with-migemo)) (apply 'anything anything-args))) (defvar anything-previous-migemo-info '("" . "") "[Internal] Previous migemo query for anything-migemo.") (defun* anything-string-match-with-migemo (str &optional (pattern anything-pattern)) "Migemo version of `string-match'." (unless (string= pattern (car anything-previous-migemo-info)) (setq anything-previous-migemo-info (cons pattern (migemo-get-pattern pattern)))) (string-match (cdr anything-previous-migemo-info) str)) (when (memq 'anything-compile-source--match-plugin anything-compile-source-functions) (defun* anything-mp-3migemo-match (str &optional (pattern anything-pattern)) (loop for (pred . re) in (anything-mp-3-get-patterns pattern) always (funcall pred (anything-string-match-with-migemo str re)))) (defun anything-mp-3migemo-search (pattern &rest ignore) (anything-mp-3-search-base migemo-forward migemo-forward bol eol)) (defun anything-mp-3migemo-search-backward (pattern &rest ignore) (anything-mp-3-search-base migemo-backward migemo-backward eol bol))) ;; (anything-string-match-with-migemo "日本語入力" "nihongo") ;; (anything-string-match-with-migemo "日本語入力" "nyuuryoku") ;; (anything-mp-3migemo-match "日本語入力" "nihongo nyuuryoku") (defun anything-compile-source--migemo (source) (if (not (featurep 'migemo)) source (let* ((match-identity-p (or (assoc 'candidates-in-buffer source) (equal '(identity) (assoc-default 'match source)))) (use-match-plugin (memq 'anything-compile-source--match-plugin anything-compile-source-functions)) (matcher (if use-match-plugin 'anything-mp-3migemo-match 'anything-string-match-with-migemo)) (searcher (if (assoc 'search-from-end source) (if use-match-plugin 'anything-mp-3migemo-search-backward 'migemo-backward) (if use-match-plugin 'anything-mp-3migemo-search 'migemo-forward)))) (cond (anything-use-migemo `((delayed) (search ,@(assoc-default 'search source) ,searcher) ,(if match-identity-p '(match identity) `(match ,matcher ,@(assoc-default 'match source))) ,@source)) ((assoc 'migemo source) `((search ,searcher) ,(if match-identity-p '(match identity) `(match ,matcher)) ,@source)) (t source))))) (add-to-list 'anything-compile-source-functions 'anything-compile-source--migemo t) (defmacro anything-migemize-command (command) "Use migemo in COMMAND when selectiong candidate by `anything'. Bind `anything-use-migemo' = t in COMMAND." `(defadvice ,command (around anything-use-migemo activate) (let ((anything-use-migemo t)) ad-do-it))) ;;;; 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 "match") (expect '(("TEST" ("日本語"))) (let ((anything-use-migemo t)) (anything-test-candidates '(((name . "TEST") (candidates "日本語"))) "nihongo" '(anything-compile-source--migemo)))) (desc "candidates buffer") (expect '(("TEST" ("日本語"))) (let ((anything-use-migemo t)) (anything-test-candidates '(((name . "TEST") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "日本語\n")))) (candidates-in-buffer))) "nihongo" '(anything-compile-source--candidates-in-buffer anything-compile-source--migemo)))) (desc "migemo attribute") (expect '(("TEST" ("日本語"))) (let ((anything-use-migemo nil)) (anything-test-candidates '(((name . "TEST") (candidates "日本語") (migemo))) "nihongo" '(anything-compile-source--migemo)))) (expect '(("TEST" ("日本語"))) (let ((anything-use-migemo nil)) (anything-test-candidates '(((name . "TEST") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "日本語\n")))) (candidates-in-buffer) (migemo))) "nihongo" '(anything-compile-source--candidates-in-buffer anything-compile-source--migemo)))) (desc "search-from-end attribute") (expect '(("FOO" ("日本語入力" "日本語会話"))) (let ((anything-use-migemo nil)) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "日本語会話\n日本語入力\n")))) (candidates-in-buffer) (migemo) (search-from-end))) "nihongo" '(anything-compile-source--candidates-in-buffer anything-compile-source--migemo)))) (expect '(("FOO" ("日本語入力" "日本語会話"))) (let ((anything-use-migemo t)) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "日本語会話\n日本語入力\n")))) (candidates-in-buffer) (search-from-end))) "nihongo" '(anything-compile-source--candidates-in-buffer anything-compile-source--migemo)))) (desc "with anything-match-plugin") (expect '(("FOO" ("日本語入力"))) (let ((anything-use-migemo nil)) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "日本語会話\n日本語入力\n")))) (candidates-in-buffer) (migemo))) "nihongo nyuuryoku" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin anything-compile-source--migemo)))) (expect '(("FOO" ("日本語入力"))) (let ((anything-use-migemo t)) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "日本語会話\n日本語入力\n")))) (candidates-in-buffer))) "nihongo nyuuryoku" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin anything-compile-source--migemo)))) (expect '(("FOO" ("日本語入力"))) (let ((anything-use-migemo nil)) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "日本語会話\n日本語入力\n")))) (candidates-in-buffer) (search-from-end) (migemo))) "nihongo nyuuryoku" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin anything-compile-source--migemo)))) (expect '(("FOO" ("日本語入力"))) (let ((anything-use-migemo t)) (anything-test-candidates '(((name . "FOO") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "日本語会話\n日本語入力\n")))) (candidates-in-buffer) (search-from-end))) "nihongo nyuuryoku" '(anything-compile-source--candidates-in-buffer anything-compile-source--match-plugin anything-compile-source--migemo)))) (expect '(("TEST" ("日本語入力"))) (let ((anything-use-migemo nil)) (anything-test-candidates '(((name . "TEST") (migemo) (candidates "日本語入力"))) "nihongo nyuuryoku" '(anything-compile-source--match-plugin anything-compile-source--migemo)))) (expect '(("TEST" ("日本語入力"))) (let ((anything-use-migemo t)) (anything-test-candidates '(((name . "TEST") (candidates "日本語入力"))) "nihongo nyuuryoku" '(anything-compile-source--match-plugin anything-compile-source--migemo)))) ))) (provide 'anything-migemo) ;; How to save (DO NOT REMOVE!!) ;; (progn (magit-push) (emacswiki-post "anything-migemo.el")) ;;; anything-migemo.el ends here anything-el-1.287/anything-show-completion.el0000644000175000017500000002324711447253044020564 0ustar takayatakaya;;; anything-show-completion.el --- Show selection in buffer for anything completion ;; $Id: anything-show-completion.el,v 1.19 2009/11/19 20:16:51 rubikitch Exp rubikitch $ ;; Copyright (C) 2009 hchbaw ;; Copyright (C) 2009 rubikitch ;; Original Author: hchbaw ;; Author: rubikitch ;; Keywords: anything, convenience, complete ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything-show-completion.el ;; 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: ;; ;; `anything' is also useful for in-buffer completion such as ;; `anything-lisp-complete-symbol'. But users must see *anything* ;; buffer when completing. It forces us to move our eyes away from ;; code temporarily and we feel stressful. ;; ;; With this plug-in, current selection (`anything-get-selection') is ;; displayed at point. This plug-in is automatically detected by user ;; program such as anything-complete.el . ;; ;; This program is based on an idea by hchbaw. ;; http://d.hatena.ne.jp/hchbaw/20090416/1239878984 ;;; Commands: ;; ;; Below are complete command list: ;; ;; ;;; Customizable Options: ;; ;; Below are customizable option list: ;; ;; `anything-show-completion-face' ;; *Face of anything-show-completion. ;; default = anything-selection-face ;; `anything-show-completion-activate' ;; *Set nil to turn off anything-show-completion. ;; default = t ;; `anything-show-completion-minimum-window-height' ;; *Minimum completion window height. ;; default = 7 ;;; For developers: ;; ;; To enable anything-show-completion for user-defined function, use ;; `use-anything-show-completion'. It accepts function and length of ;; prefix (= current completing target) as a sexp. It must be used ;; with soft-require. ;; ;; Example: ;; (when (require 'anything-show-completion nil t) ;; (use-anything-show-completion 'rct-complete-symbol--anything ;; '(length pattern))) ;; ;; Example in souce code: ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything-complete.el ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything-rcodetools.el ;;; Installation: ;; ;; Put anything-show-completion.el to your load-path. ;; The load-path is usually ~/elisp/. ;; It's set in your ~/.emacs like this: ;; (add-to-list 'load-path (expand-file-name "~/elisp")) ;; ;; And the following to your ~/.emacs startup file. ;; ;; (require 'anything-show-completion) ;; ;; No need more. ;;; Customize: ;; ;; ;; All of the above can customize by: ;; M-x customize-group RET anything-show-completion RET ;; ;;; History: ;; $Log: anything-show-completion.el,v $ ;; Revision 1.19 2009/11/19 20:16:51 rubikitch ;; asc-display-function: Fix an error "Window height XX too small (after splitting)" ;; ;; Revision 1.18 2009/11/19 17:27:59 rubikitch ;; asc-display-function: Take into account the beginning of line ;; ;; Revision 1.17 2009/11/11 17:43:34 rubikitch ;; Display bug fix. thanks to hchbaw ;; ;; http://d.hatena.ne.jp/hchbaw/20091111/1257960247 ;; ;; Revision 1.16 2009/10/09 17:05:41 rubikitch ;; asc-display-function: Fix an error when opening from minibuffer ;; ;; Revision 1.15 2009/10/08 17:04:04 rubikitch ;; Fix an error when window height is too small. ;; ;; Revision 1.14 2009/10/08 16:57:57 rubikitch ;; added comments ;; ;; Revision 1.13 2009/10/08 10:56:03 rubikitch ;; Fix an error when completion window is too small. ;; ;; Revision 1.12 2009/10/08 10:24:37 rubikitch ;; Show candidates under the point. ;; ;; Revision 1.11 2009/10/08 05:12:56 rubikitch ;; Candidates are shown near the point. ;; ;; Revision 1.10 2009/10/06 22:46:23 rubikitch ;; `asc-display-function': Emacs23 fix ;; ;; Revision 1.9 2009/05/03 22:01:32 rubikitch ;; asc-display-function: split-window hack is effective only if one window is displayed. ;; ;; Revision 1.8 2009/05/03 21:47:41 rubikitch ;; set `anything-display-function' ;; ;; Revision 1.7 2009/04/20 12:21:28 rubikitch ;; Fixed an error when `anything' is invoked for the first time. ;; ;; Revision 1.6 2009/04/18 16:11:33 rubikitch ;; Removed a mess ;; ;; Revision 1.5 2009/04/18 16:11:01 rubikitch ;; * Fixed a typo. ;; * New function: `anything-show-completion-install' ;; ;; Revision 1.4 2009/04/18 10:05:15 rubikitch ;; copyright ;; ;; Revision 1.3 2009/04/18 10:02:10 rubikitch ;; doc ;; ;; Revision 1.2 2009/04/18 09:21:14 rubikitch ;; `use-anything-show-completion' as a function. ;; It enables us to affect multiple commands with `dolist'. ;; ;; Revision 1.1 2009/04/17 17:07:35 rubikitch ;; Initial revision ;; ;;; Code: (defvar anything-show-completion-version "$Id: anything-show-completion.el,v 1.19 2009/11/19 20:16:51 rubikitch Exp rubikitch $") (require 'anything) (defgroup anything-show-completion nil "anything-show-completion" :group 'anything) (defvar asc-overlay nil) (defcustom anything-show-completion-face anything-selection-face "*Face of anything-show-completion." :type 'face :group 'anything-show-completion) (defcustom anything-show-completion-activate t "*Set nil to turn off anything-show-completion." :type 'boolean :group 'anything-show-completion) (defcustom anything-show-completion-minimum-window-height 7 "*Minimum completion window height." :type 'integer :group 'anything-show-completion) (defun asc-initialize-maybe () (unless asc-overlay (setq asc-overlay (make-overlay (point-min) (point-min))) (overlay-put asc-overlay 'face anything-show-completion-face) (asc-cleanup))) (defun asc-cleanup () (delete-overlay asc-overlay)) (add-hook 'anything-cleanup-hook 'asc-cleanup) (asc-initialize-maybe) (defun asc-overlay-activate-p () "Return non-nil if `anything' is being used for any completionic purposes." (and anything-show-completion-activate (overlay-buffer asc-overlay))) (defadvice anything-mark-current-line (after anything-show-completion activate) "Display the `anything-get-selection' contents as an overlay at the current (point)." (anything-aif (and (asc-overlay-activate-p) (with-anything-window (not (equal (anything-buffer-get) anything-action-buffer))) (anything-get-selection)) (with-current-buffer anything-current-buffer (asc-display-overlay it)))) (defun asc-display-overlay (selection) (overlay-put asc-overlay 'display selection) (move-overlay asc-overlay (- (point) (eval (overlay-get asc-overlay 'prefix-length-sexp))) (point) anything-current-buffer)) ;;; Entry point (defun use-anything-show-completion (function prefix-length-sexp) "Setup a before advice of FUNCTION to show the `anything-get-selection' contents as an overlay at point. PREFIX-LENGTH-SEXP is an expression to denote the length of prefix (completing target). It is evaluated in `asc-display-overlay'." (eval `(defadvice ,function (around anything-show-completion activate) (anything-show-completion-install ',prefix-length-sexp) (let ((anything-display-function 'asc-display-function)) ad-do-it)))) (defun anything-show-completion-install (prefix-length-sexp) (asc-initialize-maybe) (move-overlay asc-overlay (point) (point) (current-buffer)) (overlay-put asc-overlay 'prefix-length-sexp prefix-length-sexp)) (defun asc-point-at-upper-half-of-window-p (pt) (<= (+ (count-screen-lines (window-start) pt) (if header-line-format 1 0) (if (zerop (current-column)) 0 0)) (- (/ (window-height) 2) (if header-line-format 1 0)))) ;; (global-set-key "\C-x\C-z" (lambda () (interactive) (message "%s" (asc-point-at-upper-half-of-window-p (point))))) (defun asc-display-function (buf) (let* ((cursor-upper-p (asc-point-at-upper-half-of-window-p (point))) (half (/ (window-height) 2)) (win (selected-window)) (upper-height (max window-min-height (min (+ 1 ; mode-line (if header-line-format 1 0) ;header-line ;; window screen lines (count-screen-lines (window-start) (point)) ;; adjustment of count-screen-lines and BOL (if (bolp) 1 0)) (- (window-height) anything-show-completion-minimum-window-height)))) (new-w (let ((split-window-keep-point)) (if (active-minibuffer-window) (minibuffer-selected-window) (enlarge-window (if (<= (window-height) (+ anything-show-completion-minimum-window-height window-min-height)) (+ 4 anything-show-completion-minimum-window-height) 0)) (split-window (selected-window) upper-height))))) (with-selected-window win (recenter -1)) (set-window-buffer new-w buf))) (provide 'anything-show-completion) ;; (asc-display-function anything-buffer) ;; How to save (DO NOT REMOVE!!) ;; (emacswiki-post "anything-show-completion.el") ;;; anything-show-completion.el ends here anything-el-1.287/descbinds-anything.el0000644000175000017500000002021511447253044017363 0ustar takayatakaya;;; descbinds-anything.el --- Yet Another `describe-bindings' with `anything'. ;; Copyright (C) 2008, 2009, 2010 Taiki SUGAWARA ;; Author: Taiki SUGAWARA ;; Keywords: anything, help ;; Version: 1.05 ;; Time-stamp: <2010-02-05 15:00:10 taiki> ;; URL: http://www.emacswiki.org/cgi-bin/wiki/descbinds-anything.el ;; URL: http://bitbucket.org/buzztaiki/elisp/src/tip/descbinds-anything.el ;; 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 3, 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 is a replacement of `describe-bindings'. ;;; Usage: ;; Add followings on your .emacs. ;; ;; (require 'descbinds-anything) ;; (descbinds-anything-install) ;; ;; Now, `describe-bindings' is replaced to `descbinds-anything'. Type ;; `C-h b', `C-x C-h' these run `descbinds-anything'. ;; ;; In the Anything buffer, you can select key-binds with anything interface. ;; ;; - When type RET, selected candidate command is executed. ;; ;; - When type ESC, You can "Execute", "Describe Function" or "Find ;; Function" by the menu. ;; ;; - When type C-z, selected command is described without quiting. ;;; History: ;; 2010-02-05 Taiki SUGAWARA ;; ;; * descbinds-anything.el: Version 1.05 ;; bug fix. ;; ;; 2010-02-02 UTC Taiki SUGAWARA ;; ;; * descbinds-anything.el: Version 1.04 ;; add sorting feature. ;; separete sorce creation function. ;; add persistent action. ;; ;; 2009-03-29 UTC Taiki SUGAWARA ;; ;; * descbinds-anything.el: Version 1.03 ;; fix typo. ;; ;; 2008-11-16 UTC Taiki SUGAWARA ;; ;; * descbinds-anything.el: Version 1.02 ;; bound `indent-tabs-mode` to t for nil environment. ;; ;; 2008-11-16 UTC Taiki SUGAWARA ;; ;; * descbinds-anything.el: fix infinitive-loop when binding-line ;; has not tab. ;;; Code: (require 'anything) (defgroup descbinds-anything nil "Yet Another `describe-bindings' with `anything'." :prefix "descbinds-anything-" :group 'anything) (defcustom descbinds-anything-actions '(("Execute" . descbinds-anything-action:execute) ("Describe Function" . descbinds-anything-action:describe) ("Find Function" . descbinds-anything-action:find-func)) "Actions of selected candidate." :type '(repeat (cons :tag "Action" (string :tag "Name") (function :tag "Function"))) :group 'descbinds-anything) (defcustom descbinds-anything-candidate-formatter 'descbinds-anything-default-candidate-formatter "Candidate formatter function. This function called two argument KEY and BINDING." :type 'function :group 'descbinds-anything) (defcustom descbinds-anything-window-style 'one-window "Window splitting style." :type '(choice (const :tag "One Window" one-window) (const :tag "Same Window" same-window) (const :tag "Split Window" split-window)) :group 'descbinds-anything) (defcustom descbinds-anything-section-order '("Major Mode Bindings" "Minor Mode Bindings" "Global Bindings") "A list of section order by name regexp." :type '(repeat (regexp :tag "Regexp")) :group 'descbinds-anything) (defcustom descbinds-anything-source-template '((candidate-transformer . descbinds-anything-transform-candidates) (persistent-action . descbinds-anything-action:describe) (action-transformer . descbinds-anything-transform-actions)) "A template of `descbinds-anything' source." :type 'sexp :group 'descbinds-anything) (defun descbinds-anything-all-sections (buffer &optional prefix menus) (with-temp-buffer (let ((indent-tabs-mode t)) (describe-buffer-bindings buffer prefix menus)) (goto-char (point-min)) (let ((header-p (not (= (char-after) ?\f))) sections header section) (while (not (eobp)) (cond (header-p (setq header (buffer-substring-no-properties (point) (line-end-position))) (setq header-p nil) (forward-line 3)) ((= (char-after) ?\f) (push (cons header (nreverse section)) sections) (setq section nil) (setq header-p t)) ((looking-at "^[ \t]*$") ;; ignore ) (t (let ((binding-start (save-excursion (and (re-search-forward "\t+" nil t) (match-end 0)))) key binding) (when binding-start (setq key (buffer-substring-no-properties (point) binding-start) key (replace-regexp-in-string"^[ \t\n]+" "" key) key (replace-regexp-in-string"[ \t\n]+$" "" key)) (goto-char binding-start) (setq binding (buffer-substring-no-properties binding-start (line-end-position))) (unless (member binding '("self-insert-command")) (push (cons key binding) section)))))) (forward-line)) (push (cons header (nreverse section)) sections) (nreverse sections)))) (defun descbinds-anything-action:execute (candidate) "An action that execute selected CANDIDATE command." (call-interactively (cdr candidate))) (defun descbinds-anything-action:describe (candidate) "An action that describe selected CANDIDATE function." (describe-function (cdr candidate))) (defun descbinds-anything-action:find-func (candidate) "An action that find selected CANDIDATE function." (find-function (cdr candidate))) (defun descbinds-anything-default-candidate-formatter (key binding) "Default candidate formatter." (format "%-10s\t%s" key binding)) (defun descbinds-anything-sort-sections (sections) (flet ((order (x) (loop for n = 0 then (1+ n) for regexp in descbinds-anything-section-order if (and (car x) (string-match regexp (car x))) return n finally return n))) (sort sections (lambda (a b) (< (order a) (order b)))))) (defun descbinds-anything-transform-candidates (candidates) (mapcar (lambda (pair) (cons (funcall descbinds-anything-candidate-formatter (car pair) (cdr pair)) (cons (car pair) (intern-soft (cdr pair))))) candidates)) (defun descbinds-anything-transform-actions (actions candidate) (and (commandp (cdr candidate)) (or actions descbinds-anything-actions))) (defun descbinds-anything-sources (buffer &optional prefix menus) (mapcar (lambda (section) (descbinds-anything-source (car section) (cdr section))) (descbinds-anything-sort-sections (descbinds-anything-all-sections buffer prefix menus)))) (defun descbinds-anything-source (name candidates) `((name . ,name) (candidates . ,candidates) ,@descbinds-anything-source-template)) (defun descbinds-anything (&optional prefix buffer) "Yet Another `describe-bindings' with `anything'." (interactive) (let ((anything-sources (descbinds-anything-sources (or buffer (current-buffer)) prefix nil)) (anything-samewindow (and (not (minibufferp)) (memq descbinds-anything-window-style '(same-window one-window)))) (anything-before-initialize-hook (if (and (not (minibufferp)) (eq descbinds-anything-window-style 'one-window)) (cons 'delete-other-windows anything-before-initialize-hook) anything-before-initialize-hook))) (anything))) (defvar descbinds-anything-Orig-describe-bindings (symbol-function 'describe-bindings)) (defun descbinds-anything-install () "Use `descbinds-anything' as a replacement of `describe-bindings'." (interactive) (fset 'describe-bindings 'descbinds-anything)) (defun descbinds-anything-uninstall () "Restore original `describe-bindings'." (interactive) (fset 'describe-bindings descbinds-anything-Orig-describe-bindings)) (provide 'descbinds-anything) ;; How to save (DO NOT REMOVE!!) ;; (emacswiki-post "descbinds-anything.el") ;;; descbinds-anything.el ends here anything-el-1.287/anything-config.el0000644000175000017500000111123411447253044016675 0ustar takayatakaya;;; anything-config.el --- Predefined configurations for `anything.el' ;; Filename: anything-config.el ;; Description: Predefined configurations for `anything.el' ;; Author: Tassilo Horn ;; Maintainer: Tassilo Horn ;; rubikitch ;; Thierry Volpiatto ;; Copyright (C) 2007 ~ 2010, Tassilo Horn, all rights reserved. ;; Copyright (C) 2009, Andy Stewart, all rights reserved. ;; Copyright (C) 2009 ~ 2010, rubikitch, all rights reserved. ;; Copyright (C) 2009 ~ 2010, Thierry Volpiatto, all rights reserved. ;; Created: 2009-02-16 21:38:23 ;; Version: 0.4.1 ;; URL: http://www.emacswiki.org/emacs/download/anything-config.el ;; Keywords: anything, anything-config ;; Compatibility: GNU Emacs 22 ~ 23 ;; ;; Features that might be required by this library: ;; ;; `anything' ;; ;;; This file is NOT part of GNU Emacs ;;; License ;; ;; 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, 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; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth ;; Floor, Boston, MA 02110-1301, USA. ;;; !NOTICE! ;; ;; If this file does not work, upgrade anything.el! ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything.el ;;; Commentary: ;; ;; Predefined configurations for `anything.el' ;; ;; For quick start, try `anything-for-files' to open files. ;; ;; To configure anything you should define anything command ;; with your favorite sources, like below: ;; ;; (defun my-anything () ;; (interactive) ;; (anything-other-buffer ;; '(anything-c-source-buffers ;; anything-c-source-file-name-history ;; anything-c-source-info-pages ;; anything-c-source-info-elisp ;; anything-c-source-man-pages ;; anything-c-source-locate ;; anything-c-source-emacs-commands) ;; " *my-anything*")) ;; ;; Then type M-x my-anything to use sources. ;; ;; Defining own command is better than setup `anything-sources' ;; directly, because you can define multiple anything commands with ;; different sources. Each anything command should have own anything ;; buffer, because M-x anything-resume revives anything command. ;;; Autodoc documentation: ;; --------------------- ;; * Commands defined here are: ;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "anything-" :docstring t) ;; `anything-configuration' ;; Customize `anything'. ;; `anything-c-describe-anything-bindings' ;; [OBSOLETE] Describe `anything' bindings. ;; `anything-mini' ;; Preconfigured `anything' lightweight version (buffer -> recentf). ;; `anything-for-files' ;; Preconfigured `anything' for opening files. ;; `anything-recentf' ;; Preconfigured `anything' for `recentf'. ;; `anything-info-at-point' ;; Preconfigured `anything' for searching info at point. ;; `anything-info-emacs' ;; Preconfigured anything for Emacs manual index. ;; `anything-show-kill-ring' ;; Preconfigured `anything' for `kill-ring'. It is drop-in replacement of `yank-pop'. ;; `anything-minibuffer-history' ;; Preconfigured `anything' for `minibuffer-history'. ;; `anything-gentoo' ;; Preconfigured `anything' for gentoo linux. ;; `anything-imenu' ;; Preconfigured `anything' for `imenu'. ;; `anything-google-suggest' ;; Preconfigured `anything' for google search with google suggest. ;; `anything-yahoo-suggest' ;; Preconfigured `anything' for Yahoo searching with Yahoo suggest. ;; `anything-for-buffers' ;; Preconfigured `anything' for buffer. ;; `anything-buffers+' ;; Enhanced preconfigured `anything' for buffer. ;; `anything-bbdb' ;; Preconfigured `anything' for BBDB. ;; `anything-locate' ;; Preconfigured `anything' for Locate. ;; `anything-w3m-bookmarks' ;; Preconfigured `anything' for w3m bookmark. ;; `anything-firefox-bookmarks' ;; Preconfigured `anything' for firefox bookmark. ;; `anything-colors' ;; Preconfigured `anything' for color. ;; `anything-bookmarks' ;; Preconfigured `anything' for bookmarks. ;; `anything-c-pp-bookmarks' ;; Preconfigured `anything' for bookmarks (pretty-printed). ;; `anything-register' ;; Preconfigured `anything' for Emacs registers. ;; `anything-man-woman' ;; Preconfigured `anything' for Man and Woman pages. ;; `anything-org-keywords' ;; Preconfigured `anything' for org keywords. ;; `anything-emms' ;; Preconfigured `anything' for emms sources. ;; `anything-eev-anchors' ;; Preconfigured `anything' for eev anchors. ;; `anything-bm-list' ;; Preconfigured `anything' for visible bookmarks. ;; `anything-timers' ;; Preconfigured `anything' for timers. ;; `anything-list-emacs-process' ;; Preconfigured `anything' for emacs process. ;; `anything-occur' ;; Preconfigured Anything for Occur source. ;; `anything-browse-code' ;; Preconfigured anything to browse code. ;; `anything-kill-buffers' ;; Preconfigured `anything' to kill buffer you selected. ;; `anything-regexp' ;; Preconfigured anything to build regexps and run query-replace-regexp against. ;; `anything-insert-buffer-name' ;; Insert buffer name. ;; `anything-insert-symbol' ;; Insert current symbol. ;; `anything-insert-selection' ;; Insert current selection. ;; `anything-show-buffer-only' ;; [OBSOLETE] Only show sources about buffer. ;; `anything-show-bbdb-only' ;; [OBSOLETE] Only show sources about BBDB. ;; `anything-show-locate-only' ;; [OBSOLETE] Only show sources about Locate. ;; `anything-show-info-only' ;; [OBSOLETE] Only show sources about Info. ;; `anything-show-imenu-only' ;; [OBSOLETE] Only show sources about Imenu. ;; `anything-show-files-only' ;; [OBSOLETE] Only show sources about File. ;; `anything-show-w3m-bookmarks-only' ;; [OBSOLETE] Only show source about w3m bookmark. ;; `anything-show-colors-only' ;; [OBSOLETE] Only show source about color. ;; `anything-show-kill-ring-only' ;; [OBSOLETE] Only show source about kill ring. ;; `anything-show-this-source-only' ;; Only show this source. ;; `anything-test-sources' ;; List all anything sources for test. ;; `anything-select-source' ;; Select source. ;; `anything-find-files-down-one-level' ;; Go down one level like unix command `cd ..'. ;; `anything-find-files' ;; Preconfigured `anything' for anything implementation of `find-file'. ;; `anything-write-file' ;; Preconfigured `anything' providing completion for `write-file'. ;; `anything-insert-file' ;; Preconfigured `anything' providing completion for `insert-file'. ;; `anything-dired-rename-file' ;; Preconfigured `anything' to rename files from dired. ;; `anything-dired-copy-file' ;; Preconfigured `anything' to copy files from dired. ;; `anything-dired-symlink-file' ;; Preconfigured `anything' to symlink files from dired. ;; `anything-dired-hardlink-file' ;; Preconfigured `anything' to hardlink files from dired. ;; `anything-dired-bindings' ;; Replace usual dired commands `C' and `R' by anything ones. ;; `anything-M-x' ;; Preconfigured `anything' for Emacs commands. ;; `anything-manage-advice' ;; Preconfigured `anything' to disable/enable function advices. ;; `anything-bookmark-ext' ;; Preconfigured `anything' for bookmark-extensions sources. ;; `anything-simple-call-tree' ;; Preconfigured `anything' for simple-call-tree. List function relationships. ;; `anything-mark-ring' ;; Preconfigured `anything' for `anything-c-source-mark-ring'. ;; `anything-global-mark-ring' ;; Preconfigured `anything' for `anything-c-source-global-mark-ring'. ;; `anything-all-mark-rings' ;; Preconfigured `anything' for `anything-c-source-global-mark-ring' and `anything-c-source-mark-ring'. ;; `anything-yaoddmuse-cache-pages' ;; Fetch the list of files on emacswiki and create cache file. ;; `anything-yaoddmuse-emacswiki-edit-or-view' ;; Preconfigured `anything' to edit or view EmacsWiki page. ;; `anything-yaoddmuse-emacswiki-post-library' ;; Preconfigured `anything' to post library to EmacsWiki. ;; `anything-eval-expression' ;; Preconfigured anything for `anything-c-source-evaluation-result'. ;; `anything-eval-expression-with-eldoc' ;; Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. ;; `anything-surfraw' ;; Preconfigured `anything' to search PATTERN with search ENGINE. ;; `anything-emms-stream-edit-bookmark' ;; Change the information of current emms-stream bookmark from anything. ;; `anything-emms-stream-delete-bookmark' ;; Delete an emms-stream bookmark from anything. ;; `anything-call-source' ;; Preconfigured `anything' to call anything source. ;; `anything-call-source-from-anything' ;; Call anything source within `anything' session. ;; `anything-execute-anything-command' ;; Preconfigured `anything' to execute preconfigured `anything'. ;; `anything-create-from-anything' ;; Run `anything-create' from `anything' as a fallback. ;; `anything-create' ;; Preconfigured `anything' to do many create actions from STRING. ;; `anything-top' ;; Preconfigured `anything' for top command. ;; `anything-select-xfont' ;; Preconfigured `anything' to select Xfont. ;; `anything-apt' ;; Preconfigured `anything' : frontend of APT package manager. ;; `anything-c-shell-command-if-needed' ;; Not documented. ;; `anything-c-run-external-command' ;; Preconfigured `anything' to run External PROGRAM asyncronously from Emacs. ;; `anything-ratpoison-commands' ;; Preconfigured `anything' to execute ratpoison commands. ;; `anything-c-set-variable' ;; Set value to VAR interactively. ;; `anything-c-adaptive-save-history' ;; Save history information to file given by `anything-c-adaptive-history-file'. ;; * User variables defined here: ;; [EVAL] (autodoc-document-lisp-buffer :type 'user-variable :prefix "anything-" :var-value t) ;; `anything-c-use-standard-keys' ;; Default Value: nil ;; `anything-c-adaptive-history-file' ;; Default Value: "~/.emacs.d/anything-c-adaptive-history" ;; `anything-c-adaptive-history-length' ;; Default Value: 50 ;; `anything-c-google-suggest-url' ;; Default Value: "http://google.com/complete/search?output=toolbar&q=" ;; `anything-c-google-suggest-search-url' ;; Default Value: "http://www.google.com/search?ie=utf-8&oe=utf-8&q=" ;; `anything-google-suggest-use-curl-p' ;; Default Value: nil ;; `anything-c-yahoo-suggest-url' ;; Default Value: "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=G [...] ;; `anything-c-yahoo-suggest-search-url' ;; Default Value: "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p=" ;; `anything-c-boring-buffer-regexp' ;; Default Value: "\\ (\\` \\)\\|\\*anything\\| \\*Echo Area\\| \\*Minibuf" ;; `anything-c-boring-file-regexp' ;; Default Value: "/\\ (?:\\(?:\\.\\(?:git\\|hg\\|svn\\)\\|CVS\\|_darcs\\)\\)\\(?:/\\|$\\)\\| [...] ;; `anything-kill-ring-threshold' ;; Default Value: 10 ;; `anything-su-or-sudo' ;; Default Value: "su" ;; `anything-for-files-prefered-list' ;; Default Value: (anything-c-source-ffap-line anything-c-source-ffap-guesser anything-c-sou [...] ;; `anything-create--actions-private' ;; Default Value: nil ;; `anything-allow-skipping-current-buffer' ;; Default Value: t ;; `anything-c-enable-eval-defun-hack' ;; Default Value: t ;; `anything-tramp-verbose' ;; Default Value: 0 ;; `anything-raise-command' ;; Default Value: nil ;; `anything-command-map-prefix-key' ;; Default Value: " a" ;; `anything-c-find-files-show-icons' ;; Default Value: t ;; `anything-c-find-files-icons-directory' ;; Default Value: "/usr/share/emacs/24.0.50/etc/images/tree-widget/default" ;; `anything-c-browse-code-regexp-lisp' ;; Default Value: "^ * (def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|type\\|th [...] ;; `anything-c-browse-code-regexp-python' ;; Default Value: "\\\\|\\" ;; `anything-c-browse-code-regexp-alist' ;; Default Value: ((lisp-interaction-mode . "^ *(def\\(un\\|subst\\|macro\\|face\\|alias\\|a [...] ;; `anything-c-external-programs-associations' ;; Default Value: nil ;; * Anything sources defined here: ;; [EVAL] (autodoc-document-lisp-buffer :type 'anything-source :prefix "anything-" :any-sname t) ;; `anything-c-source-regexp' (Regexp Builder) ;; `anything-c-source-buffers' (Buffers) ;; `anything-c-source-buffer-not-found' (Create buffer) ;; `anything-c-source-buffers+' (Buffers) ;; `anything-c-source-file-name-history' (File Name History) ;; `anything-c-source-files-in-current-dir' (Files from Current Directory) ;; `anything-c-source-files-in-current-dir+' (Files from Current Directory) ;; `anything-c-source-find-files' (Find Files (`C-.':Go to precedent level)) ;; `anything-c-source-write-file' (Write File (`C-.':Go to precedent level)) ;; `anything-c-source-insert-file' (Insert File (`C-.':Go to precedent level)) ;; `anything-c-source-copy-files' (Copy Files (`C-.':Go to precedent level)) ;; `anything-c-source-symlink-files' (Symlink Files (`C-.':Go to precedent level)) ;; `anything-c-source-hardlink-files' (Hardlink Files (`C-.':Go to precedent level)) ;; `anything-c-source-file-cache-initialized' () ;; `anything-c-source-file-cache' (File Cache) ;; `anything-c-source-locate' (Locate) ;; `anything-c-source-recentf' (Recentf) ;; `anything-c-source-ffap-guesser' (File at point) ;; `anything-c-source-ffap-line' (File/Lineno at point) ;; `anything-c-source-files-in-all-dired' (Files in all dired buffer.) ;; `anything-c-source-info-pages' (Info Pages) ;; `anything-c-source-info-elisp' (Info index: elisp) ;; `anything-c-source-info-cl' (Info index: cl) ;; `anything-c-source-info-org' (Info index: org) ;; `anything-c-source-info-ratpoison' (Info index: ratpoison) ;; `anything-c-source-info-zsh' (Info index: zsh) ;; `anything-c-source-info-bash' (Info index: bash) ;; `anything-c-source-info-coreutils' (Info index: coreutils) ;; `anything-c-source-info-fileutils' (Info index: fileutils) ;; `anything-c-source-info-find' (Info index: find) ;; `anything-c-source-info-sh-utils' (Info index: sh-utils) ;; `anything-c-source-info-textutils' (Info index: textutils) ;; `anything-c-source-info-libc' (Info index: libc) ;; `anything-c-source-info-make' (Info index: make) ;; `anything-c-source-info-automake' (Info index: automake) ;; `anything-c-source-info-autoconf' (Info index: autoconf) ;; `anything-c-source-info-emacs-lisp-intro' (Info index: emacs-lisp-intro) ;; `anything-c-source-info-emacs' (Info index: emacs) ;; `anything-c-source-info-elib' (Info index: elib) ;; `anything-c-source-info-eieio' (Info index: eieio) ;; `anything-c-source-info-gauche-refe' (Info index: gauche) ;; `anything-c-source-info-guile' (Info index: guile) ;; `anything-c-source-info-guile-tut' (Info index: guile-tut) ;; `anything-c-source-info-goops' (Info index: goops) ;; `anything-c-source-info-screen' (Info index: screen) ;; `anything-c-source-info-latex' (Info index: latex) ;; `anything-c-source-info-gawk' (Info index: gawk) ;; `anything-c-source-info-sed' (Info index: sed) ;; `anything-c-source-info-m4' (Info index: m4) ;; `anything-c-source-info-wget' (Info index: wget) ;; `anything-c-source-info-binutils' (Info index: binutils) ;; `anything-c-source-info-as' (Info index: as) ;; `anything-c-source-info-bfd' (Info index: bfd) ;; `anything-c-source-info-gprof' (Info index: gprof) ;; `anything-c-source-info-ld' (Info index: ld) ;; `anything-c-source-info-diff' (Info index: diff) ;; `anything-c-source-info-flex' (Info index: flex) ;; `anything-c-source-info-grep' (Info index: grep) ;; `anything-c-source-info-gzip' (Info index: gzip) ;; `anything-c-source-info-libtool' (Info index: libtool) ;; `anything-c-source-info-texinfo' (Info index: texinfo) ;; `anything-c-source-info-info' (Info index: info) ;; `anything-c-source-info-gdb' (Info index: gdb) ;; `anything-c-source-info-stabs' (Info index: stabs) ;; `anything-c-source-info-cvsbook' (Info index: cvsbook) ;; `anything-c-source-info-cvs' (Info index: cvs) ;; `anything-c-source-info-bison' (Info index: bison) ;; `anything-c-source-info-id-utils' (Info index: id-utils) ;; `anything-c-source-info-global' (Info index: global) ;; `anything-c-source-man-pages' (Manual Pages) ;; `anything-c-source-complex-command-history' (Complex Command History) ;; `anything-c-source-extended-command-history' (Emacs Commands History) ;; `anything-c-source-emacs-commands' (Emacs Commands) ;; `anything-c-source-lacarte' (Lacarte) ;; `anything-c-source-emacs-functions' (Emacs Functions) ;; `anything-c-source-emacs-functions-with-abbrevs' (Emacs Functions) ;; `anything-c-source-advice' (Function Advice) ;; `anything-c-source-emacs-variables' (Emacs Variables) ;; `anything-c-source-bookmarks' (Bookmarks) ;; `anything-c-source-bookmark-set' (Set Bookmark) ;; `anything-c-source-bm' (Visible Bookmarks) ;; `anything-c-source-bookmarks-ssh' (Bookmarks-ssh) ;; `anything-c-source-bookmarks-su' (Bookmarks-root) ;; `anything-c-source-bookmarks-local' (Bookmarks-Local) ;; `anything-c-source-bmkext-addressbook' (Bookmark Addressbook) ;; `anything-c-source-bookmark-w3m' (Bookmark W3m) ;; `anything-c-source-bookmark-images' (Bookmark Images) ;; `anything-c-source-bookmark-man' (Bookmark Woman&Man) ;; `anything-c-source-bookmark-gnus' (Bookmark Gnus) ;; `anything-c-source-bookmark-info' (Bookmark Info) ;; `anything-c-source-bookmark-files&dirs' (Bookmark Files&Directories) ;; `anything-c-source-bookmark-su-files&dirs' (Bookmark Root-Files&Directories) ;; `anything-c-source-bookmark-ssh-files&dirs' (Bookmark Ssh-Files&Directories) ;; `anything-c-source-firefox-bookmarks' (Firefox Bookmarks) ;; `anything-c-source-w3m-bookmarks' (W3m Bookmarks) ;; `anything-c-source-elisp-library-scan' (Elisp libraries (Scan)) ;; `anything-c-source-imenu' (Imenu) ;; `anything-c-source-ctags' (Exuberant ctags) ;; `anything-c-source-semantic' (Semantic Tags) ;; `anything-c-source-simple-call-tree-functions-callers' (Function is called by) ;; `anything-c-source-simple-call-tree-callers-functions' (Function calls) ;; `anything-c-source-commands-and-options-in-file' (Commands/Options in file) ;; `anything-c-source-customize-face' (Customize Face) ;; `anything-c-source-colors' (Colors) ;; `anything-c-source-tracker-search' (Tracker Search) ;; `anything-c-source-mac-spotlight' (mdfind) ;; `anything-c-source-kill-ring' (Kill Ring) ;; `anything-c-source-mark-ring' (mark-ring) ;; `anything-c-source-global-mark-ring' (global-mark-ring) ;; `anything-c-source-register' (Registers) ;; `anything-c-source-fixme' (TODO/FIXME/DRY comments) ;; `anything-c-source-rd-headline' (RD HeadLine) ;; `anything-c-source-oddmuse-headline' (Oddmuse HeadLine) ;; `anything-c-source-emacs-source-defun' (Emacs Source DEFUN) ;; `anything-c-source-emacs-lisp-expectations' (Emacs Lisp Expectations) ;; `anything-c-source-emacs-lisp-toplevels' (Emacs Lisp Toplevel / Level 4 Comment / Linkd Star) ;; `anything-c-source-org-headline' (Org HeadLine) ;; `anything-c-source-yaoddmuse-emacswiki-edit-or-view' (Yaoddmuse Edit or View (EmacsWiki)) ;; `anything-c-source-yaoddmuse-emacswiki-post-library' (Yaoddmuse Post library (EmacsWiki)) ;; `anything-c-source-eev-anchor' (Anchors) ;; `anything-c-source-org-keywords' (Org Keywords) ;; `anything-c-source-picklist' (Picklist) ;; `anything-c-source-bbdb' (BBDB) ;; `anything-c-source-evaluation-result' (Evaluation Result) ;; `anything-c-source-calculation-result' (Calculation Result) ;; `anything-c-source-google-suggest' (Google Suggest) ;; `anything-c-source-yahoo-suggest' (Yahoo Suggest) ;; `anything-c-source-emms-streams' (Emms Streams) ;; `anything-c-source-emms-dired' (Music Directory) ;; `anything-c-source-emms-files' (Emms files) ;; `anything-c-source-jabber-contacts' (Jabber Contacts) ;; `anything-c-source-call-source' (Call anything source) ;; `anything-c-source-anything-commands' (Preconfigured Anything) ;; `anything-c-source-occur' (Occur) ;; `anything-c-source-browse-code' (Browse code) ;; `anything-c-source-create' (Create) ;; `anything-c-source-minibuffer-history' (Minibuffer History) ;; `anything-c-source-elscreen' (Elscreen) ;; `anything-c-source-top' (Top (Press C-c C-u to refresh)) ;; `anything-c-source-absolute-time-timers' (Absolute Time Timers) ;; `anything-c-source-idle-time-timers' (Idle Time Timers) ;; `anything-c-source-xrandr-change-resolution' (Change Resolution) ;; `anything-c-source-xfonts' (X Fonts) ;; `anything-c-source-apt' (APT) ;; `anything-c-source-gentoo' (Portage sources) ;; `anything-c-source-use-flags' (Use Flags) ;; `anything-c-source-emacs-process' (Emacs Process) ;; `anything-c-source-ratpoison-commands' (Ratpoison Commands) ;; *** END auto-documentation ;;; Change log: ;; ;; Change log of this file is found at ;; http://repo.or.cz/w/anything-config.git/history/master:/anything-config.el ;; ;; Change log of this project is found at ;; http://repo.or.cz/w/anything-config.git?a=shortlog ;;; 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 ;; Andy Stewart ;; Thierry Volpiatto ;; rubikitch ;; Scott Vokes ;; ;;; For Maintainers: ;; ;; Evaluate (autodoc-update-all) before commit. This function ;; generates anything-c-source-* / functions / options list. ;; ;; Install also developer-tools/autodoc.el ;; And eval it or run interactively. ;; ;; [EVAL IT] (autodoc-update-all) ;; ;; Please write details documentation about function, then others will ;; read code more easier. -- Andy Stewart ;; ;;; TODO ;; ;; - Fix documentation, now many functions haven't documentations. ;; ;;; Require (require 'anything) (require 'thingatpt) (require 'ffap) (require 'cl) ;;; Code: ;; version check (let ((version "1.263")) (when (and (string= "1." (substring version 0 2)) (string-match "1\.\\([0-9]+\\)" anything-version) (< (string-to-number (match-string 1 anything-version)) (string-to-number (substring version 2)))) (error "Please update anything.el!! http://www.emacswiki.org/cgi-bin/wiki/download/anything.el or M-x install-elisp-from-emacswiki anything.el"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Customize ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgroup anything-config nil "Predefined configurations for `anything.el'." :group 'anything) (defcustom anything-c-use-standard-keys nil "Whether use standard keybindings. (no effect) Key definitions in anything-config.el are removed because anything.el uses Emacs-standard keys by default. e.g. M-p/M-n for minibuffer history, C-s for isearch, etc. If you use `iswitchb' with `anything', evaluate (anything-iswitchb-setup) . Then some bindings that conflict with `iswitchb', e.g. C-p/C-n for the minibuffer history, are removed from `anything-map'. " :type 'boolean :group 'anything-config) (defcustom anything-c-adaptive-history-file "~/.emacs.d/anything-c-adaptive-history" "Path of file where history information is stored." :type 'string :group 'anything-config) (defcustom anything-c-adaptive-history-length 50 "Maximum number of candidates stored for a source." :type 'number :group 'anything-config) (defcustom anything-c-google-suggest-url "http://google.com/complete/search?output=toolbar&q=" "URL used for looking up Google suggestions." :type 'string :group 'anything-config) (defcustom anything-c-google-suggest-search-url "http://www.google.com/search?ie=utf-8&oe=utf-8&q=" "URL used for Google searching." :type 'string :group 'anything-config) (defcustom anything-google-suggest-use-curl-p nil "*When non--nil use CURL to get info from `anything-c-google-suggest-url'. Otherwise `url-retrieve-synchronously' is used." :type 'boolean :group 'anything-config) (defcustom anything-c-yahoo-suggest-url "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query=" "Url used for looking up Yahoo suggestions." :type 'string :group 'anything-config) (defcustom anything-c-yahoo-suggest-search-url "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p=" "Url used for Yahoo searching." :type 'string :group 'anything-config) (defcustom anything-c-boring-buffer-regexp (rx (or (group bos " ") ;; anything-buffer "*anything" ;; echo area " *Echo Area" " *Minibuf")) "The regexp that match boring buffers. Buffer candidates matching this regular expression will be filtered from the list of candidates if the `anything-c-skip-boring-buffers' candidate transformer is used, or they will be displayed with face `file-name-shadow' if `anything-c-shadow-boring-buffers' is used." :type 'string :group 'anything-config) ;; (string-match anything-c-boring-buffer-regexp "buf") ;; (string-match anything-c-boring-buffer-regexp " hidden") ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*") (defcustom anything-c-boring-file-regexp (rx (or ;; Boring directories (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol)) ;; Boring files (and line-start ".#") (and (or ".class" ".la" ".o" "~") eol))) "The regexp that match boring files. 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." :type 'string :group 'anything-config) (defcustom anything-kill-ring-threshold 10 "*Minimum length to be listed by `anything-c-source-kill-ring'." :type 'integer :group 'anything-config) (defcustom anything-su-or-sudo "su" "What command to use for root access." :type 'string :group 'anything-config) (defcustom anything-for-files-prefered-list '(anything-c-source-ffap-line anything-c-source-ffap-guesser anything-c-source-buffers+ anything-c-source-recentf anything-c-source-bookmarks anything-c-source-file-cache anything-c-source-files-in-current-dir+ anything-c-source-locate) "Your prefered sources to find files." :type 'list :group 'anything-config) (defcustom anything-create--actions-private nil "User defined actions for `anything-create' / `anything-c-source-create'. It is a list of (DISPLAY . FUNCTION) pairs like `action' attribute of `anything-sources'. It is prepended to predefined pairs." :type 'list :group 'anything-config) (defcustom anything-allow-skipping-current-buffer t "Show current buffer or not in anything buffer" :type 'boolean :group 'anything-config) (defcustom anything-c-enable-eval-defun-hack t "*If non-nil, execute `anything' using the source at point when C-M-x is pressed. This hack is invoked when pressing C-M-x in the form \ (defvar anything-c-source-XXX ...) or (setq anything-c-source-XXX ...)." :type 'boolean :group 'anything-config) (defcustom anything-tramp-verbose 0 "*Just like `tramp-verbose' but specific to anything. When set to 0 don't show tramp messages in anything. If you want to have the default tramp messages set it to 3." :type 'integer :group 'anything-config) (defcustom anything-raise-command nil "*A shell command to jump to a window running specific program. Stumpwm users could use: \"stumpish eval \"\(stumpwm::%s\)\"\". With others windows manager you could use: \"wmctrl -xa %s\". Though wmctrl work also with stumpwm." :type 'string :group 'anything-config) (defun anything-set-anything-command-map-prefix-key (var key) (when (boundp 'anything-command-map-prefix-key) (global-unset-key (read-kbd-macro anything-command-map-prefix-key))) (setq anything-command-map-prefix-key key) (global-set-key (read-kbd-macro anything-command-map-prefix-key) 'anything-command-map)) (defcustom anything-command-map-prefix-key " a" "*The prefix key for all `anything-command-map' commands. !!WARNING!! This default value is very likely to be changed, because it is under discussion." :type 'string :set 'anything-set-anything-command-map-prefix-key :group 'anything-config) (defcustom anything-c-find-files-show-icons nil "*Whether show or hide icons in `anything-find-files'." :type 'boolean :group 'anything-config) (defcustom anything-c-find-files-icons-directory (concat (car image-load-path) "tree-widget/default") "*Default path where to find files and directory icons." :type 'string :group 'anything-config) (defcustom anything-c-browse-code-regexp-lisp "^ *\(def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|\ type\\|theme\\|var\\|group\\|custom\\|const\\|method\\|class\\)" "*Regexp used to parse lisp buffer when browsing code." :type 'string :group 'anything-config) (defcustom anything-c-browse-code-regexp-python "\\\\|\\" "*Regexp used to parse python buffer when browsing code." :type 'string :group 'anything-config) (defcustom anything-c-browse-code-regexp-alist `((lisp-interaction-mode . ,anything-c-browse-code-regexp-lisp) (emacs-lisp-mode . ,anything-c-browse-code-regexp-lisp) (lisp-mode . ,anything-c-browse-code-regexp-lisp) (python-mode . ,anything-c-browse-code-regexp-python)) "*Alist to store regexps for browsing code corresponding \ to a specific `major-mode'." :type 'list :group 'anything-config) (defcustom anything-c-external-programs-associations nil "*Alist to store externals programs associated with file extension. This variable overhide setting in .mailcap file. e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) " :type 'list :group 'anything-config) ;;;###autoload (defun anything-configuration () "Customize `anything'." (interactive) (customize-group "anything-config")) ;;; Anything-command-map ;;;###autoload (defvar anything-command-map) (define-prefix-command 'anything-command-map) ;; rubikitch: Please change it freely because it is in discussion. I'll track from git. (define-key anything-command-map (kbd "") 'anything-execute-anything-command) (define-key anything-command-map (kbd "e") 'anything-etags-maybe-at-point) (define-key anything-command-map (kbd "l") 'anything-locate) (define-key anything-command-map (kbd "s") 'anything-surfraw) (define-key anything-command-map (kbd "r") 'anything-regexp) (define-key anything-command-map (kbd "w") 'anything-w3m-bookmarks) (define-key anything-command-map (kbd "x") 'anything-firefox-bookmarks) (define-key anything-command-map (kbd "#") 'anything-emms) (define-key anything-command-map (kbd "m") 'anything-man-woman) (define-key anything-command-map (kbd "t") 'anything-top) (define-key anything-command-map (kbd "i") 'anything-imenu) (define-key anything-command-map (kbd "p") 'anything-list-emacs-process) (define-key anything-command-map (kbd "C-x r b") 'anything-c-pp-bookmarks) (define-key anything-command-map (kbd "M-y") 'anything-show-kill-ring) (define-key anything-command-map (kbd "C-c ") 'anything-all-mark-rings) (define-key anything-command-map (kbd "C-x C-f") 'anything-find-files) (define-key anything-command-map (kbd "f") 'anything-for-files) (define-key anything-command-map (kbd "C-:") 'anything-eval-expression-with-eldoc) (define-key anything-command-map (kbd "C-,") 'anything-calcul-expression) (define-key anything-command-map (kbd "M-x") 'anything-M-x) (define-key anything-command-map (kbd "C-x C-w") 'anything-write-file) (define-key anything-command-map (kbd "C-x i") 'anything-insert-file) (define-key anything-command-map (kbd "M-s o") 'anything-occur) (define-key anything-command-map (kbd "c") 'anything-colors) (define-key anything-command-map (kbd "F") 'anything-select-xfont) (define-key anything-command-map (kbd "C-c f") 'anything-recentf) (define-key anything-command-map (kbd "C-c g") 'anything-google-suggest) (define-key anything-command-map (kbd "h i") 'anything-info-at-point) (define-key anything-command-map (kbd "h r") 'anything-info-emacs) (define-key anything-command-map (kbd "C-x C-b") 'anything-buffers+) (define-key anything-command-map (kbd "C-c C-b") 'anything-browse-code) (define-key anything-command-map (kbd "C-x r i") 'anything-register) (define-key anything-command-map (kbd "C-c C-x") 'anything-c-run-external-command) ;; In Emacs 23.1.50, minibuffer-local-must-match-filename-map was renamed to ;; minibuffer-local-filename-must-match-map. (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) ;; Emacs 23.1.+ (defvar minibuffer-local-must-match-filename-map (make-sparse-keymap)) ;; Older Emacsen (dolist (map (list minibuffer-local-filename-completion-map minibuffer-local-completion-map minibuffer-local-must-match-filename-map minibuffer-local-filename-must-match-map minibuffer-local-map minibuffer-local-isearch-map minibuffer-local-must-match-map minibuffer-local-ns-map)) (define-key map "\C-r" 'anything-minibuffer-history)) ;;; Menu (easy-menu-define nil global-map "`anything' menu" '("Anything" ["All anything commands" anything-execute-anything-command t] ["Find any Files/Buffers" anything-for-files t] "----" ("Files:" ["Find files" anything-find-files t] ["Recent Files" anything-recentf t] ["Locate" anything-locate t] ["Bookmarks" anything-c-pp-bookmarks t]) ("Buffers:" ["Find buffers" anything-buffers+ t]) ("Commands:" ["Emacs Commands" anything-M-x t] ["Externals Commands" anything-c-run-external-command t]) ("Info:" ["Info at point" anything-info-at-point t] ["Emacs Manual index" anything-info-emacs t]) ("Org:" ["Org keywords" anything-org-keywords t] ["Org headlines" anything-org-headlines t]) ("Tools:" ["Occur" anything-occur t] ["Browse Kill ring" anything-show-kill-ring t] ["Browse register" anything-register t] ["Browse code" anything-browse-code t] ["Mark Ring" anything-all-mark-rings t] ["Regexp handler" anything-regexp t] ["Colors & Faces" anything-colors t] ["Show xfonts" anything-select-xfont t] ["Imenu" anything-imenu t] ["Google Suggest" anything-google-suggest t] ["Eval expression" anything-eval-expression-with-eldoc t] ["Calcul expression" anything-calcul-expression t] ["Man pages" anything-man-woman t] ["Top externals process" anything-top t] ["Emacs internals process" anything-list-emacs-process t]) "----" ["Prefered Options" anything-configuration t])) ;;; Documentation ;; It is replaced by `anything-help' (defun anything-c-describe-anything-bindings () "[OBSOLETE] Describe `anything' bindings." (interactive) (anything-run-after-quit #'(lambda () (with-current-buffer (get-buffer-create "*Anything Help*") (erase-buffer) (insert (substitute-command-keys "The keys that are defined for `anything' are: \\{anything-map}"))) (pop-to-buffer "*Anything Help*") (goto-char (point-min))))) ;; Use `describe-mode' key in `global-map' ;; (dolist (k (where-is-internal 'describe-mode global-map)) ;; (define-key anything-map k 'anything-c-describe-anything-bindings)) ;;; Help message (defun anything-c-list-preconfigured-anything () (loop with doc with sym for entry in (cdr (assoc (file-truename (locate-library "anything-config")) load-history)) if (and (consp entry) (eq (car entry) 'defun) (string-match "^Preconfigured.+$" (setq doc (or (documentation (setq sym (cdr entry))) "")))) collect (cons sym (match-string 0 doc)))) (defun anything-c-format-preconfigured-anything () (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x))) (anything-c-list-preconfigured-anything))) (setq anything-help-message (lambda () (concat "\\" "`anything' is QuickSilver-like candidate-selection framework. Narrow the list by typing some pattern, Multiple patterns are allowed by splitting by space. Select with natural Emacs operations, choose with RET. If you have any problems, press C-c C-x C-b!! Feel free to send bug reports. I'll fix them. The steps are described in the beginning of anything.el file. == Basic Operations == C-p, Up: Previous Line C-n, Down : Next Line M-v, PageUp : Previous Page C-v, PageDown : Next Page Enter : Execute first (default) action / Select M-< : First Line M-> : Last Line M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window) M-PageDown, C-M-v : Next Page (other-window) Tab, C-i : Show action list Left : Previous Source Right, C-o : Next Source C-k : Delete pattern C-z : Persistent Action (Execute action with anything session kept) C-c C-x C-b: Send a bug report == Shortcuts For 2nd/3rd Action == \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line) \\[anything-select-3rd-action] : Execute 3rd Action == Visible Marks == Visible marks store candidate. Some actions uses marked candidates. \\[anything-toggle-visible-mark] : Toggle Visible Mark \\[anything-prev-visible-mark] : Previous Mark \\[anything-next-visible-mark] : Next Mark == Miscellaneous Commands == \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window \\[anything-quit-and-find-file] : Drop into `find-file' \\[anything-delete-current-selection] : Delete Selected Item (visually) \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit \\[anything-yank-selection] : Yank Selected Item Into Pattern \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action \\[anything-force-update] : Recalculate And Redisplay Candidates == Global Commands == \\\\[anything-resume] revives last `anything' session. It is very useful, so you should bind any key. Single source is executed by \\[anything-call-source]. == Preconfigured `anything' == Preconfigured `anything' is commands that uses `anything' interface. You can use them without configuration. " (apply 'concat (anything-c-format-preconfigured-anything)) " Enjoy!"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Preconfigured Anything ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;###autoload (defun anything-mini () "Preconfigured `anything' lightweight version (buffer -> recentf)." (interactive) (anything-other-buffer '(anything-c-source-buffers+ anything-c-source-recentf) "*anything mini*")) ;;;###autoload (defun anything-for-files () "Preconfigured `anything' for opening files. ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate" (interactive) (anything-other-buffer anything-for-files-prefered-list "*anything for files*")) ;;;###autoload (defun anything-recentf () "Preconfigured `anything' for `recentf'." (interactive) (anything-other-buffer 'anything-c-source-recentf "*anything recentf*")) ;;;###autoload (defun anything-info-at-point () "Preconfigured `anything' for searching info at point." (interactive) (anything '(anything-c-source-info-elisp anything-c-source-info-cl anything-c-source-info-pages) (thing-at-point 'symbol) nil nil nil "*anything info*")) ;;;###autoload (defun anything-info-emacs () "Preconfigured anything for Emacs manual index." (interactive) (anything-other-buffer 'anything-c-source-info-emacs "*info emacs*")) ;;;###autoload (defun anything-show-kill-ring () "Preconfigured `anything' for `kill-ring'. It is drop-in replacement of `yank-pop'. You may bind this command to M-y." (interactive) (anything-other-buffer 'anything-c-source-kill-ring "*anything kill-ring*")) ;;;###autoload (defun anything-minibuffer-history () "Preconfigured `anything' for `minibuffer-history'." (interactive) (let ((enable-recursive-minibuffers t)) (anything-other-buffer 'anything-c-source-minibuffer-history "*anything minibuffer-history*"))) ;;;###autoload (defun anything-gentoo () "Preconfigured `anything' for gentoo linux." (interactive) (anything-other-buffer '(anything-c-source-gentoo anything-c-source-use-flags) "*anything gentoo*")) ;;;###autoload (defun anything-imenu () "Preconfigured `anything' for `imenu'." (interactive) (anything 'anything-c-source-imenu nil nil nil nil "*anything imenu*")) ;;;###autoload (defun anything-google-suggest () "Preconfigured `anything' for google search with google suggest." (interactive) (anything-other-buffer 'anything-c-source-google-suggest "*anything google*")) ;;;###autoload (defun anything-yahoo-suggest () "Preconfigured `anything' for Yahoo searching with Yahoo suggest." (interactive) (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*")) ;;; Converted from anything-show-*-only ;;;###autoload (defun anything-for-buffers () "Preconfigured `anything' for buffer." (interactive) (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*")) ;;;###autoload (defun anything-buffers+ () "Enhanced preconfigured `anything' for buffer." (interactive) (anything-other-buffer 'anything-c-source-buffers+ "*anything buffers*")) ;;;###autoload (defun anything-bbdb () "Preconfigured `anything' for BBDB. Needs BBDB. http://bbdb.sourceforge.net/" (interactive) (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*")) ;;;###autoload (defun anything-locate () "Preconfigured `anything' for Locate. Note you can add locate command after entering pattern. See man locate for more infos." (interactive) (anything-other-buffer 'anything-c-source-locate "*anything locate*")) ;;;###autoload (defun anything-w3m-bookmarks () "Preconfigured `anything' for w3m bookmark. Needs w3m and emacs-w3m. http://w3m.sourceforge.net/ http://emacs-w3m.namazu.org/" (interactive) (anything-other-buffer 'anything-c-source-w3m-bookmarks "*anything w3m bookmarks*")) ;;;###autoload (defun anything-firefox-bookmarks () "Preconfigured `anything' for firefox bookmark. You will have to enable html bookmarks in firefox: open about:config in firefox and double click on this line to enable value \ to true: user_pref(\"browser.bookmarks.autoExportHTML\", false); You should have now: user_pref(\"browser.bookmarks.autoExportHTML\", true); After closing firefox, you will be able to browse you bookmarks. " (interactive) (anything-other-buffer 'anything-c-source-firefox-bookmarks "*Anything Firefox*")) ;;;###autoload (defun anything-colors () "Preconfigured `anything' for color." (interactive) (anything-other-buffer '(anything-c-source-colors anything-c-source-customize-face) "*anything colors*")) ;;;###autoload (defun anything-bookmarks () "Preconfigured `anything' for bookmarks." (interactive) (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*")) ;;;###autoload (defun anything-c-pp-bookmarks () "Preconfigured `anything' for bookmarks (pretty-printed)." (interactive) (anything-other-buffer '(anything-c-source-bookmarks-local anything-c-source-bookmarks-su anything-c-source-bookmarks-ssh) "*anything pp bookmarks*")) ;;;###autoload (defun anything-register () "Preconfigured `anything' for Emacs registers." (interactive) (anything-other-buffer 'anything-c-source-register "*anything register*")) ;;;###autoload (defun anything-man-woman () "Preconfigured `anything' for Man and Woman pages." (interactive) (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*")) ;;;###autoload (defun anything-org-keywords () "Preconfigured `anything' for org keywords." (interactive) (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*")) ;;;###autoload (defun anything-emms () "Preconfigured `anything' for emms sources." (interactive) (anything '(anything-c-source-emms-streams anything-c-source-emms-files anything-c-source-emms-dired) nil nil nil nil "*Anything Emms*")) ;;;###autoload (defun anything-eev-anchors () "Preconfigured `anything' for eev anchors." (interactive) (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*")) ;;;###autoload (defun anything-bm-list () "Preconfigured `anything' for visible bookmarks. Needs bm.el http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el" (interactive) (let ((anything-outline-using t)) (anything-other-buffer 'anything-c-source-bm "*anything bm list*"))) ;;;###autoload (defun anything-timers () "Preconfigured `anything' for timers." (interactive) (anything-other-buffer '(anything-c-source-absolute-time-timers anything-c-source-idle-time-timers) "*anything timers*")) ;;;###autoload (defun anything-list-emacs-process () "Preconfigured `anything' for emacs process." (interactive) (anything-other-buffer 'anything-c-source-emacs-process "*anything process*")) ;;;###autoload (defun anything-occur () "Preconfigured Anything for Occur source." (interactive) (let ((anything-compile-source-functions ;; rule out anything-match-plugin because the input is one regexp. (delq 'anything-compile-source--match-plugin (copy-sequence anything-compile-source-functions)))) (anything-other-buffer 'anything-c-source-occur "*Anything Occur*"))) ;;;###autoload (defun anything-browse-code () "Preconfigured anything to browse code." (interactive) (anything-other-buffer 'anything-c-source-browse-code "*Browse code*")) ;;;###autoload (defun anything-org-headlines () "Preconfigured anything to show org headlines." (interactive) (anything-other-buffer 'anything-c-source-org-headline "*org headlines*")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; kill buffers ;;;###autoload (defun anything-kill-buffers () "Preconfigured `anything' to kill buffer you selected." (interactive) (anything '(((name . "Kill Buffers") (candidates . anything-c-buffer-list) (action ("Kill Buffer" . (lambda (candidate) (kill-buffer candidate) (anything-kill-buffers) ))))) nil nil)) ;;; Regexp (defun anything-c-query-replace-regexp (candidate) (let ((regexp (funcall (anything-attr 'regexp)))) (apply 'query-replace-regexp (anything-c-query-replace-args regexp)))) (defun anything-c-kill-regexp-as-sexp (candidate) (anything-c-regexp-kill-new (prin1-to-string (funcall (anything-attr 'regexp))))) (defun anything-c-kill-regexp (candidate) (anything-c-regexp-kill-new (funcall (anything-attr 'regexp)))) (defun anything-c-query-replace-args (regexp) "create arguments of `query-replace-regexp' action in `anything-regexp'." (let ((region-only (anything-region-active-p))) (list regexp (query-replace-read-to regexp (format "Query replace %s regexp %s" (if anything-current-prefix-arg "word " "") (if region-only "in region " "")) t) anything-current-prefix-arg (when region-only (region-beginning)) (when region-only (region-end))))) (defvar anything-c-source-regexp '((name . "Regexp Builder") (init . (lambda () (anything-candidate-buffer anything-current-buffer))) (candidates-in-buffer) (get-line . anything-c-regexp-get-line) (persistent-action . anything-c-regexp-persistent-action) (persistent-help . "Show this line") (multiline) (delayed) (requires-pattern . 2) (mode-line . "Press TAB to select action.") ;; RUBIKITCH: ;; I use here `anything-input' because `anything-pattern' is lost when ;; using actions from action buffer (otherwise no e.g from RET, C-e or C-j). ;; It seem `anything-select-action' reset `anything-pattern' to empty too early. ;; Though the regexp attribute stay defined (tested with *-attr-defined). ;; Can you fix it? (regexp . (lambda () anything-input)) (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp) ("Query Replace Regexp" . anything-c-query-replace-regexp) ("Kill Regexp" . anything-c-kill-regexp))))) (defun anything-c-regexp-get-line (s e) (propertize (apply 'concat ;; Line contents (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e)) ;; subexps (loop for i from 0 to (1- (/ (length (match-data)) 2)) collect (format "\n %s'%s'" (if (zerop i) "Group 0: " (format "Group %d: " i)) (match-string i)))) ;; match beginning ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer. ;; It is implementation problem of candidates-in-buffer. 'anything-realvalue (1- s))) ;; Shut up byte compiler (defun anything-goto-line (numline) "Replacement of `goto-line'." (goto-char (point-min)) (forward-line (1- numline))) (defun anything-c-regexp-persistent-action (pt) (goto-char pt) (anything-persistent-highlight-point)) (defun anything-c-regexp-kill-new (input) (kill-new input) (message "Killed: %s" input)) (defun anything-region-active-p () (and transient-mark-mode mark-active (/= (mark) (point)))) (defun* anything-current-buffer-narrowed-p (&optional (buffer anything-current-buffer)) "Check if BUFFER is narrowed. Default is `anything-current-buffer'." (with-current-buffer buffer (let ((beg (point-min)) (end (point-max)) (total (buffer-size))) (or (/= beg 1) (/= end (1+ total)))))) ;;;###autoload (defun anything-regexp () "Preconfigured anything to build regexps and run query-replace-regexp \ against." (interactive) (save-restriction (let ((anything-compile-source-functions ;; rule out anything-match-plugin because the input is one regexp. (delq 'anything-compile-source--match-plugin (copy-sequence anything-compile-source-functions)))) (when (and (anything-region-active-p) ;; Don't narrow to region if buffer is already narrowed. (not (anything-current-buffer-narrowed-p))) (narrow-to-region (region-beginning) (region-end))) (anything :sources anything-c-source-regexp :buffer "*anything regexp*" :prompt "Regexp: ")))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Interactive Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun anything-insert-buffer-name () "Insert buffer name." (interactive) (anything-insert-string (with-current-buffer anything-current-buffer (if buffer-file-name (file-name-nondirectory buffer-file-name) (buffer-name))))) (defun anything-insert-symbol () "Insert current symbol." (interactive) (anything-insert-string (with-current-buffer anything-current-buffer (save-excursion (buffer-substring (beginning-of-thing 'symbol) (end-of-thing 'symbol)))))) (defun anything-insert-selection () "Insert current selection." (interactive) (anything-insert-string (with-current-buffer anything-current-buffer (anything-get-selection)))) (defun anything-show-buffer-only () "[OBSOLETE] Only show sources about buffer. Use `anything-for-buffers' instead." (interactive) (anything-set-source-filter '("Buffers"))) (defun anything-show-bbdb-only () "[OBSOLETE] Only show sources about BBDB. Use `anything-bbdb' instead." (interactive) (anything-set-source-filter '("BBDB"))) (defun anything-show-locate-only () "[OBSOLETE] Only show sources about Locate. Use `anything-locate' instead." (interactive) (anything-set-source-filter '("Locate"))) (defun anything-show-info-only () "[OBSOLETE] Only show sources about Info. Use `anything-info-at-point' instead." (interactive) (anything-set-source-filter '("Info Pages" "Info Elisp" "Info Common-Lisp"))) (defun anything-show-imenu-only () "[OBSOLETE] Only show sources about Imenu. Use `anything-imenu' instead." (interactive) (anything-set-source-filter '("Imenu"))) (defun anything-show-files-only () "[OBSOLETE] Only show sources about File. Use `anything-for-files' instead." (interactive) (anything-set-source-filter '("File Name History" "Files from Current Directory" "Recentf"))) (defun anything-show-w3m-bookmarks-only () "[OBSOLETE] Only show source about w3m bookmark. Use `anything-w3m-bookmarks' instead." (interactive) (anything-set-source-filter '("W3m Bookmarks"))) (defun anything-show-colors-only () "[OBSOLETE] Only show source about color. Use `anything-colors' instead." (interactive) (anything-set-source-filter '("Colors" "Customize Faces"))) (defun anything-show-kill-ring-only () "[OBSOLETE] Only show source about kill ring. Use `anything-show-kill-ring' instead." (interactive) (anything-set-source-filter '("Kill Ring"))) (defun anything-show-this-source-only () "Only show this source." (interactive) (setq anything-candidate-number-limit 9999) (anything-set-source-filter (list (assoc-default 'name (anything-get-current-source))))) (defun anything-test-sources () "List all anything sources for test. The output is sexps which are evaluated by \\[eval-last-sexp]." (interactive) (with-output-to-temp-buffer "*Anything Test Sources*" (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s))) (apropos-internal "^anything-c-source" #'boundp)) (pop-to-buffer standard-output))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utilities Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; For compatibility (unless (fboundp 'region-active-p) (defun region-active-p () "Return t if Transient Mark mode is enabled and the mark is active. Most commands that act on the region if it is active and Transient Mark mode is enabled, and on the text near point otherwise, should use `use-region-p' instead. That function checks the value of `use-empty-active-region' as well." (and transient-mark-mode mark-active))) (defun anything-nest (&rest same-as-anything) "Nested `anything'. If you use `anything' within `anything', use it." (with-selected-window (anything-window) (let (anything-current-position anything-current-buffer (orig-anything-buffer anything-buffer) anything-pattern anything-buffer anything-sources anything-compiled-sources anything-buffer-chars-modified-tick (anything-samewindow t) (enable-recursive-minibuffers t)) (unwind-protect (apply #'anything same-as-anything) (anything-initialize-overlays orig-anything-buffer) (add-hook 'post-command-hook 'anything-check-minibuffer-input))))) (defun anything-displaying-source-names () "Display sources name." (with-current-buffer anything-buffer (goto-char (point-min)) (loop with pos while (setq pos (next-single-property-change (point) 'anything-header)) do (goto-char pos) collect (buffer-substring-no-properties (point-at-bol)(point-at-eol)) do (forward-line 1)))) (defun anything-select-source () "Select source." (interactive) (let ((default (assoc-default 'name (anything-get-current-source))) (source-names (anything-displaying-source-names)) (all-source-names (mapcar (lambda (s) (assoc-default 'name s)) (anything-get-sources)))) (setq anything-candidate-number-limit 9999) (anything-aif (let (anything-source-filter) (anything-nest '(((name . "Anything Source") (candidates . source-names) (action . identity)) ((name . "Anything Source (ALL)") (candidates . all-source-names) (action . identity))) nil "Source: " nil default "*anything select source*")) (anything-set-source-filter (list it)) (anything-set-source-filter nil)))) (defun anything-insert-string (str) "Insert STR." (delete-minibuffer-contents) (insert str)) (defun anything-c-match-on-file-name (candidate) "Return non-nil if `anything-pattern' match 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' match the directory part of CANDIDATE (a file)." (anything-aif (file-name-directory candidate) (string-match anything-pattern it))) (defun anything-c-string-match (candidate) "Return non-nil if `anything-pattern' match CANDIDATE. The match is done with `string-match'." (string-match anything-pattern candidate)) ;; `anything-c-compose' is no more needed, it is for compatibility. (defalias 'anything-c-compose 'anything-compose) (defun anything-c-skip-entries (list regexp) "Remove entries which matches REGEXP from LIST." (remove-if (lambda (x) (and (stringp x) (string-match regexp x))) list)) (defun anything-c-shadow-entries (list regexp) "Elements of LIST matching 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 regexp file) (setq file (propertize file 'face face)))) file) list)) (defsubst anything-c-stringify (str-or-sym) "Get string of STR-OR-SYM." (if (stringp str-or-sym) str-or-sym (symbol-name str-or-sym))) (defsubst anything-c-symbolify (str-or-sym) "Get symbol of STR-OR-SYM." (if (symbolp str-or-sym) str-or-sym (intern str-or-sym))) (defun anything-c-describe-function (func) "FUNC is symbol or string." (describe-function (anything-c-symbolify func))) (defun anything-c-describe-variable (var) "VAR is symbol or string." (describe-variable (anything-c-symbolify var))) (defun anything-c-find-function (func) "FUNC is symbol or string." (find-function (anything-c-symbolify func))) (defun anything-c-find-variable (var) "VAR is symbol or string." (find-variable (anything-c-symbolify var))) (defun anything-c-kill-new (string &optional replace yank-handler) "STRING is symbol or string." (kill-new (anything-c-stringify string) replace yank-handler)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Prefix argument in action ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TODO: This should be integrated in anything.el instead of having ;; a defadvice here. (defvar anything-current-prefix-arg nil "Record `current-prefix-arg' when exiting minibuffer. It will be cleared at start of next `anything' call when \ `anything-before-initialize-hook' is called.") (defadvice anything-exit-minibuffer (before anything-current-prefix-arg activate) (unless anything-current-prefix-arg (setq anything-current-prefix-arg current-prefix-arg))) ;; using this hook instead of `anything-after-action-hook' ;; allow to record the prefix args and keep their values ;; when using `anything-comp-read'. (add-hook 'anything-before-initialize-hook (lambda () (setq anything-current-prefix-arg nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Hacks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defadvice eval-defun (after anything-source-hack activate) "See `anything-c-enable-eval-defun-hack'." (when anything-c-enable-eval-defun-hack (let ((varsym (save-excursion (beginning-of-defun) (forward-char 1) (when (memq (read (current-buffer)) '(defvar setq)) (read (current-buffer)))))) (when (string-match "^anything-c-source-" (symbol-name varsym)) (anything varsym))))) ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Document Generator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst anything-c-create-summary-index-regexp "^;;;; <\\(.+?\\)>$\\|^;; (anything '\\(.+?\\))$\\|^ *;; (anything '\\(.+?\\))$") (defun anything-c-create-summary () "Create `anything' summary." (save-excursion (goto-char (point-min)) (loop with it while (re-search-forward anything-c-create-summary-index-regexp nil t) collect (cond ((setq it (match-string-no-properties 1)) (cons 'section it)) ((setq it (match-string-no-properties 2)) `(source ,it . ,(assoc-default 'name (symbol-value (intern it))))) ((setq it (match-string-no-properties 3)) `(source ,it . ,(assoc-default 'name (symbol-value (intern it))))))))) ;; (find-epp (anything-c-create-summary)) (defun anything-c-insert-summary () "Insert `anything' summary." (save-excursion (goto-char (point-min)) (search-forward ";; Below are complete source list you can setup in") (forward-line 1) (delete-region (point) (progn (search-forward ";;; Change log:" nil t) (forward-line -1) (point))) (insert ";;\n") (loop with beg for (kind . value) in (anything-c-create-summary) for i from 0 do (cond ((eq kind 'section) (unless (zerop i) (align-regexp beg (point) "\\(\\s-*\\)(" 1 1 nil)) (insert ";; " value ":\n") (setq beg (point))) (t (insert ";; `" (car value) "' (" (cdr value) ")\n"))) finally (align-regexp beg (point) "\\(\\s-*\\)(" 1 1 nil)))) ;; (anything-c-insert-summary) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Sources ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; (defun anything-c-buffer-list () "Return the list of names of buffers with boring buffers filtered out. Boring buffers is specified by `anything-c-boring-buffer-regexp'. The first buffer in the list will be the last recently used buffer that is not the current buffer." (let ((buffers (mapcar 'buffer-name (buffer-list)))) (append (cdr buffers) (list (car buffers))))) (defvar anything-c-source-buffers '((name . "Buffers") (candidates . anything-c-buffer-list) (type . buffer))) ;; (anything 'anything-c-source-buffers) (defvar anything-c-source-buffer-not-found '((name . "Create buffer") (dummy) (type . buffer))) ;; (anything 'anything-c-source-buffer-not-found) ;;; Buffers+ (defface anything-dir-heading '((t (:foreground "Blue" :background "Pink"))) "*Face used for directory headings in dired buffers." :group 'anything) (defface anything-file-name '((t (:foreground "Blue"))) "*Face used for file names (without suffixes) in dired buffers." :group 'anything) (defface anything-dir-priv '((t (:foreground "DarkRed" :background "LightGray"))) "*Face used for directory privilege indicator (d) in dired buffers." :group 'anything) (defvar anything-c-buffers-face1 'anything-dir-priv) (defvar anything-c-buffers-face2 'font-lock-type-face) (defvar anything-c-buffers-face3 'italic) (eval-when-compile (require 'dired)) (defun anything-c-highlight-buffers (buffers) (require 'dired) (loop for i in buffers if (rassoc (get-buffer i) dired-buffers) collect (propertize i 'face anything-c-buffers-face1 'help-echo (car (rassoc (get-buffer i) dired-buffers))) if (buffer-file-name (get-buffer i)) collect (propertize i 'face anything-c-buffers-face2 'help-echo (buffer-file-name (get-buffer i))) if (and (not (rassoc (get-buffer i) dired-buffers)) (not (buffer-file-name (get-buffer i)))) collect (propertize i 'face anything-c-buffers-face3))) (defvar anything-c-source-buffers+ '((name . "Buffers") (candidates . anything-c-buffer-list) (type . buffer) (candidate-transformer anything-c-skip-current-buffer anything-c-highlight-buffers anything-c-skip-boring-buffers) (persistent-action . anything-c-buffers+-persistent-action) (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer"))) (defun anything-c-buffers+-persistent-action (name) (flet ((kill (item) (with-current-buffer item (if (and (buffer-modified-p) (buffer-file-name (current-buffer))) (progn (save-buffer) (kill-buffer item)) (kill-buffer item)))) (goto (item) (switch-to-buffer item))) (if current-prefix-arg (progn (kill name) (anything-delete-current-selection)) (goto name)))) ;; (anything 'anything-c-source-buffers+) ;;;; ;;; 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))) ;; (anything 'anything-c-source-file-name-history) ;;; Files in current dir (defvar anything-c-source-files-in-current-dir '((name . "Files from Current Directory") (candidates . (lambda () (with-current-buffer anything-current-buffer (directory-files (anything-c-current-directory))))) ;; volatile is not needed, I think. (type . file))) ;; (anything 'anything-c-source-files-in-current-dir) (defvar anything-c-files-face1 'anything-dir-priv) (defvar anything-c-files-face2 'anything-file-name) (defun anything-c-highlight-files (files) (loop for i in files if (file-directory-p i) collect (propertize (file-name-nondirectory i) 'face anything-c-files-face1 'help-echo (expand-file-name i)) else collect (propertize (file-name-nondirectory i) 'face anything-c-files-face2 'help-echo (expand-file-name i)))) (defvar anything-c-source-files-in-current-dir+ '((name . "Files from Current Directory") (candidates . (lambda () (with-current-buffer anything-current-buffer (directory-files (anything-c-current-directory) t)))) (candidate-transformer anything-c-highlight-files) ;; volatile is not needed, I think. (type . file))) ;; (anything 'anything-c-source-files-in-current-dir+) ;;; Anything replacement of file name completion for `find-file' and friends. (defvar anything-c-find-files-doc-header (format " (`%s':Go to precedent level)" (if window-system "C-." "C-l")) "*The doc that is inserted in the Name header of a find-files or dired source.") (defvar anything-c-source-find-files `((name . ,(concat "Find Files" anything-c-find-files-doc-header)) ;; It is needed for filenames with capital letters (disable-shortcuts) (init . (lambda () (setq ffap-newfile-prompt t))) (candidates . anything-find-files-get-candidates) (filtered-candidate-transformer anything-c-find-files-transformer) (persistent-action . anything-find-files-persistent-action) (persistent-help . "Expand Candidate") (volatile) (action . ,(delq nil `(("Find File" . anything-c-find-file-or-marked) ("Find file in Dired" . anything-c-point-file-in-dired) ,(and (locate-library "elscreen") '("Find file in Elscreen" . anything-elscreen-find-file)) ("Complete at point" . anything-c-insert-file-name-completion-at-point) ("Delete File(s)" . anything-delete-marked-files) ("Find file as root" . anything-find-file-as-root) ("Open file externally (C-u to choose)" . anything-c-open-file-externally) ;; ("Create dired buffer on marked" ;; . anything-c-create-dired-on-marked) ("Find file other window" . find-file-other-window) ("Find file other frame" . find-file-other-frame)))))) ;; (anything 'anything-c-source-find-files) (defun* anything-reduce-file-name (fname level &key unix-close expand) "Reduce FNAME by LEVEL from end or beginning depending LEVEL value. If LEVEL is positive reduce from end else from beginning. If UNIX-CLOSE is non--nil close filename with /. If EXPAND is non--nil expand-file-name." (let* ((exp-fname (expand-file-name fname)) (fname-list (split-string (if (or (string= fname "~/") expand) exp-fname fname) "/" t)) (len (length fname-list)) (pop-list (if (< level 0) (subseq fname-list (* level -1)) (subseq fname-list 0 (- len level)))) (result (mapconcat 'identity pop-list "/")) (empty (string= result ""))) (when unix-close (setq result (concat result "/"))) (if (string-match "^~" result) (if (string= result "~/") "~/" result) (if (< level 0) (if empty "../" (concat "../" result)) (cond ((eq system-type 'windows-nt) (if empty "c:/" result)) (empty "/") (t (concat "/" result))))))) (defun anything-file-completion-source-p () "Test if current source is a dired or find-files source." (let ((ff-sources '("Find Files" "Copy Files" "Rename Files" "Symlink Files" "Hardlink Files" "Write File" "Insert File" "Read file name")) (cur-source (cdr (assoc 'name (anything-get-current-source))))) (catch 'break (dolist (i ff-sources) (when (equal cur-source (concat i anything-c-find-files-doc-header)) (throw 'break t)))))) (defun anything-find-files-down-one-level (arg) "Go down one level like unix command `cd ..'. If prefix numeric arg is given go ARG level down." (interactive "p") (when (anything-file-completion-source-p) (let ((new-pattern (anything-reduce-file-name anything-pattern arg :unix-close t :expand t))) (with-selected-window (minibuffer-window) (delete-minibuffer-contents) (insert new-pattern))))) ;; `C-.' doesn't work in terms use `C-l' instead. (if window-system (define-key anything-map (kbd "C-.") 'anything-find-files-down-one-level) (define-key anything-map (kbd "C-l") 'anything-find-files-down-one-level)) (defun anything-c-point-file-in-dired (file) "Put point on filename FILE in dired buffer." (dired (file-name-directory file)) (dired-goto-file file)) (defun anything-create-tramp-name (fname) "Build filename for `anything-pattern' like /su:: or /sudo::." (apply #'tramp-make-tramp-file-name (loop with v = (tramp-dissect-file-name fname) for i across v collect i))) (defun anything-find-files-get-candidates () "Create candidate list for `anything-c-source-find-files'." (let* ( ; Don't try to tramp connect before entering the second ":". (tramp-file-name-regexp "\\`/\\([^[/:]+\\|[^/]+]\\):.*:?") (path (cond ((string-match "^~" anything-pattern) (replace-match (getenv "HOME") nil t anything-pattern)) ((string-match tramp-file-name-regexp anything-pattern) (let ((tramp-name (anything-create-tramp-name (match-string 0 anything-pattern)))) (replace-match tramp-name nil t anything-pattern))) (t anything-pattern))) (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0. ;; Inlined version (<2010-02-18 Jeu.>.) of `tramp-handle-directory-files' ;; to fix bug in tramp that doesn't show the dot file names(i.e "." "..") ;; and sorting. (flet ((tramp-handle-directory-files (directory &optional full match nosort files-only) "Like `directory-files' for Tramp files." ;; FILES-ONLY is valid for XEmacs only. (when (file-directory-p directory) (setq directory (file-name-as-directory (expand-file-name directory))) (let ((temp (nreverse (file-name-all-completions "" directory))) result item) (while temp (setq item (directory-file-name (pop temp))) (when (and (or (null match) (string-match match item)) (or (null files-only) ;; Files only. (and (equal files-only t) (file-regular-p item)) ;; Directories only. (file-directory-p item))) (push (if full (concat directory item) item) result))) (if nosort result (sort result 'string<)))))) (set-text-properties 0 (length path) nil path) (setq anything-pattern (replace-regexp-in-string " " ".*" path)) (cond ((or (file-regular-p path) (and ffap-url-regexp (string-match ffap-url-regexp path))) (list path)) ((string= anything-pattern "") (directory-files "/" t)) ((file-directory-p path) (directory-files path t)) (t (append (list path) (directory-files (file-name-directory path) t))))))) (defface anything-dired-symlink-face '((t (:foreground "DarkOrange"))) "*Face used for symlinks in `anything-find-files'." :group 'anything) (defface anything-ffiles-prefix-face '((t (:background "yellow" :foreground "black"))) "*Face used to prefix new file or url paths in `anything-find-files'." :group 'anything) (defun anything-c-prefix-filename (fname &optional image) "Return fname FNAME prefixed with icon IMAGE." (let* ((img-name (and image (expand-file-name image anything-c-find-files-icons-directory))) (img (and image (create-image img-name))) (prefix-img (and image (propertize " " 'display img))) (prefix-new (propertize " " 'display (propertize "[?]" 'face 'anything-ffiles-prefix-face))) (prefix-url (propertize " " 'display (propertize "[@]" 'face 'anything-ffiles-prefix-face)))) (cond ((or (file-exists-p fname) (file-symlink-p fname)) (if image (concat prefix-img fname) fname)) ((string-match ffap-url-regexp fname) (concat prefix-url " " fname)) (t (concat prefix-new " " fname))))) (defun anything-c-find-files-transformer (files sources) (if (and (window-system) anything-c-find-files-show-icons) (anything-c-highlight-ffiles1 files sources) (anything-c-highlight-ffiles files sources))) (defun anything-c-highlight-ffiles (files sources) "Candidate transformer for `anything-c-source-find-files' without icons." (loop for i in files collect (cond ((file-symlink-p i) (cons (anything-c-prefix-filename (propertize i 'face 'anything-dired-symlink-face 'help-echo (file-truename i))) i)) ((file-directory-p i) (cons (anything-c-prefix-filename (propertize i 'face anything-c-files-face1)) i)) (t (cons (anything-c-prefix-filename (propertize i 'face anything-c-files-face2)) i))))) (defsubst anything-c-highlight-ffiles1 (files sources) "Candidate transformer for `anything-c-source-find-files' that show icons." (loop for i in files for af = (file-name-nondirectory i) collect (cond ( ;; Files. (eq nil (car (file-attributes i))) (cons (anything-c-prefix-filename (propertize i 'face anything-c-files-face2) "leaf.xpm") i)) ( ;; Empty directories. (and (eq t (car (file-attributes i))) ;; Be sure to have permission to list content. (file-readable-p i) (eq 0 (length (directory-files i nil directory-files-no-dot-files-regexp t)))) (cons (anything-c-prefix-filename (propertize i 'face anything-c-files-face1) "empty.xpm") i)) ( ;; Open directories. (and (eq t (car (file-attributes i))) (get-buffer af)) (cons (anything-c-prefix-filename (propertize i 'face anything-c-files-face1) "open.xpm") i)) (;; Closed directories. (eq t (car (file-attributes i))) (cons (anything-c-prefix-filename (propertize i 'face anything-c-files-face1) "close.xpm") i)) ( ;; Open Symlinks directories. (and (stringp (car (file-attributes i))) (file-directory-p i) (get-buffer af)) (cons (anything-c-prefix-filename (propertize i 'face 'anything-dired-symlink-face 'help-echo (file-truename i)) "open.xpm") i)) ( ;; Closed Symlinks directories. (and (stringp (car (file-attributes i))) (file-directory-p i)) (cons (anything-c-prefix-filename (propertize i 'face 'anything-dired-symlink-face 'help-echo (file-truename i)) "close.xpm") i)) ( ;; Files symlinks. (stringp (car (file-attributes i))) (cons (anything-c-prefix-filename (propertize i 'face 'anything-dired-symlink-face 'help-echo (file-truename i)) "leaf.xpm") i))))) (defun anything-find-files-persistent-action (candidate) "Open subtree CANDIDATE without quitting anything. If CANDIDATE is not a directory expand CANDIDATE filename. If CANDIDATE is alone, open file CANDIDATE filename." (flet ((insert-in-minibuffer (elm) (with-selected-window (minibuffer-window) (delete-minibuffer-contents) (set-text-properties 0 (length elm) nil elm) (insert elm)))) (cond ((and (file-directory-p candidate) (file-symlink-p candidate)) (insert-in-minibuffer (file-name-as-directory (file-truename (expand-file-name candidate))))) ((file-directory-p candidate) (insert-in-minibuffer (file-name-as-directory (expand-file-name candidate)))) ((file-symlink-p candidate) (insert-in-minibuffer (file-truename candidate))) (t ; First hit on C-z expand CANDIDATE second hit open file. (let ((new-pattern (anything-get-selection anything-last-buffer)) (num-lines-buf (with-current-buffer anything-last-buffer (count-lines (point-min) (point-max))))) (if (> num-lines-buf 3) (insert-in-minibuffer new-pattern) (find-file candidate))))))) (defun anything-c-insert-file-name-completion-at-point (candidate) "Insert file name completion at point." (if buffer-read-only (error "Error: Buffer `%s' is read-only" (buffer-name)) (let* ((end (point)) (guess (thing-at-point 'filename)) (full-path-p (or (string-match (concat "^" (getenv "HOME")) guess) (string-match "^[^\~]" guess)))) (set-text-properties 0 (length candidate) nil candidate) (if (and guess (not (string= guess "")) (string-match "^~\\|/.*" guess)) (progn (search-backward guess (- (point) (length guess))) (delete-region (point) end) (if full-path-p (insert (expand-file-name candidate)) (insert (abbreviate-file-name candidate)))) (error "Aborting completion: No valid file name at point"))))) ;;;###autoload (defun anything-find-files () "Preconfigured `anything' for anything implementation of `find-file'." (interactive) (let ((anything-mp-highlight-delay nil)) (anything :sources 'anything-c-source-find-files :input (anything-find-files-input (ffap-guesser) (thing-at-point 'filename)) :prompt "Find Files or Url: " :buffer "*Anything Find Files*"))) (defun anything-c-current-directory () "Return current-directory name at point. Useful in dired buffers when there is inserted subdirs." (if (eq major-mode 'dired-mode) (dired-current-directory) default-directory)) (defun anything-find-files-input (fap tap) "Default input of `anything-find-files'." (let* ((def-dir (anything-c-current-directory)) (lib (anything-find-library-at-point)) (file-p (and fap (file-exists-p fap) (file-exists-p (file-name-directory (expand-file-name tap def-dir))))) (input (cond (lib) (file-p (expand-file-name tap def-dir)) (t fap)))) (or input (expand-file-name def-dir)))) (defun anything-find-library-at-point () "Try to find library path at point. Find inside `require' and `declare-function' sexp." (require 'find-func) (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t))) (end-sexp (save-excursion (search-forward ")" (point-at-eol) t))) (sexp (and beg-sexp end-sexp (buffer-substring-no-properties (1+ beg-sexp) (1- end-sexp))))) (ignore-errors (cond ((and sexp (string-match "require \'.+[^)]" sexp)) (find-library-name (replace-regexp-in-string "'\\|\)\\|\(" "" ;; If require use third arg, ignore it, ;; always use library path found in `load-path'. (second (split-string (match-string 0 sexp)))))) ((and sexp (string-match-p "^declare-function" sexp)) (find-library-name (replace-regexp-in-string "\"\\|ext:" "" (third (split-string sexp))))) (t nil))))) ;;; Anything completion for `write-file'.==> C-x C-w (defvar anything-c-source-write-file `((name . ,(concat "Write File" anything-c-find-files-doc-header)) ;; It is needed for filenames with capital letters (disable-shortcuts) (candidates . anything-find-files-get-candidates) (filtered-candidate-transformer anything-c-find-files-transformer) (persistent-action . anything-find-files-persistent-action) (persistent-help . "Expand Candidate") (volatile) (action . (("Write File" . (lambda (candidate) (write-file candidate 'confirm))))))) ;;;###autoload (defun anything-write-file () "Preconfigured `anything' providing completion for `write-file'." (interactive) (anything 'anything-c-source-write-file (expand-file-name default-directory) "Write buffer to file: " nil nil "*Anything write file*")) ;;; Anything completion for `insert-file'.==> C-x i (defvar anything-c-source-insert-file `((name . ,(concat "Insert File" anything-c-find-files-doc-header)) ;; It is needed for filenames with capital letters (disable-shortcuts) (candidates . anything-find-files-get-candidates) (filtered-candidate-transformer anything-c-find-files-transformer) (persistent-action . anything-find-files-persistent-action) (persistent-help . "Expand Candidate") (volatile) (action . (("Insert File" . (lambda (candidate) (when (y-or-n-p (format "Really insert %s in %s " candidate anything-current-buffer)) (insert-file-contents candidate)))))))) ;;;###autoload (defun anything-insert-file () "Preconfigured `anything' providing completion for `insert-file'." (interactive) (anything 'anything-c-source-insert-file (expand-file-name default-directory) "Insert file: " nil nil "*Anything insert file*")) ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired. (defvar anything-c-source-copy-files `((name . ,(concat "Copy Files" anything-c-find-files-doc-header)) ;; It is needed for filenames with capital letters (disable-shortcuts) (candidates . anything-find-files-get-candidates) (filtered-candidate-transformer anything-c-find-files-transformer) (persistent-action . anything-find-files-persistent-action) (persistent-help . "Expand Candidate") (volatile) (action . (("Copy File" . (lambda (candidate) (anything-dired-action candidate :action 'copy))) ("Copy and Follow" . (lambda (candidate) (anything-dired-action candidate :action 'copy :follow t))))))) (defvar anything-c-source-rename-files `((name . ,(concat "Rename Files" anything-c-find-files-doc-header)) ;; It is needed for filenames with capital letters (disable-shortcuts) (candidates . anything-find-files-get-candidates) (filtered-candidate-transformer anything-c-find-files-transformer) (persistent-action . anything-find-files-persistent-action) (persistent-help . "Expand Candidate") (volatile) (action . (("Rename File" . (lambda (candidate) (anything-dired-action candidate :action 'rename))) ("Rename and Follow" . (lambda (candidate) (anything-dired-action candidate :action 'rename :follow t))))))) (defvar anything-c-source-symlink-files `((name . ,(concat "Symlink Files" anything-c-find-files-doc-header)) ;; It is needed for filenames with capital letters (disable-shortcuts) (candidates . anything-find-files-get-candidates) (filtered-candidate-transformer anything-c-find-files-transformer) (persistent-action . anything-find-files-persistent-action) (persistent-help . "Expand Candidate") (volatile) (action . (("Symlink File" . (lambda (candidate) (anything-dired-action candidate :action 'symlink))) ("RelSymlink File" . (lambda (candidate) (anything-dired-action candidate :action 'relsymlink))))))) (defvar anything-c-source-hardlink-files `((name . ,(concat "Hardlink Files" anything-c-find-files-doc-header)) ;; It is needed for filenames with capital letters (disable-shortcuts) (candidates . anything-find-files-get-candidates) (filtered-candidate-transformer anything-c-find-files-transformer) (persistent-action . anything-find-files-persistent-action) (persistent-help . "Expand Candidate") (volatile) (action . (("Hardlink File" . (lambda (candidate) (anything-dired-action candidate :action 'hardlink))))))) (defun* anything-dired-action (candidate &key action follow) "Copy, rename or symlink file at point or marked files in dired to CANDIDATE. ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink." (let ((files (dired-get-marked-files)) (fn (case action ('copy 'dired-copy-file) ('rename 'dired-rename-file) ('symlink 'make-symbolic-link) ('relsymlink 'dired-make-relative-symlink) ('hardlink 'dired-hardlink))) (marker (case action ((copy rename) dired-keep-marker-copy) ('symlink dired-keep-marker-symlink) ('relsymlink dired-keep-marker-relsymlink) ('hardlink dired-keep-marker-hardlink)))) (dired-create-files fn (symbol-name action) files (if (file-directory-p candidate) ;; When CANDIDATE is a directory, build file-name in this directory. ;; Else we use CANDIDATE. #'(lambda (from) (expand-file-name (file-name-nondirectory from) candidate)) #'(lambda (from) candidate)) marker) (when follow (let* ((src (car files)) (dest (expand-file-name candidate)) (basename-src (if (file-directory-p src) (file-relative-name (directory-file-name src) (file-name-directory src)) (file-name-nondirectory src))) (fname (if (file-directory-p dest) (concat (file-name-as-directory dest) basename-src) dest))) (anything-c-point-file-in-dired fname))))) (defun* anything-dired-do-action-on-file (&key action) (let* ((files (dired-get-marked-files)) (len (length files)) (fname (if (> len 1) (format "* %d Files" len) (car files))) (source (case action ('copy 'anything-c-source-copy-files) ('rename 'anything-c-source-rename-files) ('symlink 'anything-c-source-symlink-files) ('hardlink 'anything-c-source-hardlink-files))) (prompt-fm (case action ('copy "Copy %s to: ") ('rename "Rename %s to: ") ('symlink "Symlink %s to: ") ('hardlink "Hardlink %s to: "))) (buffer (case action ('copy "*Anything Copy Files*") ('rename "*Anything Rename Files*") ('symlink "*Anything Symlink Files*") ('hardlink "*Anything Hardlink Files*")))) (anything source (or (dired-dwim-target-directory) (expand-file-name (anything-c-current-directory))) (format prompt-fm fname) nil nil buffer))) ;;;###autoload (defun anything-dired-rename-file () "Preconfigured `anything' to rename files from dired." (interactive) (anything-dired-do-action-on-file :action 'rename)) ;;;###autoload (defun anything-dired-copy-file () "Preconfigured `anything' to copy files from dired." (interactive) (anything-dired-do-action-on-file :action 'copy)) ;;;###autoload (defun anything-dired-symlink-file () "Preconfigured `anything' to symlink files from dired." (interactive) (anything-dired-do-action-on-file :action 'symlink)) ;;;###autoload (defun anything-dired-hardlink-file () "Preconfigured `anything' to hardlink files from dired." (interactive) (anything-dired-do-action-on-file :action 'hardlink)) (defvar anything-dired-bindings nil) ;;;###autoload (defun anything-dired-bindings (&optional arg) "Replace usual dired commands `C' and `R' by anything ones. When call interactively toggle dired bindings and anything bindings. When call non--interactively with arg > 0, enable anything bindings. You can put (anything-dired-binding 1) in init file to enable anything bindings." (interactive) (if (or (when arg (> arg 0)) (not anything-dired-bindings)) (progn (define-key dired-mode-map (kbd "C") 'anything-dired-copy-file) (define-key dired-mode-map (kbd "R") 'anything-dired-rename-file) (define-key dired-mode-map (kbd "S") 'anything-dired-symlink-file) (define-key dired-mode-map (kbd "H") 'anything-dired-hardlink-file) (setq anything-dired-bindings t)) (define-key dired-mode-map (kbd "C") 'dired-do-copy) (define-key dired-mode-map (kbd "R") 'dired-do-rename) (define-key dired-mode-map (kbd "S") 'dired-do-symlink) (define-key dired-mode-map (kbd "H") 'dired-do-hardlink) (setq anything-dired-bindings nil))) (defun* anything-c-read-file-name (prompt &key (initial-input (expand-file-name default-directory)) (buffer "*Anything Completions*") test) "Anything `read-file-name' emulation. INITIAL-INPUT is a valid path, TEST is a predicate that take one arg." (when (get-buffer anything-action-buffer) (kill-buffer anything-action-buffer)) (or (anything :sources `((name . ,(concat "Read file name" anything-c-find-files-doc-header)) ;; It is needed for filenames with capital letters (disable-shortcuts) (candidates . (lambda () (if test (loop with seq = (anything-find-files-get-candidates) for fname in seq when (funcall test fname) collect fname) (anything-find-files-get-candidates)))) (filtered-candidate-transformer anything-c-highlight-ffiles) (persistent-action . anything-find-files-persistent-action) (persistent-help . "Expand Candidate") (volatile) (action . (("candidate" . ,'identity)))) :input initial-input :prompt prompt :resume 'noresume :buffer buffer) (keyboard-quit))) ;;; 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 () (require 'filecache nil t) (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))) ;; (anything 'anything-c-source-file-cache) ;;; Locate ;; NOTE for WINDOZE users: ;; You have to install Everything with his command line interface here: ;; http://www.voidtools.com/download.php (defvar anything-c-locate-command (case system-type ('gnu/linux "locate -i -r %s") ('berkeley-unix "locate -i %s") ('windows-nt "es -i -r %s") (t "locate %s")) "A list of arguments for locate program. The \"-r\" option must be the last option.") (defun anything-c-locate-init () "Initialize async locate process for `anything-c-source-locate'." (start-process-shell-command "locate-process" nil (format anything-c-locate-command anything-pattern))) (defvar anything-c-source-locate '((name . "Locate") (candidates . anything-c-locate-init) (type . file) (requires-pattern . 3) (delayed)) "Find files matching the current input pattern with locate.") ;; (anything 'anything-c-source-locate) ;;; Recentf files (defvar anything-c-source-recentf '((name . "Recentf") (init . (lambda () (require 'recentf) (or recentf-mode (recentf-mode 1)) ;; Big value empowers anything/recentf (when (and (numberp recentf-max-saved-items) (<= recentf-max-saved-items 20)) (setq recentf-max-saved-items 500)))) (candidates . recentf-list) (match anything-c-match-on-file-name anything-c-match-on-directory-name) (type . file)) "See (info \"(emacs)File Conveniences\"). if `recentf-max-saved-items' is too small, set it to 500.") ;; (anything 'anything-c-source-recentf) ;;; ffap (eval-when-compile (require 'ffap)) (defvar anything-c-source-ffap-guesser '((name . "File at point") (init . (lambda () (require 'ffap))) (candidates . (lambda () (anything-aif (with-current-buffer anything-current-buffer (ffap-guesser)) (list it)))) (type . file))) ;; (anything 'anything-c-source-ffap-guesser) ;;; ffap with line number (defun anything-c-ffap-file-line-at-point () "Get (FILENAME . LINENO) at point." (anything-aif (let (ffap-alist) (ffap-file-at-point)) (save-excursion (beginning-of-line) (when (and (search-forward it nil t) (looking-at ":\\([0-9]+\\)")) (cons it (string-to-number (match-string 1))))))) (defvar anything-c-ffap-line-location nil "(FILENAME . LINENO) used by `anything-c-source-ffap-line'. It is cleared after jumping line.") (defun anything-c-ffap-line-candidates () (with-current-buffer anything-current-buffer (setq anything-c-ffap-line-location (anything-c-ffap-file-line-at-point))) (when anything-c-ffap-line-location (destructuring-bind (file . line) anything-c-ffap-line-location (list (cons (format "%s (line %d)" file line) file))))) ;;; Goto line after opening file by `anything-c-source-ffap-line'. (defun anything-c-ffap-line-goto-line () (when (car anything-c-ffap-line-location) (unwind-protect (ignore-errors (with-selected-window (get-buffer-window (get-file-buffer (car anything-c-ffap-line-location))) (anything-goto-line (cdr anything-c-ffap-line-location))))))) (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line) (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line) (defvar anything-c-source-ffap-line '((name . "File/Lineno at point") (init . (lambda () (require 'ffap))) (candidates . anything-c-ffap-line-candidates) (type . file))) ;; (anything 'anything-c-source-ffap-line) ;;; list of files gleaned from every dired buffer (defun anything-c-files-in-all-dired-candidates () (save-excursion (mapcan (lambda (dir) (cond ((listp dir) ;filelist dir) ((equal "" (file-name-nondirectory dir)) ;dir (directory-files dir t)) (t ;wildcard (file-expand-wildcards dir t)))) (delq nil (mapcar (lambda (buf) (set-buffer buf) (when (eq major-mode 'dired-mode) (if (consp dired-directory) (cdr dired-directory) ;filelist dired-directory))) ;dir or wildcard (buffer-list)))))) ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk")) (defvar anything-c-source-files-in-all-dired '((name . "Files in all dired buffer.") (candidates . anything-c-files-in-all-dired-candidates) (type . file))) ;; (anything 'anything-c-source-files-in-all-dired) (defcustom anything-c-filelist-file-name nil "*Filename of file list. Accept a list of string for multiple files. This file tend to be very large (> 100MB) and recommend to be in ramdisk for speed. File list is created by make-filelist.rb script. Usage: ruby make-filelist.rb > /tmp/all.filelist Then ;; Assume that /tmp is ramdisk or tmpfs (setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\") (setq anything-c-filelist-file-name \"/tmp/all.filelist\") " :type 'string :group 'anything-config) (defvar anything-c-source-filelist '((name . "FileList") (grep-candidates . anything-c-filelist-file-name) (candidate-number-limit . 200) (requires-pattern . 4) (type . file))) ;;;###autoload (defun anything-filelist () "Preconfigured `anything' to open files instantly." (interactive) (anything-other-buffer 'anything-c-source-filelist "*anything file list*")) ;;;###autoload (defun anything-filelist+ () "Preconfigured `anything' to open files/buffers/bookmarks instantly. This is a replacement for `anything-for-files'." (interactive) (anything-other-buffer '(anything-c-source-ffap-line anything-c-source-ffap-guesser anything-c-source-buffers+ anything-c-source-recentf anything-c-source-bookmarks anything-c-source-file-cache anything-c-source-filelist) "*anything file list*")) ;;;; ;;; 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))) ;; (anything 'anything-c-source-info-pages) ;;; Use info-index plug-in. Note that `name' attribute is ;;; not needed but `anything-c-insert-summary' uses it. ;; Info Elisp (defvar anything-c-source-info-elisp '((name . "Info index: elisp") (info-index . "elisp"))) ;; (anything 'anything-c-source-info-elisp) ;; Info-Common-Lisp (defvar anything-c-source-info-cl '((name . "Info index: cl") (info-index . "cl"))) ;; (anything 'anything-c-source-info-cl) ;; Info Index org (defvar anything-c-source-info-org '((name . "Info index: org") (info-index . "org"))) ;; (anything 'anything-c-source-info-org) ;; Info Index ratpoison (defvar anything-c-source-info-ratpoison '((name . "Info index: ratpoison") (info-index . "ratpoison"))) ;; (anything 'anything-c-source-info-ratpoison) ;; Info Index zsh (defvar anything-c-source-info-zsh '((name . "Info index: zsh") (info-index . "zsh"))) ;; (anything 'anything-c-source-info-zsh) ;; Info Index bash (defvar anything-c-source-info-bash '((name . "Info index: bash") (info-index . "bash"))) ;; (anything 'anything-c-source-info-bash) ;; Info Index coreutils (defvar anything-c-source-info-coreutils '((name . "Info index: coreutils") (info-index . "coreutils"))) ;; (anything 'anything-c-source-info-coreutils) ;; Info Index fileutils (defvar anything-c-source-info-fileutils '((name . "Info index: fileutils") (info-index . "fileutils"))) ;; (anything 'anything-c-source-info-fileutils) ;; Info Index find (defvar anything-c-source-info-find '((name . "Info index: find") (info-index . "find"))) ;; (anything 'anything-c-source-info-find) ;; Info Index sh-utils (defvar anything-c-source-info-sh-utils '((name . "Info index: sh-utils") (info-index . "sh-utils"))) ;; (anything 'anything-c-source-info-sh-utils) ;; Info Index textutils (defvar anything-c-source-info-textutils '((name . "Info index: textutils") (info-index . "textutils"))) ;; (anything 'anything-c-source-info-textutils) ;; Info Index libc (defvar anything-c-source-info-libc '((name . "Info index: libc") (info-index . "libc"))) ;; (anything 'anything-c-source-info-libc) ;; Info Index make (defvar anything-c-source-info-make '((name . "Info index: make") (info-index . "make"))) ;; (anything 'anything-c-source-info-make) ;; Info Index automake (defvar anything-c-source-info-automake '((name . "Info index: automake") (info-index . "automake"))) ;; (anything 'anything-c-source-info-automake) ;; Info Index autoconf (defvar anything-c-source-info-autoconf '((name . "Info index: autoconf") (info-index . "autoconf"))) ;; (anything 'anything-c-source-info-autoconf) ;; Info Index emacs-lisp-intro (defvar anything-c-source-info-emacs-lisp-intro '((name . "Info index: emacs-lisp-intro") (info-index . "emacs-lisp-intro"))) ;; (anything 'anything-c-source-info-emacs-lisp-intro) ;; Info Index emacs (defvar anything-c-source-info-emacs '((name . "Info index: emacs") (info-index . "emacs"))) ;; (anything 'anything-c-source-info-emacs) ;; Info Index elib (defvar anything-c-source-info-elib '((name . "Info index: elib") (info-index . "elib"))) ;; (anything 'anything-c-source-info-elib) ;; Info Index eieio (defvar anything-c-source-info-eieio '((name . "Info index: eieio") (info-index . "eieio"))) ;; (anything 'anything-c-source-info-eieio) ;; Info Index gauche-refe (defvar anything-c-source-info-gauche-refe '((name . "Info index: gauche") (info-index . "gauche-refe"))) ;; (anything 'anything-c-source-info-gauche-refe) ;; Info Index guile (defvar anything-c-source-info-guile '((name . "Info index: guile") (info-index . "guile"))) ;; (anything 'anything-c-source-info-guile) ;; Info Index guile-tut (defvar anything-c-source-info-guile-tut '((name . "Info index: guile-tut") (info-index . "guile-tut"))) ;; (anything 'anything-c-source-info-guile-tut) ;; Info Index goops (defvar anything-c-source-info-goops '((name . "Info index: goops") (info-index . "goops"))) ;; (anything 'anything-c-source-info-goops) ;; Info Index screen (defvar anything-c-source-info-screen '((name . "Info index: screen") (info-index . "screen") (index-nodes "Concept Index" "Command Index" "Keystroke Index"))) ;; (anything 'anything-c-source-info-screen) ;; Info Index latex (defvar anything-c-source-info-latex '((name . "Info index: latex") (info-index . "latex"))) ;; (anything 'anything-c-source-info-latex) ;; Info Index gawk (defvar anything-c-source-info-gawk '((name . "Info index: gawk") (info-index . "gawk"))) ;; (anything 'anything-c-source-info-gawk) ;; Info Index sed (defvar anything-c-source-info-sed '((name . "Info index: sed") (info-index . "sed"))) ;; (anything 'anything-c-source-info-sed) ;; Info Index m4 (defvar anything-c-source-info-m4 '((name . "Info index: m4") (info-index . "m4"))) ;; (anything 'anything-c-source-info-m4) ;; Info Index wget (defvar anything-c-source-info-wget '((name . "Info index: wget") (info-index . "wget"))) ;; (anything 'anything-c-source-info-wget) ;; Info Index binutils (defvar anything-c-source-info-binutils '((name . "Info index: binutils") (info-index . "binutils"))) ;; (anything 'anything-c-source-info-binutils) ;; Info Index as (defvar anything-c-source-info-as '((name . "Info index: as") (info-index . "as"))) ;; (anything 'anything-c-source-info-as) ;; Info Index bfd (defvar anything-c-source-info-bfd '((name . "Info index: bfd") (info-index . "bfd"))) ;; (anything 'anything-c-source-info-bfd) ;; Info Index gprof (defvar anything-c-source-info-gprof '((name . "Info index: gprof") (info-index . "gprof"))) ;; (anything 'anything-c-source-info-gprof) ;; Info Index ld (defvar anything-c-source-info-ld '((name . "Info index: ld") (info-index . "ld"))) ;; (anything 'anything-c-source-info-ld) ;; Info Index diff (defvar anything-c-source-info-diff '((name . "Info index: diff") (info-index . "diff"))) ;; (anything 'anything-c-source-info-diff) ;; Info Index flex (defvar anything-c-source-info-flex '((name . "Info index: flex") (info-index . "flex"))) ;; (anything 'anything-c-source-info-flex) ;; Info Index grep (defvar anything-c-source-info-grep '((name . "Info index: grep") (info-index . "grep"))) ;; (anything 'anything-c-source-info-grep) ;; Info Index gzip (defvar anything-c-source-info-gzip '((name . "Info index: gzip") (info-index . "gzip"))) ;; (anything 'anything-c-source-info-gzip) ;; Info Index libtool (defvar anything-c-source-info-libtool '((name . "Info index: libtool") (info-index . "libtool"))) ;; (anything 'anything-c-source-info-libtool) ;; Info Index texinfo (defvar anything-c-source-info-texinfo '((name . "Info index: texinfo") (info-index . "texinfo"))) ;; (anything 'anything-c-source-info-texinfo) ;; Info Index info (defvar anything-c-source-info-info '((name . "Info index: info") (info-index . "info"))) ;; (anything 'anything-c-source-info-info) ;; Info Index gdb (defvar anything-c-source-info-gdb '((name . "Info index: gdb") (info-index . "gdb"))) ;; (anything 'anything-c-source-info-gdb) ;; Info Index stabs (defvar anything-c-source-info-stabs '((name . "Info index: stabs") (info-index . "stabs"))) ;; (anything 'anything-c-source-info-stabs) ;; Info Index cvsbook (defvar anything-c-source-info-cvsbook '((name . "Info index: cvsbook") (info-index . "cvsbook"))) ;; (anything 'anything-c-source-info-cvsbook) ;; Info Index cvs (defvar anything-c-source-info-cvs '((name . "Info index: cvs") (info-index . "cvs"))) ;; (anything 'anything-c-source-info-cvs) ;; Info Index bison (defvar anything-c-source-info-bison '((name . "Info index: bison") (info-index . "bison"))) ;; (anything 'anything-c-source-info-bison) ;; Info Index id-utils (defvar anything-c-source-info-id-utils '((name . "Info index: id-utils") (info-index . "id-utils"))) ;; (anything 'anything-c-source-info-id-utils) ;; Info Index global (defvar anything-c-source-info-global '((name . "Info index: global") (info-index . "global"))) ;; (anything 'anything-c-source-info-global) ;;;; ;;; 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 (ignore-errors (require 'woman) (woman-file-name "") (sort (mapcar 'car woman-topic-all-completions) 'string-lessp)))))) (action ("Show with Woman" . (lambda (candidate) (let ((wfiles (woman-file-name-all-completions candidate))) (if (> (length wfiles) 1) (woman-find-file (anything-comp-read "ManFile: " wfiles :must-match t)) (woman candidate)))))) ;; Woman does not work OS X ;; http://xahlee.org/emacs/modernization_man_page.html (action-transformer . (lambda (actions candidate) (if (eq system-type 'darwin) '(("Show with Man" . man)) actions))) (requires-pattern . 2))) ;; (anything 'anything-c-source-man-pages) ;;;; ;;; Complex command history (defvar anything-c-source-complex-command-history '((name . "Complex Command History") (candidates . (lambda () (mapcar 'prin1-to-string command-history))) (type . sexp))) ;; (anything 'anything-c-source-complex-command-history) ;;; M-x history (defvar anything-c-source-extended-command-history '((name . "Emacs Commands History") (candidates . extended-command-history) (type . command))) ;; (anything 'anything-c-source-extended-command-history) ;;; 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)))) (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'.") ;; (anything 'anything-c-source-emacs-commands) ;; Another replacement of `M-x' that act exactly like the ;; vanilla Emacs one, no problem of windows configuration, prefix args ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during ;; anything invocation. ;;;###autoload (defun anything-M-x () "Preconfigured `anything' for Emacs commands. It is `anything' replacement of regular `M-x' `execute-extended-command'." (interactive) (let ((command (anything-comp-read "M-x " obarray :test 'commandp :must-match t :requires-pattern 2 :name "Emacs Commands" :persistent-action #'(lambda (candidate) (describe-function (intern candidate))) :persistent-help "Describe this command" :history extended-command-history)) (history (loop with hist for i in extended-command-history for com = (intern i) when (and (fboundp com) (not (member i hist))) collect i into hist finally return hist))) (unless current-prefix-arg (setq current-prefix-arg anything-current-prefix-arg)) (call-interactively (intern command)) (setq extended-command-history (cons command (delete command history))))) ;;; LaCarte (defvar anything-c-source-lacarte '((name . "Lacarte") (init . (lambda () (require 'lacarte ))) (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist)))) (candidate-number-limit . 9999) (action . anything-c-call-interactively)) "Needs lacarte.el. http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el") ;; (anything 'anything-c-source-lacarte) ;;;; ;;; Emacs functions (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)))) (type . function) (requires-pattern . 2)) "Source for completing Emacs functions.") ;; (anything 'anything-c-source-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 "The regexp for `anything-c-source-emacs-functions-with-abbrevs'. 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)))))))) ;; (anything 'anything-c-source-emacs-functions-with-abbrevs) (defvar anything-c-source-advice '((name . "Function Advice") (candidates . anything-c-advice-candidates) (action ("Toggle Enable/Disable" . anything-c-advice-toggle)) ;; (real-to-display . anything-c-advice-real-to-display) (persistent-action . anything-c-advice-persistent-action) (persistent-help . "Describe function / C-u C-z: Toggle advice"))) ;; (anything 'anything-c-source-advice) ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice)) ;; (testadvice) (defun anything-c-advice-candidates () (require 'advice) (loop for (fname) in ad-advised-functions for function = (intern fname) append (loop for class in ad-advice-classes append (loop for advice in (ad-get-advice-info-field function class) for enabled = (ad-advice-enabled advice) collect (cons (format "%s %s %s" (if enabled "Enabled " "Disabled") (propertize fname 'face 'font-lock-function-name-face) (ad-make-single-advice-docstring advice class nil)) (list function class advice)))))) (defun anything-c-advice-persistent-action (func-class-advice) (if current-prefix-arg (anything-c-advice-toggle func-class-advice) (describe-function (car func-class-advice)))) (defun anything-c-advice-toggle (func-class-advice) (destructuring-bind (function class advice) func-class-advice (cond ((ad-advice-enabled advice) (ad-advice-set-enabled advice nil) (message "Disabled")) (t ;disabled (ad-advice-set-enabled advice t) (message "Enabled"))) (ad-activate function) (and anything-in-persistent-action (anything-c-advice-update-current-display-string)))) (defun anything-c-advice-update-current-display-string () (anything-edit-current-selection (let ((newword (cond ((looking-at "Disabled") "Enabled") ((looking-at "Enabled") "Disabled"))) realvalue) (when newword (delete-region (point) (progn (forward-word 1) (point))) (insert newword))))) ;;;###autoload (defun anything-manage-advice () "Preconfigured `anything' to disable/enable function advices." (interactive) (anything-other-buffer 'anything-c-source-advice "*anything advice*")) ;;;; ;;; Emacs variables (defvar anything-c-source-emacs-variables '((name . "Emacs Variables") (candidates . (lambda () (sort (all-completions "" obarray 'boundp) 'string-lessp))) (type . variable) (requires-pattern . 2)) "Source for completing Emacs variables.") ;; (anything 'anything-c-source-emacs-variables) ;;;; ;;; Bookmarks (eval-when-compile (require 'bookmark)) (defvar anything-c-source-bookmarks '((name . "Bookmarks") (init . (lambda () (require 'bookmark))) (candidates . bookmark-all-names) (type . bookmark)) "See (info \"(emacs)Bookmarks\").") ;; (anything 'anything-c-source-bookmarks) ;;; bookmark-set (defvar anything-c-source-bookmark-set '((name . "Set Bookmark") (dummy) (action . bookmark-set)) "See (info \"(emacs)Bookmarks\").") ;; (anything 'anything-c-source-bookmark-set) ;;; Visible Bookmarks ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el") ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327 (defvar anything-c-source-bm '((name . "Visible Bookmarks") (init . anything-c-bm-init) (candidates-in-buffer) (type . line)) "Needs bm.el. http://www.nongnu.org/bm/") (defun anything-c-bm-init () "Init function for `anything-c-source-bm'." (when (require 'bm nil t) (with-no-warnings (let ((bookmarks (bm-lists)) (buf (anything-candidate-buffer 'global))) (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks)) '< :key 'overlay-start)) (let ((start (overlay-start bm)) (end (overlay-end bm)) (annotation (or (overlay-get bm 'annotation) ""))) (unless (< (- end start) 1) ; org => (if (< (- end start) 2) (let ((str (format "%5d: [%s]: %s\n" (line-number-at-pos start) annotation (buffer-substring start (1- end))))) (with-current-buffer buf (insert str)))))))))) ;;; Special bookmarks (defvar anything-c-source-bookmarks-ssh '((name . "Bookmarks-ssh") (init . (lambda () (require 'bookmark))) (candidates . (lambda () (anything-c-collect-bookmarks :ssh t))) (type . bookmark)) "See (info \"(emacs)Bookmarks\").") ;; (anything 'anything-c-source-bookmarks-ssh) (defvar anything-c-source-bookmarks-su '((name . "Bookmarks-root") (init . (lambda () (require 'bookmark))) (candidates . (lambda () (anything-c-collect-bookmarks :su t))) (filtered-candidate-transformer anything-c-highlight-bookmark-su) (type . bookmark)) "See (info \"(emacs)Bookmarks\").") ;; (anything 'anything-c-source-bookmarks-su) (defvar anything-c-source-bookmarks-local '((name . "Bookmarks-Local") (init . (lambda () (require 'bookmark))) (candidates . (lambda () (anything-c-collect-bookmarks :local t))) (filtered-candidate-transformer anything-c-adaptive-sort anything-c-highlight-bookmark) (type . bookmark)) "See (info \"(emacs)Bookmarks\").") ;; (anything 'anything-c-source-bookmarks-local) (defun* anything-c-collect-bookmarks (&key local su sudo ssh) (let* ((lis-all (bookmark-all-names)) (lis-loc (cond (local (loop for i in lis-all unless (string-match "^(ssh)\\|^(su)" i) collect i)) (su (loop for i in lis-all when (string-match "^(su)" i) collect i)) (sudo (loop for i in lis-all when (string-match "^(sudo)" i) collect i)) (ssh (loop for i in lis-all when (string-match "^(ssh)" i) collect i))))) (sort lis-loc 'string-lessp))) (defun anything-c-bookmark-root-logged-p () (catch 'break (dolist (i (mapcar #'buffer-name (buffer-list))) (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i) (throw 'break t))))) (defun anything-c-highlight-bookmark-su (files source) (if (anything-c-bookmark-root-logged-p) (anything-c-highlight-bookmark files source) (anything-c-highlight-not-logged files source))) (defun anything-c-highlight-not-logged (files source) (loop for i in files collect (propertize i 'face anything-c-bookmarks-face3))) (defun anything-c-highlight-bookmark (bookmarks source) "Used as `candidate-transformer' to colorize bookmarks. Work both with standard Emacs bookmarks and bookmark-extensions.el." (loop for i in bookmarks for isfile = (bookmark-get-filename i) for bufp = (and (fboundp 'bmkext-get-buffer-name) (bmkext-get-buffer-name i)) for handlerp = (and (fboundp 'bookmark-get-handler) (bookmark-get-handler i)) for isw3m = (and (fboundp 'bmkext-w3m-bookmark-p) (bmkext-w3m-bookmark-p i)) for isgnus = (and (fboundp 'bmkext-gnus-bookmark-p) (bmkext-gnus-bookmark-p i)) for isman = (and (fboundp 'bmkext-man-bookmark-p) ; Man (bmkext-man-bookmark-p i)) for iswoman = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman (bmkext-woman-bookmark-p i)) for handlerp = (bookmark-get-handler i) for isannotation = (bookmark-get-annotation i) for isabook = (string= (bookmark-prop-get i 'type) "addressbook") for isinfo = (eq handlerp 'Info-bookmark-jump) ;; Add a * if bookmark have annotation if (and isannotation (not (string-equal isannotation ""))) do (setq i (concat "*" i)) collect (cond (;; info buffers isinfo (propertize i 'face 'anything-bmkext-info 'help-echo isfile)) (;; w3m buffers isw3m (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile)) (;; gnus buffers isgnus (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile)) (;; Man Woman (or iswoman isman) (propertize i 'face 'anything-bmkext-man 'help-echo isfile)) (;; Addressbook isabook (propertize i 'face '((:foreground "Tomato")))) (;; directories (and isfile (file-directory-p isfile)) (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile)) (;; regular files t (propertize i 'face 'anything-bmkext-file 'help-echo isfile))))) ;;; Faces for bookmarks (defface anything-bmkext-info '((t (:foreground "green"))) "*Face used for W3m Emacs bookmarks (not w3m bookmarks)." :group 'anything) (defface anything-bmkext-w3m '((t (:foreground "yellow"))) "*Face used for W3m Emacs bookmarks (not w3m bookmarks)." :group 'anything) (defface anything-bmkext-gnus '((t (:foreground "magenta"))) "*Face used for Gnus bookmarks." :group 'anything) (defface anything-bmkext-man '((t (:foreground "Orange4"))) "*Face used for Woman/man bookmarks." :group 'anything) (defface anything-bmkext-no--file '((t (:foreground "grey"))) "*Face used for non--file bookmarks." :group 'anything) (defface anything-bmkext-file '((t (:foreground "Deepskyblue2"))) "*Face used for non--file bookmarks." :group 'anything) (defface anything-bookmarks-su-face '((t (:foreground "red"))) "Face for su/sudo bookmarks." :group 'anything) (defvar anything-c-bookmarks-face1 'anything-dir-heading) (defvar anything-c-bookmarks-face2 'anything-file-name) (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face) ;;; Sources to filter bookmark-extensions bookmarks. ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension ;; If you want to enable google-maps in addressbook you will need ;; Julien Danjou google-maps-el package available here: ;; http://julien.danjou.info/google-maps-el.html (defun anything-c-bmkext-filter-setup-alist (fn &rest args) "Return a filtered `bookmark-alist' sorted alphabetically." (loop with alist = (if args (apply #'(lambda (x) (funcall fn x)) args) (funcall fn)) for i in alist for b = (car i) collect b into sa finally return (sort sa 'string-lessp))) ;; Addressbook (defvar anything-c-source-bmkext-addressbook '((name . "Bookmark Addressbook") (init . (lambda () (require 'bookmark-extensions) (bookmark-maybe-load-default-file))) (candidates . anything-c-bmkext-addressbook-setup-alist) (persistent-action . (lambda (candidate) (let ((bmk (anything-bookmark-get-bookmark-from-name candidate))) (bookmark--jump-via bmk 'pop-to-buffer)))) (persistent-help . "Show contact - Prefix with C-u to append") (filtered-candidate-transformer anything-c-adaptive-sort anything-c-highlight-bookmark) (action . (("Show person's data" . (lambda (candidate) (let ((bmk (anything-bookmark-get-bookmark-from-name candidate)) (current-prefix-arg anything-current-prefix-arg)) (bookmark-jump bmk)))) ("Send Mail" . (lambda (candidate) (let ((bmk (anything-bookmark-get-bookmark-from-name candidate))) (if anything-current-prefix-arg (addressbook-set-mail-buffer1 bmk 'append) (addressbook-set-mail-buffer1 bmk))))) ("Edit Bookmark" . (lambda (candidate) (let ((bmk (anything-bookmark-get-bookmark-from-name candidate))) (addressbook-bookmark-edit (assoc bmk bookmark-alist))))) ("Insert Email at point" . (lambda (candidate) (let* ((bmk (anything-bookmark-get-bookmark-from-name candidate)) (mlist (split-string (assoc-default 'email (assoc bmk bookmark-alist)) ", "))) (insert (if (> (length mlist) 1) (anything-comp-read "Insert Mail Address: " mlist :must-match t) (car mlist)))))) ("Show annotation" . (lambda (candidate) (let ((bmk (anything-bookmark-get-bookmark-from-name candidate))) (bookmark-show-annotation bmk)))) ("Edit annotation" . (lambda (candidate) (let ((bmk (anything-bookmark-get-bookmark-from-name candidate))) (bookmark-edit-annotation bmk)))) ("Show Google map" . (lambda (candidate) (let* ((bmk (anything-bookmark-get-bookmark-from-name candidate)) (full-bmk (assoc bmk bookmark-alist))) (addressbook-google-map full-bmk)))))))) (defun anything-c-bmkext-addressbook-setup-alist () "Specialized filter function for bookmarks w3m." (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only)) ;; W3m (defvar anything-c-source-bookmark-w3m '((name . "Bookmark W3m") (init . (lambda () (require 'bookmark-extensions) (bookmark-maybe-load-default-file))) (candidates . anything-c-bookmark-w3m-setup-alist) (filtered-candidate-transformer anything-c-adaptive-sort anything-c-highlight-bookmark) (type . bookmark))) ;; (anything 'anything-c-source-bookmark-w3m) (defun anything-c-bookmark-w3m-setup-alist () "Specialized filter function for bookmarks w3m." (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only)) ;; Images (defvar anything-c-source-bookmark-images '((name . "Bookmark Images") (init . (lambda () (require 'bookmark-extensions) (bookmark-maybe-load-default-file))) (candidates . anything-c-bookmark-images-setup-alist) (filtered-candidate-transformer anything-c-adaptive-sort anything-c-highlight-bookmark) (type . bookmark))) ;; (anything 'anything-c-source-bookmark-images) (defun anything-c-bookmark-images-setup-alist () "Specialized filter function for images bookmarks." (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only)) ;; Woman Man (defvar anything-c-source-bookmark-man '((name . "Bookmark Woman&Man") (init . (lambda () (require 'bookmark-extensions) (bookmark-maybe-load-default-file))) (candidates . anything-c-bookmark-man-setup-alist) (filtered-candidate-transformer anything-c-adaptive-sort anything-c-highlight-bookmark) (type . bookmark))) ;; (anything 'anything-c-source-bookmark-man) (defun anything-c-bookmark-man-setup-alist () "Specialized filter function for bookmarks w3m." (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only) (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only))) ;; Gnus (defvar anything-c-source-bookmark-gnus '((name . "Bookmark Gnus") (init . (lambda () (require 'bookmark-extensions) (bookmark-maybe-load-default-file))) (candidates . anything-c-bookmark-gnus-setup-alist) (filtered-candidate-transformer anything-c-adaptive-sort anything-c-highlight-bookmark) (type . bookmark))) ;; (anything 'anything-c-source-bookmark-gnus) (defun anything-c-bookmark-gnus-setup-alist () "Specialized filter function for bookmarks gnus." (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only)) ;; Info (defvar anything-c-source-bookmark-info '((name . "Bookmark Info") (init . (lambda () (require 'bookmark-extensions) (bookmark-maybe-load-default-file))) (candidates . anything-c-bookmark-info-setup-alist) (filtered-candidate-transformer anything-c-adaptive-sort anything-c-highlight-bookmark) (type . bookmark))) ;; (anything 'anything-c-source-bookmark-info) (defun anything-c-bookmark-info-setup-alist () "Specialized filter function for bookmarks info." (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only)) ;; Local Files&directories (defvar anything-c-source-bookmark-files&dirs '((name . "Bookmark Files&Directories") (init . (lambda () (require 'bookmark-extensions) (bookmark-maybe-load-default-file))) (candidates . anything-c-bookmark-local-files-setup-alist) (filtered-candidate-transformer anything-c-adaptive-sort anything-c-highlight-bookmark) (type . bookmark))) ;; (anything 'anything-c-source-bookmark-files&dirs) (defun anything-c-bookmark-local-files-setup-alist () "Specialized filter function for bookmarks locals files." (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only)) ;; Su Files&directories (defvar anything-c-source-bookmark-su-files&dirs '((name . "Bookmark Root-Files&Directories") (init . (lambda () (require 'bookmark-extensions) (bookmark-maybe-load-default-file))) (candidates . anything-c-bookmark-su-files-setup-alist) (filtered-candidate-transformer anything-c-adaptive-sort anything-c-highlight-bookmark-su) (type . bookmark))) ;; (anything 'anything-c-source-bookmark-su-files&dirs) (defun anything-c-bookmark-su-files-setup-alist () "Specialized filter function for bookmarks su/sudo files." (loop with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only) for i in l for isfile = (bookmark-get-filename i) for istramp = (and isfile (boundp 'tramp-file-name-regexp) (save-match-data (string-match tramp-file-name-regexp isfile))) for issu = (and istramp (string-match bmkext-su-or-sudo-regexp isfile)) if issu collect i)) ;; Ssh Files&directories (defvar anything-c-source-bookmark-ssh-files&dirs '((name . "Bookmark Ssh-Files&Directories") (init . (lambda () (require 'bookmark-extensions) (bookmark-maybe-load-default-file))) (candidates . anything-c-bookmark-ssh-files-setup-alist) (filtered-candidate-transformer . anything-c-adaptive-sort) (type . bookmark))) ;; (anything 'anything-c-source-bookmark-ssh-files&dirs) (defun anything-c-bookmark-ssh-files-setup-alist () "Specialized filter function for bookmarks ssh files." (loop with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only) for i in l for isfile = (bookmark-get-filename i) for istramp = (and isfile (boundp 'tramp-file-name-regexp) (save-match-data (string-match tramp-file-name-regexp isfile))) for isssh = (and istramp (string-match "/ssh:" isfile)) if isssh collect i)) ;; All bookmark-extensions sources. ;;;###autoload (defun anything-bookmark-ext () "Preconfigured `anything' for bookmark-extensions sources. Needs bookmark-ext.el http://mercurial.intuxication.org/hg/emacs-bookmark-extension" (interactive) (anything :sources '(anything-c-source-bookmark-files&dirs anything-c-source-bookmark-w3m anything-c-source-bmkext-addressbook anything-c-source-bookmark-gnus anything-c-source-bookmark-info anything-c-source-bookmark-man anything-c-source-bookmark-images anything-c-source-bookmark-su-files&dirs anything-c-source-bookmark-ssh-files&dirs) :prompt "SearchBookmark: " :buffer "*anything bmkext*")) ;; Firefox bookmarks ;; You will have to set firefox to import bookmarks in his html file bookmarks.html. ;; (only for firefox versions >=3) ;; To achieve that, open about:config in firefox and double click on this line to enable value ;; to true: ;; user_pref("browser.bookmarks.autoExportHTML", false); ;; You should have now: ;; user_pref("browser.bookmarks.autoExportHTML", true); (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*") (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^]\\)") (defun anything-get-firefox-user-init-dir () "Guess the default Firefox user directory name." (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/")) (moz-user-dir (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini")) (goto-char (point-min)) (prog1 (when (search-forward "Path=" nil t) (buffer-substring-no-properties (point) (point-at-eol))) (kill-buffer))))) (file-name-as-directory (concat moz-dir moz-user-dir)))) (defun anything-guess-firefox-bookmark-file () "Return the path of the Firefox bookmarks file." (concat (anything-get-firefox-user-init-dir) "bookmarks.html")) (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp) "Parse html bookmark FILE and return an alist with (title . url) as elements." (let (bookmarks-alist url title) (with-temp-buffer (insert-file-contents file) (goto-char (point-min)) (while (re-search-forward "href=\\|^ *
\\([^><]+.[^]\\)") (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*") (defvar anything-c-w3m-bookmarks-alist nil) (defvar anything-c-source-w3m-bookmarks '((name . "W3m Bookmarks") (init . (lambda () (setq anything-c-w3m-bookmarks-alist (anything-html-bookmarks-to-alist w3m-bookmark-file anything-w3m-bookmark-url-regexp anything-w3m-bookmarks-regexp)))) (candidates . (lambda () (mapcar #'car anything-c-w3m-bookmarks-alist))) (filtered-candidate-transformer anything-c-adaptive-sort anything-c-highlight-w3m-bookmarks) (action . (("Browse Url" . (lambda (candidate) (anything-c-w3m-browse-bookmark candidate))) ("Copy Url" . (lambda (elm) (kill-new (anything-c-w3m-bookmarks-get-value elm)))) ("Browse Url Firefox" . (lambda (candidate) (anything-c-w3m-browse-bookmark candidate t))) ("Delete Bookmark" . (lambda (candidate) (anything-c-w3m-delete-bookmark candidate))) ("Rename Bookmark" . (lambda (candidate) (anything-c-w3m-rename-bookmark candidate))))) (persistent-action . (lambda (candidate) (if current-prefix-arg (anything-c-w3m-browse-bookmark candidate t) (anything-c-w3m-browse-bookmark candidate nil t)))) (persistent-help . "Open URL with emacs-w3m in new tab / \ C-u \\[anything-execute-persistent-action]: Open URL with Firefox")) "Needs w3m and emacs-w3m. http://w3m.sourceforge.net/ http://emacs-w3m.namazu.org/") ;; (anything 'anything-c-source-w3m-bookmarks) (defun anything-c-w3m-bookmarks-get-value (elm) (replace-regexp-in-string "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist)))) (defun anything-c-w3m-browse-bookmark (elm &optional use-firefox new-tab) (let* ((fn (if use-firefox 'browse-url-firefox 'w3m-browse-url)) (arg (and (eq fn 'w3m-browse-url) new-tab))) (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg))) (defun anything-c-highlight-w3m-bookmarks (bookmarks source) (loop for i in bookmarks collect (propertize i 'face 'anything-w3m-bookmarks-face 'help-echo (anything-c-w3m-bookmarks-get-value i)))) (defun anything-c-w3m-delete-bookmark (elm) (save-excursion (find-file-literally w3m-bookmark-file) (goto-char (point-min)) (when (re-search-forward elm nil t) (beginning-of-line) (delete-region (point) (line-end-position)) (delete-blank-lines)) (save-buffer (current-buffer)) (kill-buffer (current-buffer)))) (defun anything-c-w3m-rename-bookmark (elm) (let* ((old-title (replace-regexp-in-string ">" "" elm)) (new-title (read-string "NewTitle: " old-title))) (save-excursion (find-file-literally w3m-bookmark-file) (goto-char (point-min)) (when (re-search-forward (concat elm "<") nil t) (goto-char (1- (point))) (delete-char (- (length old-title))) (insert new-title)) (save-buffer (current-buffer)) (kill-buffer (current-buffer))))) ;;;; ;;; Elisp library scan (defvar anything-c-source-elisp-library-scan '((name . "Elisp libraries (Scan)") (init . (anything-c-elisp-library-scan-init)) (candidates-in-buffer) (action ("Find library" . (lambda (candidate) (find-file (find-library-name candidate)))) ("Find library other window" . (lambda (candidate) (find-file-other-window (find-library-name candidate)))) ("Load library" . (lambda (candidate) (load-library candidate)))))) ;; (anything 'anything-c-source-elisp-library-scan) (defun anything-c-elisp-library-scan-init () "Init anything buffer status." (let ((anything-buffer (anything-candidate-buffer 'global)) (library-list (anything-c-elisp-library-scan-list))) (with-current-buffer anything-buffer (dolist (library library-list) (insert (format "%s\n" library)))))) (defun anything-c-elisp-library-scan-list (&optional dirs string) "Do completion for file names passed to `locate-file'. DIRS is directory to search path. STRING is string to match." ;; Use `load-path' as path when ignore `dirs'. (or dirs (setq dirs load-path)) ;; Init with blank when ignore `string'. (or string (setq string "")) ;; Get library list. (let ((string-dir (file-name-directory string)) ;; File regexp that suffix match `load-file-rep-suffixes'. (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes))) name names) (dolist (dir dirs) (unless dir (setq dir default-directory)) (if string-dir (setq dir (expand-file-name string-dir dir))) (when (file-directory-p dir) (dolist (file (file-name-all-completions (file-name-nondirectory string) dir)) ;; Suffixes match `load-file-rep-suffixes'. (setq name (if string-dir (concat string-dir file) file)) (if (string-match match-regexp name) (add-to-list 'names name))))) names)) ;;;; ;;; Imenu (defvar anything-c-imenu-delimiter " / ") (defvar anything-c-imenu-index-filter nil) (make-variable-buffer-local 'anything-c-imenu-index-filter) (defvar anything-c-cached-imenu-alist nil) (make-variable-buffer-local 'anything-c-cached-imenu-alist) (defvar anything-c-cached-imenu-candidates nil) (make-variable-buffer-local 'anything-c-cached-imenu-candidates) (defvar anything-c-cached-imenu-tick nil) (make-variable-buffer-local 'anything-c-cached-imenu-tick) (eval-when-compile (require 'imenu)) (setq imenu-auto-rescan t) (defun anything-imenu-create-candidates (entry) "Create candidates with ENTRY." (if (listp (cdr entry)) (mapcan (lambda (sub) (if (consp (cdr sub)) (mapcar (lambda (subentry) (concat (car entry) anything-c-imenu-delimiter subentry)) (anything-imenu-create-candidates sub)) (list (concat (car entry) anything-c-imenu-delimiter (car sub))))) (cdr entry)) (list entry))) (defvar anything-c-source-imenu '((name . "Imenu") (init . (lambda () (require 'imenu))) (candidates . anything-c-imenu-candidates) (persistent-action . (lambda (elm) (anything-c-imenu-default-action elm) (unless (fboundp 'semantic-imenu-tag-overlay) (anything-match-line-color-current-line)))) (persistent-help . "Show this entry") (action . anything-c-imenu-default-action)) "See (info \"(emacs)Imenu\")") ;; (anything 'anything-c-source-imenu) (defun anything-c-imenu-candidates () (with-current-buffer anything-current-buffer (let ((tick (buffer-modified-tick))) (if (eq anything-c-cached-imenu-tick tick) anything-c-cached-imenu-candidates (setq imenu--index-alist nil) (setq anything-c-cached-imenu-tick tick anything-c-cached-imenu-candidates (ignore-errors (mapcan 'anything-imenu-create-candidates (setq anything-c-cached-imenu-alist (let ((index (imenu--make-index-alist))) (if anything-c-imenu-index-filter (funcall anything-c-imenu-index-filter index) index)))))) (setq anything-c-cached-imenu-candidates (mapcar #'(lambda (x) (if (stringp x) x (car x))) anything-c-cached-imenu-candidates)))))) (setq imenu-default-goto-function 'imenu-default-goto-function) (defun anything-c-imenu-default-action (elm) "The default action for `anything-c-source-imenu'." (let ((path (split-string elm anything-c-imenu-delimiter)) (alist anything-c-cached-imenu-alist)) (if (> (length path) 1) (progn (setq alist (assoc (car path) alist)) (setq elm (cadr path)) (imenu (assoc elm alist))) (imenu (assoc elm alist))))) ;;; Ctags (defvar anything-c-ctags-modes '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode scheme-mode sh-mode slang-mode sql-mode tcl-mode )) (defun anything-c-source-ctags-init () (when (and buffer-file-name (memq major-mode anything-c-ctags-modes) (anything-current-buffer-is-modified)) (with-current-buffer (anything-candidate-buffer 'local) (call-process-shell-command (if (string-match "\\.el\\.gz$" anything-buffer-file-name) (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) " anything-buffer-file-name) (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name)) nil (current-buffer)) (goto-char (point-min)) (forward-line 2) (delete-region (point-min) (point)) (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t)) for lineno-start = (point) for lineno = (buffer-substring lineno-start (1- (search-forward "," (point-at-eol) t))) do (beginning-of-line) (insert (format "%5s:" lineno)) (search-forward "\177" (point-at-eol) t) (delete-region (1- (point)) (point-at-eol)) (forward-line 1))))) (defvar anything-c-source-ctags '((name . "Exuberant ctags") (init . anything-c-source-ctags-init) (candidates-in-buffer) (adjust) (type . line)) "Needs Exuberant Ctags. http://ctags.sourceforge.net/") ;; (anything 'anything-c-source-ctags) ;; Semantic (eval-when-compile (require 'semantic nil t)) (declare-function semantic-format-tag-summarize "ext:format.el" (tag &optional parent color) t) (declare-function semantic-tag-components "ext:tag.el" (tag) t) (declare-function semantic-go-to-tag "ext:tag-file.el" (tag) t) (defvar anything-semantic-candidates nil) (defun anything-semantic-construct-candidates (tags depth) (when (require 'semantic nil t) (apply 'append (mapcar (lambda (tag) (if (listp tag) (let ((type (semantic-tag-type tag)) (class (semantic-tag-class tag))) (if (or (and (stringp type) (or (string= type "class") (string= type "namespace"))) (eq class 'function) (eq class 'variable)) (cons (cons (concat (make-string (* depth 2) ?\s) (semantic-format-tag-summarize tag nil t)) tag) (anything-semantic-construct-candidates (semantic-tag-components tag) (1+ depth))))))) tags)))) (defun anything-semantic-default-action (candidate) (let ((tag (cdr (assoc candidate anything-semantic-candidates)))) (semantic-go-to-tag tag))) (defvar anything-c-source-semantic '((name . "Semantic Tags") (init . (lambda () (setq anything-semantic-candidates (ignore-errors (anything-semantic-construct-candidates (semantic-fetch-tags) 0))))) (candidates . (lambda () (if anything-semantic-candidates (mapcar 'car anything-semantic-candidates)))) (persistent-action . (lambda (elm) (anything-semantic-default-action elm) (anything-match-line-color-current-line))) (persistent-help . "Show this entry") (action . anything-semantic-default-action) "Needs semantic in CEDET. http://cedet.sourceforge.net/semantic.shtml http://cedet.sourceforge.net/")) ;; (anything 'anything-c-source-semantic) ;;; Function is called by ;;;###autoload (defun anything-simple-call-tree () "Preconfigured `anything' for simple-call-tree. List function relationships. Needs simple-call-tree.el. http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el" (interactive) (anything-other-buffer '(anything-c-source-simple-call-tree-functions-callers anything-c-source-simple-call-tree-callers-functions) "*anything simple-call-tree*")) (defvar anything-c-source-simple-call-tree-functions-callers '((name . "Function is called by") (init . anything-c-simple-call-tree-functions-callers-init) (multiline) (candidates . anything-c-simple-call-tree-candidates) (persistent-action . anything-c-simple-call-tree-persistent-action) (persistent-help . "Show function definitions by rotation") (action ("Find definition selected by persistent-action" . anything-c-simple-call-tree-find-definition))) "Needs simple-call-tree.el. http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el") (defvar anything-c-simple-call-tree-tick nil) (make-variable-buffer-local 'anything-c-simple-call-tree-tick) (defun anything-c-simple-call-tree-analyze-maybe () (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick) (simple-call-tree-analyze) (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick)))) (defun anything-c-simple-call-tree-init-base (function message) (require 'simple-call-tree) (with-no-warnings (when (anything-current-buffer-is-modified) (anything-c-simple-call-tree-analyze-maybe) (let ((list (funcall function simple-call-tree-alist))) (with-current-buffer (anything-candidate-buffer 'local) (dolist (entry list) (let ((funcs (concat " " (mapconcat #'identity (cdr entry) "\n ")))) (insert (car entry) message (if (string= funcs " ") " no functions." funcs) "\n\n")))))))) (defun anything-c-simple-call-tree-functions-callers-init () (anything-c-simple-call-tree-init-base 'simple-call-tree-invert " is called by\n")) (defun anything-c-simple-call-tree-candidates () (with-current-buffer (anything-candidate-buffer) (split-string (buffer-string) "\n\n"))) (defvar anything-c-simple-call-tree-related-functions nil) (defvar anything-c-simple-call-tree-function-index 0) (defun anything-c-simple-call-tree-persistent-action (candidate) (unless (eq last-command 'anything-execute-persistent-action) (setq anything-c-simple-call-tree-related-functions (delete "no functions." (split-string (replace-regexp-in-string " \\| is called by\\| calls " "" candidate) "\n"))) (setq anything-c-simple-call-tree-function-index -1)) (incf anything-c-simple-call-tree-function-index) (anything-c-simple-call-tree-find-definition candidate)) (defun anything-c-simple-call-tree-find-definition (candidate) (find-function (intern (nth (mod anything-c-simple-call-tree-function-index (length anything-c-simple-call-tree-related-functions)) anything-c-simple-call-tree-related-functions)))) ;; (anything 'anything-c-source-simple-call-tree-functions-callers) ;;; Function calls (defvar anything-c-source-simple-call-tree-callers-functions '((name . "Function calls") (init . anything-c-simple-call-tree-callers-functions-init) (multiline) (candidates . anything-c-simple-call-tree-candidates) (persistent-action . anything-c-simple-call-tree-persistent-action) (persistent-help . "Show function definitions by rotation") (action ("Find definition selected by persistent-action" . anything-c-simple-call-tree-find-definition))) "Needs simple-call-tree.el. http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el") (defun anything-c-simple-call-tree-callers-functions-init () (anything-c-simple-call-tree-init-base 'identity " calls \n")) ;; (anything 'anything-c-source-simple-call-tree-callers-functions) ;;; Commands/Options with doc (defvar anything-c-auto-document-data nil) (make-variable-buffer-local 'anything-c-auto-document-data) (defvar anything-c-source-commands-and-options-in-file '((name . "Commands/Options in file") (header-name . (lambda (x) (format "Commands/Options in %s" (buffer-local-value 'buffer-file-name anything-current-buffer)))) (candidates . anything-command-and-options-candidates) (multiline) (action . imenu)) "List Commands and Options with doc. It needs auto-document.el . http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el") (eval-when-compile (require 'auto-document nil t)) (defun anything-command-and-options-candidates () (with-current-buffer anything-current-buffer (when (and (require 'auto-document nil t) (eq major-mode 'emacs-lisp-mode) (or (anything-current-buffer-is-modified) (not anything-c-auto-document-data))) (or imenu--index-alist (imenu--make-index-alist t)) (setq anything-c-auto-document-data (destructuring-bind (commands options) (adoc-construct anything-current-buffer) (append (loop for (command . doc) in commands for cmdname = (symbol-name command) collect (cons (format "Command: %s\n %s" (propertize cmdname 'face font-lock-function-name-face) (adoc-first-line doc)) (assoc cmdname imenu--index-alist))) (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist)) for (option doc default) in options for optname = (symbol-name option) collect (cons (format "Option: %s\n %s\n default = %s" (propertize optname 'face font-lock-variable-name-face) (adoc-first-line doc) (adoc-prin1-to-string default)) (assoc optname var-alist))))))) anything-c-auto-document-data)) ;; (anything 'anything-c-source-commands-and-options-in-file) ;;;; ;;; Customize Face (defvar anything-c-source-customize-face '((name . "Customize Face") (init . (lambda () (unless (anything-candidate-buffer) (save-window-excursion (list-faces-display)) (anything-candidate-buffer (get-buffer "*Faces*"))))) (candidates-in-buffer) (get-line . buffer-substring) (action . (lambda (line) (customize-face (intern (car (split-string line)))))) (requires-pattern . 3)) "See (info \"(emacs)Faces\")") ;; (anything 'anything-c-source-customize-face) ;; Color (defvar anything-c-source-colors '((name . "Colors") (init . (lambda () (unless (anything-candidate-buffer) (save-window-excursion (list-colors-display)) (anything-candidate-buffer (get-buffer "*Colors*"))))) (candidates-in-buffer) (get-line . buffer-substring) (action ("Copy Name" . (lambda (candidate) (kill-new (anything-c-colors-get-name candidate)))) ("Copy RGB" . (lambda (candidate) (kill-new (anything-c-colors-get-rgb candidate)))) ("Insert Name" . (lambda (candidate) (with-current-buffer anything-current-buffer (insert (anything-c-colors-get-name candidate))))) ("Insert RGB" . (lambda (candidate) (with-current-buffer anything-current-buffer (insert (anything-c-colors-get-rgb candidate)))))))) ;; (anything 'anything-c-source-colors) (defun anything-c-colors-get-name (candidate) "Get color name." (replace-regexp-in-string " " "" (with-temp-buffer (insert (capitalize candidate)) (goto-char (point-min)) (search-forward-regexp "\\s-\\{2,\\}") (delete-region (point) (point-max)) (buffer-string)))) (defun anything-c-colors-get-rgb (candidate) "Get color RGB." (replace-regexp-in-string " " "" (with-temp-buffer (insert (capitalize candidate)) (goto-char (point-max)) (search-backward-regexp "\\s-\\{2,\\}") (delete-region (point) (point-min)) (buffer-string)))) ;;;; ;;; 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.") ;; (anything 'anything-c-source-tracker-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.") ;; (anything 'anything-c-source-mac-spotlight) ;;;; ;;; Kill ring (defvar anything-c-source-kill-ring '((name . "Kill Ring") (init . (lambda () (anything-attrset 'last-command last-command))) (candidates . anything-c-kill-ring-candidates) (action . anything-c-kill-ring-action) (last-command) (migemo) (multiline)) "Source for browse and insert contents of kill-ring.") (defun anything-c-kill-ring-candidates () (loop for kill in kill-ring unless (or (< (length kill) anything-kill-ring-threshold) (string-match "^[\\s\\t]+$" kill)) collect kill)) (defun anything-c-kill-ring-action (str) "Insert STR in `kill-ring' and set STR to the head. If this action is executed just after `yank', replace with STR as yanked string." (setq kill-ring (delete str kill-ring)) (if (not (eq (anything-attr 'last-command) 'yank)) (insert-for-yank str) ;; from `yank-pop' (let ((inhibit-read-only t) (before (< (point) (mark t)))) (if before (funcall (or yank-undo-function 'delete-region) (point) (mark t)) (funcall (or yank-undo-function 'delete-region) (mark t) (point))) (setq yank-undo-function nil) (set-marker (mark-marker) (point) (current-buffer)) (insert-for-yank str) ;; Set the window start back where it was in the yank command, ;; if possible. (set-window-start (selected-window) yank-window-start t) (if before ;; This is like exchange-point-and-mark, but doesn't activate the mark. ;; It is cleaner to avoid activation, even though the command ;; loop would deactivate the mark because we inserted text. (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer))))))) (kill-new str)) ;; (anything 'anything-c-source-kill-ring) ;;;; ;; DO NOT include these sources in `anything-sources' use ;; the commands `anything-mark-ring', `anything-global-mark-ring' or ;; `anything-all-mark-rings' instead. (defun anything-c-source-mark-ring-candidates () (flet ((get-marks (pos) (save-excursion (goto-char pos) (beginning-of-line) (let ((line (car (split-string (thing-at-point 'line) "[\n\r]")))) (when (string= "" line) (setq line "")) (format "%7d: %s" (line-number-at-pos) line))))) (with-current-buffer anything-current-buffer (loop with marks = (cons (mark-marker) mark-ring) with recip = nil for i in marks for m = (get-marks i) unless (member m recip) collect m into recip finally return recip)))) (defvar anything-mark-ring-cache nil) (defvar anything-c-source-mark-ring '((name . "mark-ring") (init . (lambda () (setq anything-mark-ring-cache (ignore-errors (anything-c-source-mark-ring-candidates))))) (candidates . (lambda () (anything-aif anything-mark-ring-cache it))) (action . (("Goto line" . (lambda (candidate) (anything-goto-line (string-to-number candidate)))))) (persistent-action . (lambda (candidate) (anything-goto-line (string-to-number candidate)) (anything-match-line-color-current-line))) (persistent-help . "Show this line"))) ;; (anything 'anything-c-source-mark-ring) ;;;###autoload (defun anything-mark-ring () "Preconfigured `anything' for `anything-c-source-mark-ring'." (interactive) (anything 'anything-c-source-mark-ring)) ;;; Global-mark-ring (defvar anything-c-source-global-mark-ring '((name . "global-mark-ring") (candidates . anything-c-source-global-mark-ring-candidates) (action . (("Goto line" . (lambda (candidate) (let ((items (split-string candidate ":"))) (switch-to-buffer (second items)) (anything-goto-line (string-to-number (car items)))))))) (persistent-action . (lambda (candidate) (let ((items (split-string candidate ":"))) (switch-to-buffer (second items)) (anything-goto-line (string-to-number (car items))) (anything-match-line-color-current-line)))) (persistent-help . "Show this line"))) (defun anything-c-source-global-mark-ring-candidates () (flet ((buf-fn (m) (with-current-buffer (marker-buffer m) (goto-char m) (beginning-of-line) (let (line) (if (string= "" line) (setq line "") (setq line (car (split-string (thing-at-point 'line) "[\n\r]")))) (format "%7d:%s: %s" (line-number-at-pos) (marker-buffer m) line))))) (loop with marks = global-mark-ring with recip = nil for i in marks for gm = (unless (or (string-match "^ " (format "%s" (marker-buffer i))) (null (marker-buffer i))) (buf-fn i)) when (and gm (not (member gm recip))) collect gm into recip finally return recip))) ;; (anything 'anything-c-source-global-mark-ring) ;;;###autoload (defun anything-global-mark-ring () "Preconfigured `anything' for `anything-c-source-global-mark-ring'." (interactive) (anything 'anything-c-source-global-mark-ring)) ;;;###autoload (defun anything-all-mark-rings () "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \ `anything-c-source-mark-ring'." (interactive) (anything '(anything-c-source-global-mark-ring anything-c-source-mark-ring))) ;;;; ;;; Insert from register (defvar anything-c-source-register '((name . "Registers") (candidates . anything-c-register-candidates) (action-transformer . anything-c-register-action-transformer) (multiline) (action)) "See (info \"(emacs)Registers\")") (defun anything-c-register-candidates () "Collecting register contents and appropriate commands." (loop for (char . val) in register-alist for key = (single-key-description char) for string-actions = (cond ((numberp val) (list (int-to-string val) 'insert-register 'increment-register)) ((markerp val) (let ((buf (marker-buffer val))) (if (null buf) (list "a marker in no buffer") (list (concat "a buffer position:" (buffer-name buf) ", position " (int-to-string (marker-position val))) 'jump-to-register 'insert-register)))) ((and (consp val) (window-configuration-p (car val))) (list "window configuration." 'jump-to-register)) ((and (consp val) (frame-configuration-p (car val))) (list "frame configuration." 'jump-to-register)) ((and (consp val) (eq (car val) 'file)) (list (concat "file:" (prin1-to-string (cdr val)) ".") 'jump-to-register)) ((and (consp val) (eq (car val) 'file-query)) (list (concat "file:a file-query reference: file " (car (cdr val)) ", position " (int-to-string (car (cdr (cdr val)))) ".") 'jump-to-register)) ((consp val) (let ((lines (format "%4d" (length val)))) (list (format "%s: %s\n" lines (truncate-string-to-width (mapconcat 'identity (list (car val)) ;; (mapconcat (lambda (y) y) val "^J") (- (window-width) 15))) 'insert-register))) ((stringp val) (list ;; without properties (substring-no-properties val) 'insert-register 'append-to-register 'prepend-to-register)) (t "GARBAGE!")) collect (cons (format "register %3s: %s" key (car string-actions)) (cons char (cdr string-actions))))) (defun anything-c-register-action-transformer (actions register-and-functions) "Decide actions by the contents of register." (loop with func-actions = '((insert-register "Insert Register" . (lambda (c) (insert-register (car c)))) (jump-to-register "Jump to Register" . (lambda (c) (jump-to-register (car c)))) (append-to-register "Append Region to Register" . (lambda (c) (append-to-register (car c) (region-beginning) (region-end)))) (prepend-to-register "Prepend Region to Register" . (lambda (c) (prepend-to-register (car c) (region-beginning) (region-end)))) (increment-register "Increment Prefix Arg to Register" . (lambda (c) (increment-register anything-current-prefix-arg (car c))))) for func in (cdr register-and-functions) for cell = (assq func func-actions) when cell collect (cdr cell))) ;; (anything 'anything-c-source-register) ;;;; (defvar anything-c-source-fixme '((name . "TODO/FIXME/DRY comments") (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$") (adjust) (recenter)) "Show TODO/FIXME/DRY comments in current file.") ;; (anything 'anything-c-source-fixme) (defvar anything-c-source-rd-headline '((name . "RD HeadLine") (headline "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$") (condition . (memq major-mode '(rdgrep-mode rd-mode))) (migemo) (subexp . 1)) "Show RD headlines. RD is Ruby's POD. http://en.wikipedia.org/wiki/Ruby_Document_format") ;; (anything 'anything-c-source-rd-headline) (defvar anything-c-source-oddmuse-headline '((name . "Oddmuse HeadLine") (headline "^= \\(.+\\) =$" "^== \\(.+\\) ==$" "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$") (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode))) (migemo) (subexp . 1)) "Show Oddmuse headlines, such as EmacsWiki.") ;; (anything 'anything-c-source-oddmuse-headline) (defvar anything-c-source-emacs-source-defun '((name . "Emacs Source DEFUN") (headline . "DEFUN\\|DEFVAR") (condition . (string-match "/emacs2[0-9].+/src/.+c$" (or buffer-file-name "")))) "Show DEFUN/DEFVAR in Emacs C source file.") ;; (anything 'anything-c-source-emacs-source-defun) (defvar anything-c-source-emacs-lisp-expectations '((name . "Emacs Lisp Expectations") (headline . "(desc[ ]\\|(expectations") (condition . (eq major-mode 'emacs-lisp-mode))) "Show descriptions (desc) in Emacs Lisp Expectations. http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el") ;; (anything 'anything-c-source-emacs-lisp-expectations) (defvar anything-c-source-emacs-lisp-toplevels '((name . "Emacs Lisp Toplevel / Level 4 Comment / Linkd Star") (headline . "^(\\|(@\\*\\|^;;;;") (get-line . buffer-substring) (condition . (eq major-mode 'emacs-lisp-mode)) (adjust)) "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp. linkd.el is optional because linkd stars are extracted by regexp. http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el") ;; (anything 'anything-c-source-emacs-lisp-toplevels) (defvar anything-c-source-org-headline '((name . "Org HeadLine") (headline "^\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$" "^\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$" "^\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$" "^\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$" "^\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$" "^\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$" "^\\*\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$" "^\\*\\*\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$") (condition . (eq major-mode 'org-mode)) (migemo) (subexp . 1) (persistent-action . (lambda (elm) (anything-c-action-line-goto elm) (org-cycle))) (action-transformer . (lambda (actions candidate) '(("Go to Line" . anything-c-action-line-goto) ("Insert Link to This Headline" . anything-c-org-headline-insert-link-to-headline))))) "Show Org headlines. org-mode is very very much extended text-mode/outline-mode. See (find-library \"org.el\") See http://orgmode.org for the latest version.") (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content) (insert (save-excursion (anything-goto-line (car lineno-and-content)) (and (looking-at org-complex-heading-regexp) (org-make-link-string (concat "*" (match-string 4))))))) ;; (anything 'anything-c-source-org-headline) ;;; Anything yaoddmuse ;; Be sure to have yaoddmuse.el installed ;; install-elisp may be required if you want to install elisp file from here. (defvar anything-yaoddmuse-use-cache-file nil) (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el") (defvar anything-c-yaoddmuse-ew-cache nil) (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view '((name . "Yaoddmuse Edit or View (EmacsWiki)") (candidates . (lambda () (if anything-yaoddmuse-use-cache-file (ignore-errors (unless anything-c-yaoddmuse-ew-cache (load anything-c-yaoddmuse-cache-file) (setq anything-c-yaoddmuse-ew-cache (gethash "EmacsWiki" yaoddmuse-pages-hash))) anything-c-yaoddmuse-ew-cache) (yaoddmuse-update-pagename t) (gethash "EmacsWiki" yaoddmuse-pages-hash)))) (action . (("Edit page" . (lambda (candidate) (yaoddmuse-edit "EmacsWiki" candidate))) ("Browse page" . (lambda (candidate) (yaoddmuse-browse-page "EmacsWiki" candidate))) ("Browse page other window" . (lambda (candidate) (if (one-window-p) (split-window-vertically)) (yaoddmuse-browse-page "EmacsWiki" candidate))) ("Browse diff" . (lambda (candidate) (yaoddmuse-browse-page-diff "EmacsWiki" candidate))) ("Copy URL" . (lambda (candidate) (kill-new (yaoddmuse-url "EmacsWiki" candidate)) (message "Have copy page %s's URL to yank." candidate))) ("Create page" . (lambda (candidate) (yaoddmuse-edit "EmacsWiki" anything-input))) ("Update cache" . (lambda (candidate) (if anything-yaoddmuse-use-cache-file (progn (anything-yaoddmuse-cache-pages t) (setq anything-c-yaoddmuse-ew-cache (gethash "EmacsWiki" yaoddmuse-pages-hash))) (yaoddmuse-update-pagename)))))) (action-transformer anything-c-yaoddmuse-action-transformer)) "Needs yaoddmuse.el. http://www.emacswiki.org/emacs/download/yaoddmuse.el") ;; (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view) (defvar anything-c-source-yaoddmuse-emacswiki-post-library '((name . "Yaoddmuse Post library (EmacsWiki)") (init . (anything-yaoddmuse-init)) (candidates-in-buffer) (action . (("Post library and Browse" . (lambda (candidate) (yaoddmuse-post-file (find-library-name candidate) "EmacsWiki" (file-name-nondirectory (find-library-name candidate)) nil t))) ("Post library" . (lambda (candidate) (yaoddmuse-post-file (find-library-name candidate) "EmacsWiki" (file-name-nondirectory (find-library-name candidate)))))))) "Needs yaoddmuse.el. http://www.emacswiki.org/emacs/download/yaoddmuse.el") ;; (anything 'anything-c-source-yaoddmuse-emacswiki-post-library) (defun anything-c-yaoddmuse-action-transformer (actions candidate) "Allow the use of `install-elisp' only on elisp files." (if (string-match "\.el$" candidate) (append actions '(("Install Elisp" . (lambda (elm) (install-elisp-from-emacswiki elm))))) actions)) ;;;###autoload (defun anything-yaoddmuse-cache-pages (&optional load) "Fetch the list of files on emacswiki and create cache file. If load is non--nil load the file and feed `yaoddmuse-pages-hash'." (interactive) (yaoddmuse-update-pagename) (save-excursion (find-file anything-c-yaoddmuse-cache-file) (erase-buffer) (insert "(puthash \"EmacsWiki\" '(") (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash) do (insert (concat "(\"" (car i) "\") "))) (insert ") yaoddmuse-pages-hash)\n") (save-buffer) (kill-buffer (current-buffer)) (when (or current-prefix-arg load) (load anything-c-yaoddmuse-cache-file)))) ;;;###autoload (defun anything-yaoddmuse-emacswiki-edit-or-view () "Preconfigured `anything' to edit or view EmacsWiki page. Needs yaoddmuse.el. http://www.emacswiki.org/emacs/download/yaoddmuse.el" (interactive) (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view)) ;;;###autoload (defun anything-yaoddmuse-emacswiki-post-library () "Preconfigured `anything' to post library to EmacsWiki. Needs yaoddmuse.el. http://www.emacswiki.org/emacs/download/yaoddmuse.el" (interactive) (anything 'anything-c-source-yaoddmuse-emacswiki-post-library)) (defun anything-yaoddmuse-init () "Init anything buffer status." (let ((anything-buffer (anything-candidate-buffer 'global)) (library-list (yaoddmuse-get-library-list))) (with-current-buffer anything-buffer ;; Insert library name. (dolist (library library-list) (insert (format "%s\n" library))) ;; Sort lines. (sort-lines nil (point-min) (point-max))))) ;;; Eev anchors (defvar anything-c-source-eev-anchor '((name . "Anchors") (candidates . (lambda () (ignore-errors (with-current-buffer anything-current-buffer (loop initially (goto-char (point-min)) while (re-search-forward (format ee-anchor-format "\\([^\.].+\\)") nil t) for anchor = (match-string-no-properties 1) collect (cons (format "%5d:%s" (line-number-at-pos (match-beginning 0)) (format ee-anchor-format anchor)) anchor)))))) (persistent-action . (lambda (item) (ee-to item) (anything-match-line-color-current-line))) (persistent-help . "Show this entry") (action . (("Goto link" . ee-to))))) ;; (anything 'anything-c-source-eev-anchor) ;;;; ;;; Org keywords (defvar anything-c-source-org-keywords '((name . "Org Keywords") (init . anything-c-org-keywords-init) (candidates . anything-c-org-keywords-candidates) (action . anything-c-org-keywords-insert) (persistent-action . anything-c-org-keywords-show-help) (persistent-help . "Show an example and info page to describe this keyword.") (keywords-examples) (keywords))) ;; (anything 'anything-c-source-org-keywords) (defvar anything-c-org-keywords-info-location '(("#+TITLE:" . "(org)Export options") ("#+AUTHOR:" . "(org)Export options") ("#+DATE:" . "(org)Export options") ("#+EMAIL:" . "(org)Export options") ("#+DESCRIPTION:" . "(org)Export options") ("#+KEYWORDS:" . "(org)Export options") ("#+LANGUAGE:" . "(org)Export options") ("#+TEXT:" . "(org)Export options") ("#+TEXT:" . "(org)Export options") ("#+OPTIONS:" . "(org)Export options") ("#+BIND:" . "(org)Export options") ("#+LINK_UP:" . "(org)Export options") ("#+LINK_HOME:" . "(org)Export options") ("#+LATEX_HEADER:" . "(org)Export options") ("#+EXPORT_SELECT_TAGS:" . "(org)Export options") ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options") ("#+INFOJS_OPT" . "(org)Javascript support") ("#+BEGIN_HTML" . "(org)Quoting HTML tags") ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code") ("#+ORGTBL" . "(org)Radio tables") ("#+HTML:" . "(org)Quoting HTML tags") ("#+LaTeX:" . "(org)Quoting LaTeX code") ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview ("#+BEGIN_EXAMPLE" . "(org)Literal examples") ("#+BEGIN_QUOTE" . "(org)Paragraphs") ("#+BEGIN_VERSE" . "(org)Paragraphs") ("#+BEGIN_SRC" . "(org)Literal examples") ("#+CAPTION" . "(org)Tables in HTML export") ("#+LABEL" . "(org)Tables in LaTeX export") ("#+ATTR_HTML" . "(org)Links") ("#+ATTR_LaTeX" . "(org)Images in LaTeX export"))) (defun anything-c-org-keywords-init () (unless (anything-attr 'keywords-examples) (require 'org) (anything-attrset 'keywords-examples (append (mapcar (lambda (x) (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) (cons (match-string 2 x) (match-string 1 x))) (org-split-string (org-get-current-options) "\n")) (mapcar 'list org-additional-option-like-keywords))) (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples))))) (defun anything-c-org-keywords-candidates () (and (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode) (anything-attr 'keywords))) (defun anything-c-org-keywords-insert (keyword) (cond ((string-match "BEGIN" keyword) (insert "#+" keyword " ") (save-excursion (insert "\n" (replace-regexp-in-string "BEGIN" "END" keyword) "\n"))) (t (insert "#+" keyword " ")))) (defun anything-c-org-keywords-show-help (keyword) (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location) "(org)In-buffer settings")) (search-forward (concat "#+" keyword) nil t) (anything-persistent-highlight-point) (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) ""))) ;;; Picklist (defvar anything-c-source-picklist '((name . "Picklist") (candidates . (lambda () (mapcar 'car picklist-list))) (type . file))) ;; (anything 'anything-c-source-picklist) ;;; BBDB (defvar bbdb-records) (defvar bbdb-buffer-name) (declare-function bbdb "ext:bbdb-com") (declare-function bbdb-current-record "ext:bbdb-com") (declare-function bbdb-redisplay-one-record "ext:bbdb-com") (declare-function bbdb-record-net "ext:bbdb-com" (string) t) (declare-function bbdb-current-record "ext:bbdb-com") (declare-function bbdb-dwim-net-address "ext:bbdb-com") (declare-function bbdb-records "ext:bbdb-com" (&optional dont-check-disk already-in-db-buffer)) (defun anything-c-bbdb-candidates () "Return a list of all names in the bbdb database. The format is \"Firstname Lastname\"." (mapcar (lambda (bbdb-record) (replace-regexp-in-string "\\s-+$" "" (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)) (defun anything-c-bbdb-get-record (candidate) "Return record that match CANDIDATE." (bbdb candidate nil) (set-buffer "*BBDB*") (bbdb-current-record)) (defvar anything-c-bbdb-name nil "Only for internal use.") (defvar anything-c-source-bbdb '((name . "BBDB") (candidates . anything-c-bbdb-candidates) (action ("Send a mail" . anything-c-bbdb-compose-mail) ("View person's data" . anything-c-bbdb-view-person-action)) (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)))) "Needs BBDB. http://bbdb.sourceforge.net/") ;; (anything 'anything-c-source-bbdb) (defun anything-c-bbdb-view-person-action (candidate) "View BBDB data of single CANDIDATE or marked candidates." (anything-aif (anything-marked-candidates) (let ((bbdb-append-records (length it))) (dolist (i it) (bbdb-redisplay-one-record (anything-c-bbdb-get-record i)))) (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate)))) (defun anything-c-bbdb-collect-mail-addresses () "Return a list of all mail addresses of records in bbdb buffer." (with-current-buffer bbdb-buffer-name (loop for i in bbdb-records if (bbdb-record-net (car i)) collect (bbdb-dwim-net-address (car i))))) (defun anything-c-bbdb-compose-mail (candidate) "Compose a mail with all records of bbdb buffer." (anything-c-bbdb-view-person-action candidate) (let* ((address-list (anything-c-bbdb-collect-mail-addresses)) (address-str (mapconcat 'identity address-list ",\n "))) (compose-mail address-str))) ;;; Evaluation Result (defvar anything-c-source-evaluation-result '((name . "Evaluation Result") (disable-shortcuts) (dummy) (filtered-candidate-transformer . (lambda (candidates source) (list (condition-case nil (with-current-buffer anything-current-buffer (pp-to-string (eval (read anything-pattern)))) (error "Error"))))) (action ("Copy result to kill-ring" . (lambda (candidate) (with-current-buffer anything-buffer (let ((end (save-excursion (goto-char (point-max)) (search-backward "\n") (point)))) (kill-region (point) end)))))))) ;; (anything 'anything-c-source-evaluation-result) ;;;###autoload (defun anything-eval-expression (arg) "Preconfigured anything for `anything-c-source-evaluation-result'." (interactive "P") (anything 'anything-c-source-evaluation-result (when arg (thing-at-point 'sexp)) nil nil nil "*anything eval*")) ;;;###autoload (defun anything-eval-expression-with-eldoc () "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. " (interactive) (if (window-system) (let ((timer (run-with-idle-timer eldoc-idle-delay 'repeat 'anything-eldoc-show-in-eval))) (unwind-protect (call-interactively 'anything-eval-expression) (cancel-timer timer))) (call-interactively 'anything-eval-expression))) (defun anything-eldoc-show-in-eval () "Return eldoc in a tooltip for current minibuffer input." (let* ((str-all (minibuffer-completion-contents)) (sym (when str-all (with-temp-buffer (insert str-all) (goto-char (point-max)) (unless (looking-back ")\\|\"") (forward-char -1)) (eldoc-current-symbol)))) (doc (or (eldoc-get-var-docstring sym) (eldoc-get-fnsym-args-string (car (eldoc-fnsym-in-current-sexp)))))) (when doc (tooltip-show doc)))) ;;; Calculation Result (defvar anything-c-source-calculation-result '((name . "Calculation Result") (dummy) (filtered-candidate-transformer . (lambda (candidates source) (list (condition-case nil (calc-eval anything-pattern) (error "error"))))) (action ("Copy result to kill-ring" . kill-new)))) ;; (anything 'anything-c-source-calculation-result) ;;; Google Suggestions (defvar anything-gg-sug-lgh-flag 0) (defun anything-c-google-suggest-fetch (input) "Fetch suggestions for INPUT from XML buffer. Return an alist with elements like (data . number_results)." (let ((request (concat anything-c-google-suggest-url (url-hexify-string input)))) (flet ((fetch () (loop with result-alist = (xml-get-children (car (xml-parse-region (point-min) (point-max))) 'CompleteSuggestion) for i in result-alist for data = (cdr (caadr (assoc 'suggestion i))) for nqueries = (cdr (caadr (assoc 'num_queries i))) for ldata = (length data) do (when (> ldata anything-gg-sug-lgh-flag) (setq anything-gg-sug-lgh-flag ldata)) collect (cons data nqueries) into cont finally return cont))) (if anything-google-suggest-use-curl-p (with-temp-buffer (call-process "curl" nil t nil request) (fetch)) (with-current-buffer (url-retrieve-synchronously request) (fetch)))))) (defun anything-c-google-suggest-set-candidates () "Set candidates with result and number of google results found." (let ((suggestions (anything-c-google-suggest-fetch anything-input))) (setq suggestions (loop for i in suggestions for interval = (- anything-gg-sug-lgh-flag (length (car i))) for elm = (concat (car i) (make-string (+ 2 interval) ? ) "(" (cdr i) " results)") collect (cons elm (car i)))) (if (some (lambda (data) (equal (cdr data) anything-input)) suggestions) suggestions ;; if there is no suggestion exactly matching the input then ;; prepend a Search on Google item to the list (append suggestions (list (cons (concat "Search for " "'" anything-input "'" " on Google") anything-input)))))) (defun anything-c-google-suggest-action (candidate) "Default action to jump to a google suggested candidate." (anything-c-browse-url (concat anything-c-google-suggest-search-url (url-hexify-string candidate)))) (defvar anything-c-source-google-suggest '((name . "Google Suggest") (candidates . anything-c-google-suggest-set-candidates) (action . (("Google Search" . anything-c-google-suggest-action))) (volatile) (requires-pattern . 3) (delayed))) ;; (anything 'anything-c-source-google-suggest) ;;; Yahoo suggestions (defun anything-c-yahoo-suggest-fetch (input) "Fetch Yahoo suggestions for INPUT from XML buffer. Return an alist with elements like (data . number_results)." (let ((request (concat anything-c-yahoo-suggest-url (url-hexify-string input)))) (flet ((fetch () (loop with result-alist = (xml-get-children (car (xml-parse-region (point-min) (point-max))) 'Result) for i in result-alist collect (caddr i)))) (with-current-buffer (url-retrieve-synchronously request) (fetch))))) (defun anything-c-yahoo-suggest-set-candidates () "Set candidates with Yahoo results found." (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input))) (or suggestions (append suggestions (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo") anything-input)))))) (defun anything-c-yahoo-suggest-action (candidate) "Default action to jump to a Yahoo suggested candidate." (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url (url-hexify-string candidate)))) (defvar anything-c-source-yahoo-suggest '((name . "Yahoo Suggest") (candidates . anything-c-yahoo-suggest-set-candidates) (action . (("Yahoo Search" . anything-c-yahoo-suggest-action))) (volatile) (requires-pattern . 3) (delayed))) ;; (anything 'anything-c-source-yahoo-suggest) ;;; Surfraw ;;; Need external program surfraw. ;;; http://surfraw.alioth.debian.org/ ;; user variables (require 'browse-url) (defvar w3m-command nil) (defvar anything-c-home-url "http://www.google.fr" "*Default url to use as home url.") (defvar anything-browse-url-default-browser-alist `((,w3m-command . w3m-browse-url) (,browse-url-firefox-program . browse-url-firefox) (,browse-url-kde-program . browse-url-kde) (,browse-url-gnome-moz-program . browse-url-gnome-moz) (,browse-url-mozilla-program . browse-url-mozilla) (,browse-url-galeon-program . browse-url-galeon) (,browse-url-netscape-program . browse-url-netscape) (,browse-url-mosaic-program . browse-url-mosaic) (,browse-url-xterm-program . browse-url-text-xterm)) "*Alist of (executable . function) to try to find a suitable url browser.") (defun anything-browse-url-default-browser (url &rest args) "Find a suitable browser and ask it to load URL." (let ((default-browser (loop for i in anything-browse-url-default-browser-alist when (and (car i) (executable-find (car i))) return (cdr i)))) (if default-browser (apply default-browser url args) (error "No usable browser found")))) (defun* anything-c-browse-url (&optional (url anything-c-home-url)) "Default command to browse URL." (if browse-url-browser-function (browse-url url) (anything-browse-url-default-browser url))) (defun anything-c-build-elvi-list () "Return list of all engines and descriptions handled by surfraw." (cdr (with-temp-buffer (call-process "surfraw" nil t nil "-elvi") (split-string (buffer-string) "\n")))) (defvar anything-surfraw-engines-history nil) ;;;###autoload (defun anything-surfraw (pattern engine) "Preconfigured `anything' to search PATTERN with search ENGINE." (interactive (list (read-string "SearchFor: ") (anything-comp-read "Engine: " (anything-c-build-elvi-list) :must-match t :name "Surfraw Search Engines" :history anything-surfraw-engines-history))) (let* ((engine-nodesc (car (split-string engine))) (url (with-temp-buffer (apply 'call-process "surfraw" nil t nil (list engine-nodesc "-p" pattern)) (replace-regexp-in-string "\n" "" (buffer-string))))) (if (string= engine-nodesc "W") (anything-c-browse-url) (anything-c-browse-url url) (setq anything-surfraw-engines-history (cons engine (delete engine anything-surfraw-engines-history)))))) ;;; Emms ;;;###autoload (defun anything-emms-stream-edit-bookmark (elm) "Change the information of current emms-stream bookmark from anything." (interactive) (let* ((cur-buf anything-current-buffer) (bookmark (assoc elm emms-stream-list)) (name (read-from-minibuffer "Description: " (nth 0 bookmark))) (url (read-from-minibuffer "URL: " (nth 1 bookmark))) (fd (read-from-minibuffer "Feed Descriptor: " (int-to-string (nth 2 bookmark)))) (type (read-from-minibuffer "Type (url, streamlist, or lastfm): " (format "%s" (car (last bookmark)))))) (save-excursion (emms-streams) (when (re-search-forward (concat "^" name) nil t) (beginning-of-line) (emms-stream-delete-bookmark) (emms-stream-add-bookmark name url (string-to-number fd) type) (emms-stream-save-bookmarks-file) (emms-stream-quit) (switch-to-buffer cur-buf))))) (defun anything-emms-stream-delete-bookmark (elm) "Delete an emms-stream bookmark from anything." (interactive) (let* ((cur-buf anything-current-buffer) (bookmark (assoc elm emms-stream-list)) (name (nth 0 bookmark))) (save-excursion (emms-streams) (when (re-search-forward (concat "^" name) nil t) (beginning-of-line) (emms-stream-delete-bookmark) (emms-stream-save-bookmarks-file) (emms-stream-quit) (switch-to-buffer cur-buf))))) (defvar anything-c-source-emms-streams '((name . "Emms Streams") (init . (lambda () (emms-stream-init))) (candidates . (lambda () (mapcar 'car emms-stream-list))) (action . (("Play" . (lambda (elm) (let* ((stream (assoc elm emms-stream-list)) (fn (intern (concat "emms-play-" (symbol-name (car (last stream)))))) (url (second stream))) (funcall fn url)))) ("Delete" . anything-emms-stream-delete-bookmark) ("Edit" . anything-emms-stream-edit-bookmark))) (filtered-candidate-transformer . anything-c-adaptive-sort))) ;; (anything 'anything-c-source-emms-streams) ;; Don't forget to set `emms-source-file-default-directory' (defvar anything-c-source-emms-dired '((name . "Music Directory") (candidates . (lambda () (cddr (directory-files emms-source-file-default-directory)))) (action . (("Play Directory" . (lambda (item) (emms-play-directory (expand-file-name item emms-source-file-default-directory)))) ("Open dired in file's directory" . (lambda (item) (anything-c-open-dired (expand-file-name item emms-source-file-default-directory)))))) (filtered-candidate-transformer . anything-c-adaptive-sort))) ;; (anything 'anything-c-source-emms-dired) (defface anything-emms-playlist '((t (:foreground "Springgreen4" :underline t))) "*Face used for tracks in current emms playlist." :group 'anything) (defun anything-c-emms-files-modifier (candidates) (let ((current-playlist (with-current-emms-playlist (loop with cur-list = (emms-playlist-tracks-in-region (point-min) (point-max)) for i in cur-list collect (assoc-default 'info-file i))))) (loop for i in candidates if (member i current-playlist) collect (propertize i 'face 'anything-emms-playlist) into lis else collect i into lis finally return lis))) (defun anything-c-emms-play-current-playlist () "Play current playlist." (with-current-emms-playlist (emms-playlist-first) (emms-playlist-mode-play-smart))) (defvar anything-c-source-emms-files '((name . "Emms files") (candidates . (lambda () (loop for v being the hash-values in emms-cache-db for name = (assoc-default 'name v) unless (string-match "^http:" name) collect name))) (candidate-transformer . anything-c-emms-files-modifier) (action . (("Play file" . emms-play-file) ("Add to Playlist and play" . (lambda (candidate) (emms-playlist-new) (mapc 'emms-add-playlist-file (anything-marked-candidates)) (unless emms-player-playing-p (anything-c-emms-play-current-playlist)))))))) ;; (anything 'anything-c-source-emms-files) ;;; Jabber Contacts (jabber.el) (defun anything-c-jabber-online-contacts () "List online Jabber contacts." (with-no-warnings (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))))))))) ;; (anything 'anything-c-source-jabber-contacts) ;;; Call source. (defvar anything-source-select-buffer "*anything source select*") (defvar anything-c-source-call-source `((name . "Call anything source") (candidate-number-limit) (candidates . (lambda () (loop for vname in (all-completions "anything-c-source-" obarray) for var = (intern vname) for name = (ignore-errors (assoc-default 'name (symbol-value var))) if name collect (cons (format "%s `%s'" name (propertize vname 'face 'font-lock-variable-name-face)) var)))) (action . (("Invoke anything with selected source" . (lambda (candidate) (setq anything-candidate-number-limit 9999) (anything candidate nil nil nil nil anything-source-select-buffer))) ("Describe variable" . describe-variable) ("Find variable" . find-variable))) (persistent-action . describe-variable) (persistent-help . "Show description of this source"))) ;; (anything 'anything-c-source-call-source) ;;;###autoload (defun anything-call-source () "Preconfigured `anything' to call anything source." (interactive) (anything 'anything-c-source-call-source nil nil nil nil anything-source-select-buffer)) (defun anything-call-source-from-anything () "Call anything source within `anything' session." (interactive) (setq anything-input-idle-delay 0) (anything-set-sources '(anything-c-source-call-source))) ;;; Execute Preconfigured anything. (defvar anything-c-source-anything-commands '((name . "Preconfigured Anything") (candidates . anything-c-anything-commands-candidates) (type . command) (candidate-number-limit))) ;; (anything 'anything-c-source-anything-commands) (defun anything-c-anything-commands-candidates () (loop for (cmd . desc) in (anything-c-list-preconfigured-anything) collect (cons (if (where-is-internal cmd nil t) (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc)) (substitute-command-keys (format "\\[%s] : %s" cmd desc))) cmd))) ;;;###autoload (defun anything-execute-anything-command () "Preconfigured `anything' to execute preconfigured `anything'." (interactive) (anything-other-buffer 'anything-c-source-anything-commands "*anything commands*")) ;; Occur (defun anything-c-occur-init () (anything-candidate-buffer anything-current-buffer)) (defun anything-c-occur-get-line (s e) (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e))) (defvar anything-c-source-occur '((name . "Occur") (init . anything-c-occur-init) (candidates-in-buffer) (migemo) (get-line . anything-c-occur-get-line) (type . line) (recenter) (requires-pattern . 1) (delayed) (volatile))) ;; (anything 'anything-c-source-occur) ;;; Anything browse code. (defun anything-c-browse-code-get-line (beg end) "Select line if it match the regexp corresponding to current `major-mode'. Line is parsed for BEG position to END position." (let ((str-line (buffer-substring beg end)) (regexp (assoc-default major-mode anything-c-browse-code-regexp-alist)) (num-line (if (string= anything-pattern "") beg (1- beg)))) (when (and regexp (string-match regexp str-line)) (format "%4d:%s" (line-number-at-pos num-line) str-line)))) (defvar anything-c-source-browse-code '((name . "Browse code") (init . (lambda () (anything-candidate-buffer anything-current-buffer) (with-current-buffer anything-current-buffer (jit-lock-fontify-now)))) (candidates-in-buffer) (get-line . anything-c-browse-code-get-line) (type . line) (recenter))) ;; Do many actions for input (defvar anything-c-source-create '((name . "Create") (dummy) (action) (action-transformer . anything-create--actions)) "Do many create actions from `anything-pattern'. See also `anything-create--actions'.") ;; (anything 'anything-c-source-create) (defun anything-create-from-anything () "Run `anything-create' from `anything' as a fallback." (interactive) (anything-run-after-quit 'anything-create nil anything-pattern)) ;;;###autoload (defun anything-create (&optional string initial-input) "Preconfigured `anything' to do many create actions from STRING. See also `anything-create--actions'." (interactive) (setq string (or string (read-string "Create Anything: " initial-input))) (anything '(((name . "Anything Create") (header-name . (lambda (_) (format "Action for \"%s\"" string))) (candidates . anything-create--actions) (candidate-number-limit) (action . (lambda (func) (funcall func string))))))) (defun anything-create--actions (&rest ignored) "Default actions for `anything-create' / `anything-c-source-create'." (remove-if-not (lambda (pair) (and (consp pair) (functionp (cdr pair)))) (append anything-create--actions-private '(("find-file" . find-file) ("find-file other window" . find-file-other-window) ("New buffer" . switch-to-buffer) ("New buffer other window" . switch-to-buffer-other-window) ("Bookmark Set" . bookmark-set) ("Set Register" . (lambda (x) (set-register (read-char "Register: ") x))) ("Insert Linkd star" . linkd-insert-star) ("Insert Linkd Tag" . linkd-insert-tag) ("Insert Linkd Link" . linkd-insert-link) ("Insert Linkd Lisp" . linkd-insert-lisp) ("Insert Linkd Wiki" . linkd-insert-wiki) ("Google Search" . google))))) ;; Minibuffer History (defvar anything-c-source-minibuffer-history '((name . "Minibuffer History") (header-name . (lambda (name) (format "%s (%s)" name minibuffer-history-variable))) (candidates . (lambda () (let ((history (symbol-value minibuffer-history-variable))) (if (consp (car history)) (mapcar 'prin1-to-string history) history)))) (migemo) (action . insert))) ;; (anything 'anything-c-source-minibuffer-history) ;; elscreen (defvar anything-c-source-elscreen '((name . "Elscreen") (candidates . (lambda () (if (cdr (elscreen-get-screen-to-name-alist)) (sort (loop for sname in (elscreen-get-screen-to-name-alist) append (list (format "[%d] %s" (car sname) (cdr sname))) into lst finally (return lst)) #'(lambda (a b) (compare-strings a nil nil b nil nil)))))) (action . (("Change Screen". (lambda (candidate) (elscreen-goto (- (aref candidate 1) (aref "0" 0))))) ("Kill Screen(s)". (lambda (candidate) (dolist (i (anything-marked-candidates)) (elscreen-goto (- (aref i 1) (aref "0" 0))) (elscreen-kill)))) ("Only Screen". (lambda (candidate) (elscreen-goto (- (aref candidate 1) (aref "0" 0))) (elscreen-kill-others))))))) ;; (anything 'anything-c-source-elscreen) ;;;; ;;; Top (process) (defvar anything-c-top-command "COLUMNS=%s top -b -n 1" "Top command (batch mode). %s is replaced with `frame-width'.") (defvar anything-c-source-top '((name . "Top (Press C-c C-u to refresh)") (init . anything-c-top-init) (candidates-in-buffer) (display-to-real . anything-c-top-display-to-real) (update . anything-c-top-update) (action ("kill (TERM)" . (lambda (pid) (anything-c-top-sh (format "kill -TERM %s" pid)))) ("kill (KILL)" . (lambda (pid) (anything-c-top-sh (format "kill -KILL %s" pid)))) ("Copy PID" . (lambda (pid) (kill-new pid)))))) ;; (anything 'anything-c-source-top) (defun anything-c-top-sh (cmd) (message "Executed %s\n%s" cmd (shell-command-to-string cmd))) (defun anything-c-top-init () (with-current-buffer (anything-candidate-buffer 'global) (call-process-shell-command (format anything-c-top-command (- (frame-width) (if anything-enable-digit-shortcuts 4 0))) nil (current-buffer)))) (defun anything-c-top-display-to-real (line) (car (split-string line))) (defun anything-c-top-update () (let ((anything-source-name (assoc-default 'name anything-c-source-top))) ;UGLY HACK (anything-c-top-init))) ;;;###autoload (defun anything-top () "Preconfigured `anything' for top command." (interactive) (let ((anything-samewindow t) (anything-enable-shortcuts) (anything-display-function 'anything-default-display-buffer) (anything-candidate-number-limit 9999)) (save-window-excursion (delete-other-windows) (anything-other-buffer 'anything-c-source-top "*anything top*")))) ;;; Timers (defvar anything-c-source-absolute-time-timers '((name . "Absolute Time Timers") (candidates . timer-list) (type . timer))) ;; (anything 'anything-c-source-absolute-time-timers) (defvar anything-c-source-idle-time-timers '((name . "Idle Time Timers") (candidates . timer-idle-list) (type . timer))) ;; (anything 'anything-c-source-idle-time-timers) (defun anything-c-timer-real-to-display (timer) (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay) (append timer nil) ;use `append' to convert vector->list (format "%s repeat=%5S %s(%s)" (let ((time (list t1 t2 t3))) (if idle-delay (format-time-string "idle-for=%5s" time) (format-time-string "%m/%d %T" time))) repeat-delay func (mapconcat 'prin1-to-string args " ")))) ;;; X RandR resolution change ;;; FIXME I do not care multi-display. (defvar anything-c-xrandr-output "VGA") (defvar anything-c-xrandr-screen "0") (defvar anything-c-source-xrandr-change-resolution '((name . "Change Resolution") (candidates . (lambda () (with-temp-buffer (call-process "xrandr" nil (current-buffer) nil "--screen" anything-c-xrandr-screen "-q") (goto-char 1) (loop while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t) collect (match-string 1))))) (action ("Change Resolution" . (lambda (mode) (call-process "xrandr" nil nil nil "--screen" anything-c-xrandr-screen "--output" anything-c-xrandr-output "--mode" mode)))))) ;; (anything 'anything-c-source-xrandr-change-resolution) ;;; Xfont selection (defun anything-c-persistent-xfont-action (elm) "Show current font temporarily" (let ((current-font (cdr (assoc 'font (frame-parameters)))) (default-font elm)) (unwind-protect (progn (set-frame-font default-font 'keep-size) (sit-for 2)) (set-frame-font current-font)))) (defvar anything-c-xfonts-cache nil) (defvar anything-c-source-xfonts '((name . "X Fonts") (init . (lambda () (unless anything-c-xfonts-cache (setq anything-c-xfonts-cache (x-list-fonts "*"))))) (candidates . anything-c-xfonts-cache) (action . (("Copy to kill ring" . (lambda (elm) (kill-new elm))) ("Set Font" . (lambda (elm) (kill-new elm) (set-frame-font elm 'keep-size) (message "New font have been copied to kill ring"))))) (persistent-action . anything-c-persistent-xfont-action) (persistent-help . "Switch to this font temporarily"))) ;;;###autoload (defun anything-select-xfont () "Preconfigured `anything' to select Xfont." (interactive) (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont")) ;; (anything 'anything-c-source-xfonts) ;;; Source for Debian/Ubuntu users (defvar anything-c-source-apt '((name . "APT") (init . anything-c-apt-init) (candidates-in-buffer) (candidate-transformer anything-c-apt-candidate-transformer) (display-to-real . anything-c-apt-display-to-real) (candidate-number-limit . 9999) (action ("Show package description" . anything-c-apt-cache-show) ("Install package" . anything-c-apt-install) ("Remove package" . anything-c-apt-uninstall) ("Purge package" . anything-c-apt-purge)) (persistent-action . anything-c-apt-persistent-action) (persistent-help . "Show - C-u Refresh"))) ;; (anything 'anything-c-source-apt) (defvar anything-c-apt-query "emacs") (defvar anything-c-apt-search-command "apt-cache search '%s'") (defvar anything-c-apt-show-command "apt-cache show '%s'") (defvar anything-c-apt-installed-packages nil) (defface anything-apt-installed '((t (:foreground "green"))) "*Face used for apt installed candidates." :group 'anything) (defun anything-c-apt-refresh () "Refresh installed candidates list." (setq anything-c-apt-installed-packages nil) (anything-force-update)) (defun anything-c-apt-persistent-action (candidate) "Persistent action for APT source." (if current-prefix-arg (anything-c-apt-refresh) (anything-c-apt-cache-show candidate))) ;;;###autoload (defun anything-apt (query) "Preconfigured `anything' : frontend of APT package manager." (interactive "sAPT search: ") (let ((anything-c-apt-query query)) (anything 'anything-c-source-apt))) (defun anything-c-apt-candidate-transformer (candidates) "Show installed candidates in a different color." (loop with all for cand in candidates for name = (anything-c-apt-display-to-real cand) if (member name anything-c-apt-installed-packages) collect (propertize cand 'face 'anything-apt-installed) into all else collect cand into all finally return all)) (defun anything-c-apt-init () "Initialize list of debian packages." (unless anything-c-apt-installed-packages (message "Updating installed candidate list...") (setq anything-c-apt-installed-packages (with-temp-buffer (call-process-shell-command "dpkg --get-selections" nil (current-buffer)) (loop for i in (split-string (buffer-string) "\n" t) collect (car (split-string i)))))) (with-current-buffer (anything-candidate-buffer (get-buffer-create (format "*anything-apt:%s*" anything-c-apt-query))) (erase-buffer) (call-process-shell-command (format anything-c-apt-search-command anything-c-apt-query) nil (current-buffer))) (message "Updating installed candidate list...done")) (defun anything-c-apt-display-to-real (line) "Return only name of a debian package. LINE is displayed like: package name - description." (car (split-string line " - "))) ;;;###autoload (defun anything-c-shell-command-if-needed (command) (interactive "sShell command: ") (if (get-buffer command) ; if the buffer already exists (switch-to-buffer command) ; then just switch to it (switch-to-buffer command) ; otherwise create it (insert (shell-command-to-string command)))) (defun anything-c-apt-cache-show (package) (anything-c-shell-command-if-needed (format anything-c-apt-show-command package))) (defun anything-c-apt-install (package) (anything-c-apt-install1 package :action 'install)) (defun anything-c-apt-uninstall (package) (anything-c-apt-install1 package :action 'uninstall)) (defun anything-c-apt-purge (package) (anything-c-apt-install1 package :action 'purge)) (defun* anything-c-apt-install1 (candidate &key action) (ansi-term (getenv "SHELL") "anything apt") (term-line-mode) (let ((command (case action ('install "sudo apt-get install '%s'") ('uninstall "sudo apt-get remove '%s'") ('purge "sudo apt-get purge '%s'") (t (error "Unknow action")))) (beg (point)) end) (goto-char (point-max)) (insert (format command candidate)) (setq end (point)) (if (y-or-n-p (format "%s package" (symbol-name action))) (progn (setq anything-c-external-commands-list nil) (setq anything-c-apt-installed-packages nil) (term-char-mode) (term-send-input)) (delete-region beg end) (term-send-eof) (kill-buffer)))) ;; (anything-c-apt-install "jed") ;;; Sources for gentoo users (defvar anything-c-gentoo-use-flags nil) (defvar anything-c-gentoo-buffer "*anything-gentoo-output*") (defvar anything-c-cache-gentoo nil) (defvar anything-c-cache-world nil) (defvar anything-c-source-gentoo '((name . "Portage sources") (init . (lambda () (get-buffer-create anything-c-gentoo-buffer) (unless anything-c-cache-gentoo (anything-c-gentoo-setup-cache)) (unless anything-c-cache-world (setq anything-c-cache-world (anything-c-gentoo-get-world))) (anything-c-gentoo-init-list))) (candidates-in-buffer) (match . identity) (candidate-transformer anything-c-highlight-world) (action . (("Show package" . (lambda (elm) (anything-c-gentoo-eshell-action elm "eix"))) ("Show history" . (lambda (elm) (if (member elm anything-c-cache-world) (anything-c-gentoo-eshell-action elm "genlop -qe") (message "No infos on packages not yet installed")))) ("Copy in kill-ring" . kill-new) ("insert at point" . insert) ("Browse HomePage" . (lambda (elm) (let ((urls (anything-c-gentoo-get-url elm))) (browse-url (anything-comp-read "Url: " urls :must-match t))))) ("Show extra infos" . (lambda (elm) (if (member elm anything-c-cache-world) (anything-c-gentoo-eshell-action elm "genlop -qi") (message "No infos on packages not yet installed")))) ("Show use flags" . (lambda (elm) (anything-c-gentoo-default-action elm "equery" "-C" "u") (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face))) (font-lock-mode 1))) ("Run emerge pretend" . (lambda (elm) (anything-c-gentoo-eshell-action elm "emerge -p"))) ("Emerge" . (lambda (elm) (anything-gentoo-install elm :action 'install))) ("Unmerge" . (lambda (elm) (anything-gentoo-install elm :action 'uninstall))) ("Show dependencies" . (lambda (elm) (anything-c-gentoo-default-action elm "equery" "-C" "d"))) ("Show related files" . (lambda (elm) (anything-c-gentoo-default-action elm "equery" "files"))) ("Refresh" . (lambda (elm) (anything-c-gentoo-setup-cache) (setq anything-c-cache-world (anything-c-gentoo-get-world)))))))) ;; (anything 'anything-c-source-gentoo) (defun* anything-gentoo-install (candidate &key action) (setq anything-c-external-commands-list nil) (ansi-term (getenv "SHELL") "Gentoo emerge") (term-line-mode) (let ((command (case action ('install "sudo emerge -av ") ('uninstall "sudo emerge -avC ") (t (error "Unknow action")))) (elms (mapconcat 'identity (anything-marked-candidates) " ")) (beg (point)) end) (goto-char (point-max)) (insert (concat command elms)) (setq end (point)) (term-char-mode) (term-send-input))) (defun anything-c-gentoo-default-action (elm command &rest args) "Gentoo default action that use `anything-c-gentoo-buffer'." (if (member elm anything-c-cache-world) (progn (switch-to-buffer anything-c-gentoo-buffer) (erase-buffer) (let ((com-list (append args (list elm)))) (apply #'call-process command nil t nil com-list))) (message "No infos on packages not yet installed"))) (defvar anything-c-source-use-flags '((name . "Use Flags") (init . (lambda () (unless anything-c-gentoo-use-flags (anything-c-gentoo-setup-use-flags-cache)) (anything-c-gentoo-get-use))) (candidates-in-buffer) (match . identity) (candidate-transformer anything-c-highlight-local-use) (action . (("Description" . (lambda (elm) (switch-to-buffer anything-c-gentoo-buffer) (erase-buffer) (apply #'call-process "euse" nil t nil `("-i" ,elm)) (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face))) (font-lock-mode 1))) ("Enable" . (lambda (elm) (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E"))) ("Disable" . (lambda (elm) (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D"))) ("Remove" . (lambda (elm) (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P"))) ("Show which dep use this flag" . (lambda (elm) (switch-to-buffer anything-c-gentoo-buffer) (erase-buffer) (apply #'call-process "equery" nil t nil `("-C" "h" ,elm)))))))) ;; (anything 'anything-c-source-use-flags) (defun anything-c-gentoo-init-list () "Initialize buffer with all packages in Portage." (let* ((portage-buf (get-buffer-create "*anything-gentoo*")) (buf (anything-candidate-buffer 'portage-buf))) (with-current-buffer buf (dolist (i anything-c-cache-gentoo) (insert (concat i "\n")))))) (defun anything-c-gentoo-setup-cache () "Set up `anything-c-cache-gentoo'" (setq anything-c-cache-gentoo (split-string (with-temp-buffer (call-process "eix" nil t nil "--only-names") (buffer-string))))) (defun anything-c-gentoo-eshell-action (elm command) (when (get-buffer "*EShell Command Output*") (kill-buffer "*EShell Command Output*")) (message "Wait searching...") (let ((buf-fname (buffer-file-name anything-current-buffer))) (if (and buf-fname (string-match tramp-file-name-regexp buf-fname)) (progn (save-window-excursion (pop-to-buffer "*scratch*") (eshell-command (format "%s %s" command elm))) (pop-to-buffer "*EShell Command Output*")) (eshell-command (format "%s %s" command elm))))) (defun anything-c-gentoo-get-use () "Initialize buffer with all use flags." (let* ((use-buf (get-buffer-create "*anything-gentoo-use*")) (buf (anything-candidate-buffer 'use-buf))) (with-current-buffer buf (dolist (i anything-c-gentoo-use-flags) (insert (concat i "\n")))))) (defun anything-c-gentoo-setup-use-flags-cache () "Setup `anything-c-gentoo-use-flags'" (setq anything-c-gentoo-use-flags (split-string (with-temp-buffer (call-process "eix" nil t nil "--print-all-useflags") (buffer-string))))) (defun anything-c-gentoo-get-url (elm) "Return a list of urls from eix output." (loop with url-list = (split-string (with-temp-buffer (call-process "eix" nil t nil elm "--format" "\n") (buffer-string))) with all for i in url-list when (and (string-match "^http://.*" i) (not (member i all))) collect i into all finally return all)) (defun anything-c-gentoo-get-world () "Return list of all installed package on your system." (split-string (with-temp-buffer (call-process "qlist" nil t nil "-I") (buffer-string)))) (defun anything-c-gentoo-get-local-use () (split-string (with-temp-buffer (call-process "portageq" nil t nil "envvar" "USE") (buffer-string)))) (defface anything-gentoo-match-face '((t (:foreground "red"))) "Face for anything-gentoo installed packages." :group 'traverse-faces) (defun anything-c-highlight-world (eix) "Highlight all installed package." (loop for i in eix if (member i anything-c-cache-world) collect (propertize i 'face 'anything-gentoo-match-face) else collect i)) (defun anything-c-highlight-local-use (use-flags) (let ((local-uses (anything-c-gentoo-get-local-use))) (loop for i in use-flags if (member i local-uses) collect (propertize i 'face 'anything-gentoo-match-face) else collect i))) (defvar anything-c-source-emacs-process '((name . "Emacs Process") (candidates . (lambda () (mapcar #'process-name (process-list)))) (persistent-action . (lambda (elm) (delete-process (get-process elm)) (anything-delete-current-selection))) (persistent-help . "Kill Process") (action ("Kill Process" . (lambda (elm) (delete-process (get-process elm))))))) ;; (anything 'anything-c-source-emacs-process) ;; Run Externals commands within Emacs (defmacro* anything-comp-hash-get-items (hash-table &key test) "Get the list of all keys/values of hash-table." `(let ((li-items ())) (maphash #'(lambda (x y) (if ,test (when (funcall ,test y) (push (list x y) li-items)) (push (list x y) li-items))) ,hash-table) li-items)) (defun anything-comp-read-get-candidates (collection &optional test) "Convert collection to list. If collection is an `obarray', a test is maybe needed, otherwise the list would be incomplete. See `obarray'." (cond ((and (listp collection) test) (loop for i in collection when (funcall test i) collect i)) ((and (eq collection obarray) test) (loop for s being the symbols of collection when (funcall test s) collect s)) ((and (vectorp collection) test) (loop for i across collection when (funcall test i) collect i)) ((vectorp collection) (loop for i across collection collect i)) ((and (hash-table-p collection) test) (anything-comp-hash-get-items collection :test test)) ((hash-table-p collection) (anything-comp-hash-get-items collection)) (t collection))) (defun* anything-comp-read (prompt collection &key test initial-input (buffer "*Anything Completions*") must-match (requires-pattern 0) (history nil) (persistent-action nil) (persistent-help "DoNothing") (name "Anything Completions")) "Anything `completing-read' emulation. PROMPT is the prompt name to use. COLLECTION can be a list, vector, obarray or hash-table. Keys: TEST :a predicate called with one arg i.e candidate. INITIAL-INPUT :same as initial-input arg in `anything'. BUFFER :name of anything-buffer. MUST-MATCH :candidate selected must be one of COLLECTION. REQUIRES-PATTERN :Same as anything attribute, default is 0. HISTORY :a list containing specific history, default is nil. When it is non--nil, all elements of HISTORY are displayed in anything-buffer before COLLECTION. PERSISTENT-ACTION :a function called with one arg i.e candidate. PERSISTENT-HELP :a string to document PERSISTENT-ACTION. NAME :The name related to this local source. Any prefix args passed during `anything-comp-read' invocation will be recorded in `anything-current-prefix-arg', otherwise if prefix args where given before `anything-comp-read' invocation, the value of `current-prefix-arg' will be used." (when (get-buffer anything-action-buffer) (kill-buffer anything-action-buffer)) (or (anything :sources `(((name . ,(format "%s History" name)) (candidates . (lambda () (anything-comp-read-get-candidates history))) (volatile) (persistent-action . ,persistent-action) (persistent-help . ,persistent-help) (action . ,'identity)) ((name . ,name) (candidates . (lambda () (let ((cands (anything-comp-read-get-candidates collection test))) (if (or must-match (string= anything-pattern "")) cands (append (list anything-pattern) cands))))) (requires-pattern . ,requires-pattern) (persistent-action . ,persistent-action) (persistent-help . ,persistent-help) (volatile) (action . (("candidate" . ,'identity))))) :input initial-input :prompt prompt :resume 'noresume :buffer buffer) (keyboard-quit))) (defun anything-c-get-pid-from-process-name (process-name) "Get pid from running process PROCESS-NAME." (loop with process-list = (list-system-processes) for pid in process-list for process = (assoc-default 'comm (process-attributes pid)) when (and process (string-match process-name process)) return pid)) (defun anything-run-or-raise (exe &optional file) "Generic command that run asynchronously EXE. If EXE is already running just jump to his window if `anything-raise-command' is non--nil. When FILE argument is provided run EXE with FILE. In this case EXE must be provided as \"EXE %s\"." (let ((real-com (car (split-string (replace-regexp-in-string " %s" "" exe))))) (if (or (get-process real-com) (anything-c-get-pid-from-process-name real-com)) (if anything-raise-command (shell-command (format anything-raise-command real-com)) (error "Error: %s is already running" real-com)) (when (member real-com anything-c-external-commands-list) (message "Starting %s..." real-com) (if file (start-process-shell-command real-com nil (format exe file)) (start-process-shell-command real-com nil real-com)) (set-process-sentinel (get-process real-com) #'(lambda (process event) (when (string= event "finished\n") (when anything-raise-command (shell-command (format anything-raise-command "emacs"))) (message "%s process...Finished." process)))) (setq anything-c-external-commands-list (push (pop (nthcdr (anything-c-position real-com anything-c-external-commands-list :test 'equal) anything-c-external-commands-list)) anything-c-external-commands-list)))))) (defvar anything-external-command-history nil) ;;;###autoload (defun anything-c-run-external-command (program) "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs. If program is already running exit with error. You can set your own list of commands with `anything-c-external-commands-list'." (interactive (list (anything-comp-read "RunProgram: " (anything-c-external-commands-list-1 'sort) :must-match t :name "External Commands" :history anything-external-command-history))) (anything-run-or-raise program) (setq anything-external-command-history (cons program (delete program (loop for i in anything-external-command-history when (executable-find i) collect i))))) (defsubst* anything-c-position (item seq &key (test 'eq)) "A simple and faster replacement of CL `position'." (loop for i in seq for index from 0 when (funcall test i item) return index)) (defvar anything-c-source-ratpoison-commands '((name . "Ratpoison Commands") (init . anything-c-ratpoison-commands-init) (candidates-in-buffer) (action ("Execute the command" . anything-c-ratpoison-commands-execute)) (display-to-real . anything-c-ratpoison-commands-display-to-real) (candidate-number-limit))) ;; (anything 'anything-c-source-ratpoison-commands) (defun anything-c-ratpoison-commands-init () (unless (anything-candidate-buffer) (with-current-buffer (anything-candidate-buffer 'global) ;; with ratpoison prefix key (save-excursion (call-process "ratpoison" nil (current-buffer) nil "-c" "help")) (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) (replace-match " \\1: \\2")) (goto-char (point-max)) ;; direct binding (save-excursion (call-process "ratpoison" nil (current-buffer) nil "-c" "help top")) (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) (replace-match "\\1: \\2"))))) (defun anything-c-ratpoison-commands-display-to-real (display) (and (string-match ": " display) (substring display (match-end 0)))) (defun anything-c-ratpoison-commands-execute (candidate) (call-process "ratpoison" nil nil nil "-ic" candidate)) ;;;###autoload (defun anything-ratpoison-commands () "Preconfigured `anything' to execute ratpoison commands." (interactive) (anything-other-buffer 'anything-c-source-ratpoison-commands "*anything ratpoison commands*")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 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 (&optional sort) "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'." (if anything-c-external-commands-list anything-c-external-commands-list (setq anything-c-external-commands-list (loop with paths = (split-string (getenv "PATH") path-separator) with completions = () for dir in paths when (and (file-exists-p dir) (file-accessible-directory-p dir)) for lsdir = (loop for i in (directory-files dir t) for bn = (file-name-nondirectory i) when (and (not (member bn completions)) (not (file-directory-p i)) (file-executable-p i)) collect bn) append lsdir into completions finally return (if sort (sort completions 'string-lessp) completions))))) (defun anything-c-file-buffers (filename) "Returns a list of buffer names corresponding to FILENAME." (let ((name (expand-file-name filename)) (buf-list ())) (dolist (buf (buffer-list) buf-list) (let ((bfn (buffer-file-name buf))) (when (and bfn (string= name bfn)) (push (buffer-name buf) buf-list)))))) (defun anything-c-delete-file (file) "Delete the given file after querying the user. Ask to kill buffers associated with that file, too." (let ((buffers (anything-c-file-buffers file))) (dired-delete-file file 'dired-recursive-deletes) (when buffers (dolist (buf buffers) (when (y-or-n-p (format "Kill buffer %s, too? " buf)) (kill-buffer buf)))))) (defun anything-get-mailcap-for-file (filename) "Get the command to use for FILENAME from mailcap files. The command is like and is meant to use with `format'." (mailcap-parse-mailcaps) (let* ((ext (file-name-extension filename)) (mime (when ext (mailcap-extension-to-mime ext)))) (when mime (mailcap-mime-info mime)))) (defun anything-get-default-program-for-file (filename) "Try to find a default program to open FILENAME. Try first in `anything-c-external-programs-associations' and then in mailcap file if nothing found return nil." (let* ((ext (file-name-extension filename)) (def-prog (assoc-default ext anything-c-external-programs-associations))) (if (and def-prog (not (string= def-prog ""))) (concat def-prog " %s") (anything-get-mailcap-for-file filename)))) (defun anything-c-open-file-externally (file) "Open FILE with an external program. Try to guess which program to use with `anything-get-default-program-for-file'. If not found or a prefix arg is given query the user which tool to use." (let* ((fname (expand-file-name file)) (collection (anything-c-external-commands-list-1 'sort)) (def-prog (anything-get-default-program-for-file fname)) (program (or (unless (or anything-current-prefix-arg (not def-prog)) def-prog) (concat (anything-comp-read "Program: " collection :must-match t :name "Open file Externally" :history anything-external-command-history) " %s"))) (real-prog-name (replace-regexp-in-string " %s" "" program))) (unless (or def-prog ; Association exists, no need to record it. (not (file-exists-p fname))) ; Don't record non--filenames. (when (y-or-n-p (format "Do you want to make %s the default program for this kind of files? " real-prog-name)) (push (cons (file-name-extension fname) (read-string "Program(Add args maybe and confirm): " real-prog-name)) anything-c-external-programs-associations) (customize-save-variable 'anything-c-external-programs-associations anything-c-external-programs-associations))) (anything-run-or-raise program file) (setq anything-external-command-history (cons real-prog-name (delete real-prog-name (loop for i in anything-external-command-history when (executable-find i) collect i)))))) ;;;###autoload (defun w32-shell-execute-open-file (file) (interactive "fOpen file:") (with-no-warnings (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))) (defun anything-c-display-to-real-line (candidate) (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate) (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate)) (error "Line number not found"))) (defun anything-c-action-line-goto (lineno-and-content) (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file)) (append lineno-and-content (list (if (and (anything-attr-defined 'target-file) (not anything-in-persistent-action)) 'find-file-other-window 'find-file))))) (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file)) (apply #'anything-goto-file-line (if (stringp file-line-content) ;; Case: filtered-candidate-transformer is skipped (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content)) file-line-content))) (require 'compile) (defun anything-c-filtered-candidate-transformer-file-line (candidates source) (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates))) (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate) (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate) (let ((filename (match-string 1 candidate)) (lineno (match-string 2 candidate)) (content (match-string 3 candidate))) (cons (format "%s:%s\n %s" (propertize filename 'face compilation-info-face) (propertize lineno 'face compilation-line-face) content) (list (expand-file-name filename (or (anything-interpret-value (anything-attr 'default-directory)) (and (anything-candidate-buffer) (buffer-local-value 'default-directory (anything-candidate-buffer))))) (string-to-number lineno) content))))) (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file)) (anything-aif (anything-attr 'before-jump-hook) (funcall it)) (when file (funcall find-file-function file)) (if (anything-attr-defined 'adjust) (anything-c-goto-line-with-adjustment lineno content) (anything-goto-line lineno)) (unless (anything-attr-defined 'recenter) (set-window-start (get-buffer-window anything-current-buffer) (point))) (anything-aif (anything-attr 'after-jump-hook) (funcall it)) (when anything-in-persistent-action (anything-match-line-color-current-line))) (defun anything-find-file-as-root (candidate) (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate)))) (defun anything-find-many-files (ignore) (mapc 'find-file (anything-marked-candidates))) ;; borrowed from etags.el ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el") (defun anything-c-goto-line-with-adjustment (line line-content) (let ((startpos) offset found pat) ;; This constant is 1/2 the initial search window. ;; There is no sense in making it too small, ;; since just going around the loop once probably ;; costs about as much as searching 2000 chars. (setq offset 1000 found nil pat (concat (if (eq selective-display t) "\\(^\\|\^m\\) *" "^ *") ;allow indent (regexp-quote line-content))) ;; If no char pos was given, try the given line number. (setq startpos (progn (anything-goto-line line) (point))) (or startpos (setq startpos (point-min))) ;; First see if the tag is right at the specified location. (goto-char startpos) (setq found (looking-at pat)) (while (and (not found) (progn (goto-char (- startpos offset)) (not (bobp)))) (setq found (re-search-forward pat (+ startpos offset) t) offset (* 3 offset))) ; expand search window (or found (re-search-forward pat nil t) (error "not found"))) ;; Position point at the right place ;; if the search string matched an extra Ctrl-m at the beginning. (and (eq selective-display t) (looking-at "\^m") (forward-char 1)) (beginning-of-line)) (anything-document-attribute 'default-directory "type . file-line" "`default-directory' to interpret file.") (anything-document-attribute 'before-jump-hook "type . file-line / line" "Function to call before jumping to the target location.") (anything-document-attribute 'after-jump-hook "type . file-line / line" "Function to call after jumping to the target location.") (anything-document-attribute 'adjust "type . file-line" "Search around line matching line contents.") (anything-document-attribute 'recenter "type . file-line / line" "`recenter' after jumping.") (anything-document-attribute 'target-file "type . line" "Goto line of target-file.") ;;;###autoload (defun anything-c-call-interactively (cmd-or-name) "Execute CMD-OR-NAME as Emacs command. It is added to `extended-command-history'. `anything-current-prefix-arg' is used as the command's prefix argument." (setq extended-command-history (cons (anything-c-stringify cmd-or-name) (delete (anything-c-stringify cmd-or-name) extended-command-history))) (let ((current-prefix-arg anything-current-prefix-arg) (cmd (anything-c-symbolify cmd-or-name))) (if (stringp (symbol-function cmd)) (execute-kbd-macro (symbol-function cmd)) (setq this-command cmd) (call-interactively cmd)))) ;;;###autoload (defun anything-c-set-variable (var) "Set value to VAR interactively." (interactive) (let ((sym (anything-c-symbolify var))) (set sym (eval-minibuffer (format "Set %s: " var) (prin1-to-string (symbol-value sym)))))) ;; (setq hh 12) ;; (anything-c-set-variable 'hh) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Persistent Action Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar anything-match-line-overlay-face nil) (defvar anything-match-line-overlay nil) (defun anything-match-line-color-current-line (&optional start end buf face rec) "Highlight and underline current position" (let ((args (list (or start (line-beginning-position)) (or end (1+ (line-end-position))) buf))) (if (not anything-match-line-overlay) (setq anything-match-line-overlay (apply 'make-overlay args)) (apply 'move-overlay anything-match-line-overlay args))) (overlay-put anything-match-line-overlay 'face (or face anything-match-line-overlay-face)) (when rec (goto-char start) (recenter))) (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line) (defface anything-overlay-line-face '((t (:background "IndianRed4" :underline t))) "Face for source header in the anything buffer." :group 'anything) (setq anything-match-line-overlay-face 'anything-overlay-line-face) (defun anything-match-line-cleanup () (when anything-match-line-overlay (delete-overlay anything-match-line-overlay) (setq anything-match-line-overlay nil))) (defun anything-match-line-update () (when anything-match-line-overlay (delete-overlay anything-match-line-overlay) (anything-match-line-color-current-line))) (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup) (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Actions 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 (member (file-name-extension candidate) '("el" "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 or URL. Else return ACTIONS unmodified." (let ((browse-action '("Browse with Browser" . browse-url))) (cond ((string-match "^http\\|^ftp" candidate) (cons browse-action actions)) ((string-match "\\.html?$" candidate) (append actions (list browse-action))) (t 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-soft candidate)) (append actions '(("Call Interactively" . anything-c-call-interactively))) 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Buffers (defun anything-c-skip-boring-buffers (buffers) (anything-c-skip-entries buffers anything-c-boring-buffer-regexp)) (defun anything-c-skip-current-buffer (buffers) (if anything-allow-skipping-current-buffer (remove (buffer-name anything-current-buffer) buffers) buffers)) (defun anything-c-shadow-boring-buffers (buffers) "Buffers matching `anything-c-boring-buffer-regexp' will be displayed with the `file-name-shadow' face if available." (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp)) ;;; Files (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." (anything-c-shadow-entries files anything-c-boring-file-regexp)) (defun anything-c-skip-boring-files (files) "Files matching `anything-c-boring-file-regexp' will be skipped." (anything-c-skip-entries files anything-c-boring-file-regexp)) ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge")) (defun anything-c-skip-current-file (files) "Current file will be skipped." (remove (buffer-file-name anything-current-buffer) 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 ~." (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows... (getenv "HOME")))) (mapcar (lambda (file) (if (and (stringp file) (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-soft function)) " (i)")) function) list) finally (return (nreverse list))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Adaptive Sorting of Candidates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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-source-use-adaptative-p (&optional source-name) "Return current source only if it use adaptative history, nil otherwise." (let* ((source (or source-name (anything-get-current-source))) (adapt-source (or (assoc-default 'filtered-candidate-transformer (assoc (assoc-default 'type source) anything-type-attributes)) (assoc-default 'candidate-transformer (assoc (assoc-default 'type source) anything-type-attributes)) (assoc-default 'filtered-candidate-transformer source) (assoc-default 'candidate-transformer source)))) (if (listp adapt-source) (when (member 'anything-c-adaptive-sort adapt-source) source) (when (eq adapt-source 'anything-c-adaptive-sort) source)))) (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-c-source-use-adaptative-p))) (when source (let* ((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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Outliner ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar anything-outline-goto-near-line-flag t) (defvar anything-outline-using nil) (defun anything-after-update-hook--outline () (if (and (eq anything-outline-using t) (eq anything-outline-goto-near-line-flag t)) (anything-outline-goto-near-line))) (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline) (defun anything-outline-goto-near-line () (with-anything-window ;; TODO need consideration whether to update position by every input. (when t ; (equal anything-pattern "") (anything-goto-line 2) (let ((lineno (with-current-buffer anything-current-buffer (line-number-at-pos (car anything-current-position))))) (block exit (while (<= (progn (skip-chars-forward " ") (or (number-at-point) lineno)) lineno) (forward-line 1) (when (eobp) (forward-line -1) (return-from exit)))) (forward-line -1) (and (bobp) (forward-line 1)) (and (anything-pos-header-line-p) (forward-line -2)) (anything-mark-current-line))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Plug-in ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Plug-in: info-index (defun* anything-c-info-init (&optional (file (anything-attr 'info-file))) (let (result) (unless (anything-candidate-buffer) (save-window-excursion (info file) (let (Info-history (tobuf (anything-candidate-buffer 'global)) (infobuf (current-buffer)) s e) (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes))) (Info-goto-node node) (goto-char (point-min)) (while (search-forward "\n* " nil t) (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t) '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result) (setq s (point-at-bol) e (point-at-eol)) (with-current-buffer tobuf (insert-buffer-substring infobuf s e) (insert "\n")))))))))) (defun anything-c-info-goto (node-line) (Info-goto-node (car node-line)) (anything-goto-line (cdr node-line))) (defun anything-c-info-display-to-real (line) (and (string-match "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line) (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line)) (string-to-number (or (match-string 3 line) "1"))))) (defun anything-c-make-info-source (file) `((name . ,(concat "Info Index: " file)) (info-file . ,file) (init . anything-c-info-init) (display-to-real . anything-c-info-display-to-real) (get-line . buffer-substring) (candidates-in-buffer) (action ("Goto node" . anything-c-info-goto)))) (defun anything-compile-source--info-index (source) (anything-aif (anything-interpret-value (assoc-default 'info-index source)) (anything-c-make-info-source it) source)) (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index) (anything-document-attribute 'info-index "info-index plugin" "Create a source of info index very easily. ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))") (anything-document-attribute 'index-nodes "info-index plugin (optional)" "Index nodes of info file. If it is omitted, `Info-index-nodes' is used to collect index nodes. Some info files are missing index specification. ex. See `anything-c-source-info-screen'.") ;; Plug-in: candidates-file (defun anything-compile-source--candidates-file (source) (if (assoc-default 'candidates-file source) `((init anything-p-candidats-file-init ,@(let ((orig-init (assoc-default 'init source))) (cond ((null orig-init) nil) ((functionp orig-init) (list orig-init)) (t orig-init)))) (candidates-in-buffer) ,@source) source)) (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file) (defun anything-p-candidats-file-init () (destructuring-bind (file &optional updating) (anything-mklist (anything-attr 'candidates-file)) (setq file (anything-interpret-value file)) (with-current-buffer (anything-candidate-buffer (find-file-noselect file)) (when updating (buffer-disable-undo) (font-lock-mode -1) (auto-revert-mode 1))))) (anything-document-attribute 'candidates-file "candidates-file plugin" "Use a file as the candidates buffer. 1st argument is a filename, string or function name or variable name. If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.") ;; Plug-in: headline (defun anything-compile-source--anything-headline (source) (if (assoc-default 'headline source) (append '((init . anything-headline-init) (get-line . buffer-substring) (type . line)) source '((candidates-in-buffer) (persistent-help . "Show this line"))) source)) (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline) (defun anything-headline-init () (when (and (anything-current-buffer-is-modified) (with-current-buffer anything-current-buffer (eval (or (anything-attr 'condition) t)))) (anything-headline-make-candidate-buffer (anything-interpret-value (anything-attr 'headline)) (anything-interpret-value (anything-attr 'subexp))))) (anything-document-attribute 'headline "Headline plug-in" "Regexp string for anything-headline to scan.") (anything-document-attribute 'condition "Headline plug-in" "A sexp representing the condition to use anything-headline.") (anything-document-attribute 'subexp "Headline plug-in" "Display (match-string-no-properties subexp).") (defun anything-headline-get-candidates (regexp subexp) (with-current-buffer anything-current-buffer (save-excursion (goto-char (point-min)) (if (functionp regexp) (setq regexp (funcall regexp))) (let (hierarchy curhead) (flet ((matched () (if (numberp subexp) (cons (match-string-no-properties subexp) (match-beginning subexp)) (cons (buffer-substring (point-at-bol) (point-at-eol)) (point-at-bol)))) (hierarchies (headlines) (1+ (loop for (_ . hierarchy) in headlines maximize hierarchy))) (vector-0-n (v n) (loop for i from 0 to hierarchy collecting (aref curhead i))) (arrange (headlines) (unless (null headlines) ; FIX headlines empty bug! (loop with curhead = (make-vector (hierarchies headlines) "") for ((str . pt) . hierarchy) in headlines do (aset curhead hierarchy str) collecting (cons (format "H%d:%s" (1+ hierarchy) (mapconcat 'identity (vector-0-n curhead hierarchy) " / ")) pt))))) (if (listp regexp) (arrange (sort (loop for re in regexp for hierarchy from 0 do (goto-char (point-min)) appending (loop while (re-search-forward re nil t) collect (cons (matched) hierarchy))) (lambda (a b) (> (cdar b) (cdar a))))) (loop while (re-search-forward regexp nil t) collect (matched)))))))) (defun anything-headline-make-candidate-buffer (regexp subexp) (with-current-buffer (anything-candidate-buffer 'local) (loop for (content . pos) in (anything-headline-get-candidates regexp subexp) do (insert (format "%5d:%s\n" (with-current-buffer anything-current-buffer (line-number-at-pos pos)) content))))) (defun anything-headline-goto-position (pos recenter) (goto-char pos) (unless recenter (set-window-start (get-buffer-window anything-current-buffer) (point)))) (defun anything-revert-buffer (candidate) (with-current-buffer candidate (when (buffer-modified-p) (revert-buffer t t)))) (defun anything-revert-marked-buffers (ignore) (mapc 'anything-revert-buffer (anything-marked-candidates))) (defun anything-kill-marked-buffers (ignore) (mapc 'kill-buffer (anything-marked-candidates))) ;; Plug-in: persistent-help (defun anything-compile-source--persistent-help (source) (append source '((header-line . anything-persistent-help-string)))) (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help) (defun anything-persistent-help-string () (substitute-command-keys (concat "\\\\[anything-execute-persistent-action]: " (or (anything-interpret-value (anything-attr 'persistent-help)) (anything-aif (or (assoc-default 'persistent-action (anything-get-current-source)) (assoc-default 'action (anything-get-current-source))) (cond ((symbolp it) (symbol-name it)) ((listp it) (or (ignore-errors (caar it)) "")))) "") " (keeping session)"))) (anything-document-attribute 'persistent-help "persistent-help plug-in" "A string to explain persistent-action of this source. It also accepts a function or a variable name.") ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST")))) ;; Plug-in: Type customize (defun anything-c-uniq-list (lst) "Like `remove-duplicates' in CL. But cut deeper duplicates and test by `equal'. " (reverse (remove-duplicates (reverse lst) :test 'equal))) (defvar anything-additional-type-attributes nil) (defun anything-c-arrange-type-attribute (type spec) "Override type attributes by `define-anything-type-attribute'. The SPEC is like source. The symbol `REST' is replaced with original attribute value. Example: Set `play-sound-file' as default action (anything-c-arrange-type-attribute 'file '((action (\"Play sound\" . play-sound-file) REST ;; Rest of actions (find-file, find-file-other-window, ...) ))) " (add-to-list 'anything-additional-type-attributes (cons type (loop with typeattr = (assoc-default type anything-type-attributes) for (attr . value) in spec if (listp value) collect (cons attr (anything-c-uniq-list (loop for v in value if (eq v 'REST) append (assoc-default attr typeattr) else collect v))) else collect (cons attr value))))) (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1) (defun anything-compile-source--type-customize (source) (anything-aif (assoc-default (assoc-default 'type source) anything-additional-type-attributes) (append it source) source)) (add-to-list 'anything-compile-source-functions 'anything-compile-source--type-customize t) ;; Plug-in: default-action (defun anything-compile-source--default-action (source) (anything-aif (assoc-default 'default-action source) (append `((action ,it ,@(remove it (assoc-default 'action source)))) source) source)) (add-to-list 'anything-compile-source-functions 'anything-compile-source--default-action t) (anything-document-attribute 'default-action "default-action plug-in" "Default action.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun anything-c-find-file-or-marked (candidate) "Open file CANDIDATE or open anything marked files in background." (let ((marked (anything-marked-candidates))) (if (> (length marked) 1) (mapc 'find-file-noselect marked) (find-file-at-point candidate)))) ;; FIXME there is a bug in dired that confuse all dired commands ;; when using this feature, so i suspend it until bug is fixed in emacs. ;; ;; (defun anything-c-create-dired-on-marked (candidate) ;; "Create a new dired buffer with only marked candidates." ;; (let ((marked (anything-marked-candidates)) ;; (buffer-name (read-string "New Dired Buffer: "))) ;; (dired (cons buffer-name marked)))) (defun anything-delete-marked-files (ignore) (let* ((files (anything-marked-candidates)) (len (length files))) (if (not (y-or-n-p (format "Delete *%s File(s):\n%s" len (mapconcat (lambda (f) (format "- %s\n" f)) files "")))) (message "(No deletions performed)") (dolist (i files) (set-text-properties 0 (length i) nil i) (anything-c-delete-file i)) (message "%s File(s) deleted" len)))) (defun anything-ediff-marked-buffers (candidate &optional merge) "Ediff 2 marked buffers or 1 marked buffer and current-buffer. With optional arg `merge' call `ediff-merge-buffers'." (let ((lg-lst (length (anything-marked-candidates))) buf1 buf2) (case lg-lst (0 (error "Error:You have to mark at least 1 buffer")) (1 (setq buf1 anything-current-buffer buf2 (first (anything-marked-candidates)))) (2 (setq buf1 (first (anything-marked-candidates)) buf2 (second (anything-marked-candidates)))) (t (error "Error:To much buffers marked!"))) (if merge (ediff-merge-buffers buf1 buf2) (ediff-buffers buf1 buf2)))) (defun anything-bookmark-get-bookmark-from-name (bmk) "Return bookmark name even if it is a bookmark with annotation. e.g prepended with *. Return nil if bmk is not a valid bookmark." (let ((bookmark (replace-regexp-in-string "\*" "" bmk))) (if (assoc bookmark bookmark-alist) bookmark (when (assoc bmk bookmark-alist) bmk)))) (defun anything-delete-marked-bookmarks (ignore) "Delete this bookmark or all marked bookmarks." (dolist (i (anything-marked-candidates)) (bookmark-delete (anything-bookmark-get-bookmark-from-name i) 'batch))) (defun anything-require-or-error (feature function) (or (require feature nil t) (error "Need %s to use `%s'." feature function))) (defun anything-find-buffer-on-elscreen (candidate) "Open buffer in new screen, if marked buffers open all in elscreens." (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen) (anything-aif (anything-marked-candidates) (dolist (i it) (let ((target-screen (elscreen-find-screen-by-buffer (get-buffer i) 'create))) (elscreen-goto target-screen))) (let ((target-screen (elscreen-find-screen-by-buffer (get-buffer candidate) 'create))) (elscreen-goto target-screen)))) (defun anything-elscreen-find-file (file) (anything-require-or-error 'elscreen 'anything-elscreen-find-file) (elscreen-find-file file)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Setup ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Type Attributes (define-anything-type-attribute '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))) ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen)) ("View buffer" . view-buffer) ("Display buffer" . display-buffer) ("Revert buffer" . anything-revert-buffer) ("Revert Marked buffers" . anything-revert-marked-buffers) ("Insert buffer" . insert-buffer) ("Kill buffer" . kill-buffer) ("Kill Marked buffers" . anything-kill-marked-buffers) ("Diff with file" . diff-buffer-with-file) ("Ediff Marked buffers" . anything-ediff-marked-buffers) ("Ediff Merge marked buffers" . (lambda (candidate) (anything-ediff-marked-buffers candidate t)))) (persistent-help . "Show this buffer") (candidate-transformer anything-c-skip-current-buffer anything-c-skip-boring-buffers)) "Buffer or buffer name.") (define-anything-type-attribute 'file `((action ,@(if pop-up-frames '(("Find file other window" . find-file-other-window) ("Find file(s)" . anything-find-many-files) ("Find file as root" . anything-find-file-as-root)) '(("Find file" . anything-find-many-files) ("Find file as root" . anything-find-file-as-root) ("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) ("View file" . view-file) ("Insert file" . insert-file) ("Delete file(s)" . anything-delete-marked-files) ("Open file externally" . anything-c-open-file-externally) ("Open file with default tool" . anything-c-open-file-with-default-tool) ("Find file in hex dump" . hexl-find-file)) (persistent-help . "Show this file") (action-transformer anything-c-transform-file-load-el anything-c-transform-file-browse-url) (candidate-transformer anything-c-w32-pathname-transformer anything-c-skip-current-file anything-c-skip-boring-files anything-c-shorten-home-path)) "File name.") (let ((actions '(("Describe command" . describe-function) ("Add command to kill ring" . anything-c-kill-new) ("Go to command's definition" . find-function) ("Debug on entry" . debug-on-entry) ("Cancel debug on entry" . cancel-debug-on-entry) ("Trace function" . trace-function) ("Trace function (background)" . trace-function-background) ("Untrace function" . untrace-function)))) (define-anything-type-attribute 'command `((action ("Call interactively" . anything-c-call-interactively) ,@actions) ;; Sort commands according to their usage count. (filtered-candidate-transformer . anything-c-adaptive-sort) (coerce . anything-c-symbolify) (persistent-action . describe-function)) "Command. (string or symbol)") (define-anything-type-attribute 'function `((action . ,actions) (action-transformer anything-c-transform-function-call-interactively) (candidate-transformer anything-c-mark-interactive-functions) (coerce . anything-c-symbolify)) "Function. (string or symbol)")) (define-anything-type-attribute 'variable '((action ("Describe variable" . describe-variable) ("Add variable to kill ring" . anything-c-kill-new) ("Go to variable's definition" . find-variable) ("Set variable" . anything-c-set-variable)) (coerce . anything-c-symbolify)) "Variable.") (define-anything-type-attribute 'sexp '((action ("Eval s-expression" . (lambda (c) (eval (read c)))) ("Add s-expression to kill ring" . kill-new)) (action-transformer anything-c-transform-sexp-eval-command-sexp)) "String representing S-Expressions.") (define-anything-type-attribute 'bookmark `((coerce . anything-bookmark-get-bookmark-from-name) (action ("Jump to bookmark" . (lambda (bookmark) (let ((current-prefix-arg anything-current-prefix-arg)) (bookmark-jump bookmark)) (anything-update))) ("Jump to BM other window" . (lambda (bookmark) (bookmark-jump-other-window bookmark) (anything-update))) ("Bookmark edit annotation" . bookmark-edit-annotation) ("Bookmark show annotation" . bookmark-show-annotation) ("Delete bookmark(s)" . anything-delete-marked-bookmarks) ,@(when (fboundp 'bmkext-edit-bookmark) '(("Edit Bookmark" . bmkext-edit-bookmark))) ("Rename bookmark" . bookmark-rename) ("Relocate bookmark" . bookmark-relocate))) "Bookmark name.") (define-anything-type-attribute 'line '((display-to-real . anything-c-display-to-real-line) (action ("Go to Line" . anything-c-action-line-goto))) "LINENO:CONTENT string, eg. \" 16:foo\". Optional `target-file' attribute is a name of target file. Optional `before-jump-hook' attribute is a function with no arguments which is called before jumping to position. Optional `after-jump-hook' attribute is a function with no arguments which is called after jumping to position. If `adjust' attribute is specified, searches the line whose content is CONTENT near the LINENO. If `recenter' attribute is specified, the line is displayed at the center of window, otherwise at the top of window. ") (define-anything-type-attribute 'file-line `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line) (multiline) (action ("Go to" . anything-c-action-file-line-goto))) "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\". Optional `default-directory' attribute is a default-directory FILENAME is interpreted. Optional `before-jump-hook' attribute is a function with no arguments which is called before jumping to position. Optional `after-jump-hook' attribute is a function with no arguments which is called after jumping to position. If `adjust' attribute is specified, searches the line whose content is CONTENT near the LINENO. If `recenter' attribute is specified, the line is displayed at the center of window, otherwise at the top of window. ") (define-anything-type-attribute 'timer '((real-to-display . anything-c-timer-real-to-display) (action ("Cancel Timer" . cancel-timer) ("Describe Function" . (lambda (tm) (describe-function (timer--function tm)))) ("Find Function" . (lambda (tm) (find-function (timer--function tm))))) (persistent-action . (lambda (tm) (describe-function (timer--function tm)))) (persistent-help . "Describe Function")) "Timer.") ;;;; Default `anything-sources' ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies ;; tend to invoke M-x anything directly. So I offer default setting. (setq anything-sources '(anything-c-source-buffers+ anything-c-source-recentf anything-c-source-files-in-current-dir+)) ;;;; 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 "candidates-file plug-in") (expect '(anything-p-candidats-file-init) (assoc-default 'init (car (anything-compile-sources '(((name . "test") (candidates-file . "test.txt"))) '(anything-compile-source--candidates-file))))) (expect '(anything-p-candidats-file-init (lambda () 1)) (assoc-default 'init (car (anything-compile-sources '(((name . "test") (candidates-file . "test.txt") (init . (lambda () 1)))) '(anything-compile-source--candidates-file))))) (expect '(anything-p-candidats-file-init (lambda () 1)) (assoc-default 'init (car (anything-compile-sources '(((name . "test") (candidates-file . "test.txt") (init (lambda () 1)))) '(anything-compile-source--candidates-file))))) ;; FIXME error ;; (desc "anything-c-source-buffers") ;; (expect '(("Buffers" ("foo" "curbuf"))) ;; (stub buffer-list => '("curbuf" " hidden" "foo" "*anything*")) ;; (let ((anything-c-boring-buffer-regexp ;; (rx (or ;; (group bos " ") ;; "*anything" ;; ;; echo area ;; " *Echo Area" " *Minibuf")))) ;; (flet ((buffer-name (&optional x) x)) ;; (anything-test-candidates 'anything-c-source-buffers)))) (desc "anything-c-stringify") (expect "str1" (anything-c-stringify "str1")) (expect "str2" (anything-c-stringify 'str2)) (desc "anything-c-symbolify") (expect 'sym1 (anything-c-symbolify "sym1")) (expect 'sym2 (anything-c-symbolify 'sym2)) (desc "plug-in:default-action") (expect '(((action ("default" . default) ("original" . original)) (default-action . ("default" . default)) (action ("original" . original)))) (anything-compile-sources '(((default-action . ("default" . default)) (action ("original" . original)))) '(anything-compile-source--default-action))) (expect '(((action ("a1" . a1) ("a2" . a2)) (default-action . ("a1" . a1)) (action ("a1" . a1) ("a2" . a2)))) (anything-compile-sources '(((default-action . ("a1" . a1)) (action ("a1" . a1) ("a2" . a2)))) '(anything-compile-source--default-action))) (expect '(((action ("a2" . a2) ("a1" . a1)) (default-action . ("a2" . a2)) (action ("a1" . a1) ("a2" . a2)))) (anything-compile-sources '(((default-action . ("a2" . a2)) (action ("a1" . a1) ("a2" . a2)))) '(anything-compile-source--default-action)))))) (provide 'anything-config) ;;; Local Variables: ;;; time-stamp-format: "%:y-%02m-%02d %02H:%02M:%02S (%Z) %u" ;;; End: ;; How to save (DO NOT REMOVE!!) ;; (progn (magit-push) (emacswiki-post "anything-config.el")) ;;; anything-config.el ends here ;;; LocalWords: Tassilo Patrovics Vagn Johansen Dahl Clementson infos ;;; LocalWords: Kamphausen informations McBrayer Volpiatto bbdb bb ;;; LocalWords: iswitchb imenu Recentf sym samewindow pos bol eol ;;; LocalWords: aif str lst func attrib recentf lessp prin mapatoms commandp ;;; LocalWords: cmd stb Picklist picklist mapcan subentry destructuring dirs ;;; LocalWords: darwin locat MacOS mdfind Firstname Lastname calc prepend jids ;;; LocalWords: dotimes Thierry online vname ;;; LocalWords: csharp javascript lua makefile cperl zcat lineno buf ;;; LocalWords: multiline href fn cand NewTitle cwd filepath thru ret ;;; LocalWords: bfn fOpen UNC cygdrive nt xdg macos FILE's elc rx svn hg ;;; LocalWords: CANDIDATE's darcs facep pathname args pathnames subseq priorty ;;; LocalWords: Vokes rfind berkeley JST ffap lacarte bos ;;; LocalWords: Lacarte Minibuf epp LaCarte bm attrset migemo attr conf mklist ;;; LocalWords: startpos noselect dont desc anything-el-1.287/anything-auto-install.el0000644000175000017500000001605511447253044020050 0ustar takayatakaya;;; anything-auto-install.el --- Integrate auto-install.el with anything.el ;; Filename: anything-auto-install.el ;; Description: Integrate auto-install.el with anything.el ;; Author: Andy Stewart ;; Maintainer: Andy Stewart ;; Copyright (C) 2009, Andy Stewart, all rights reserved. ;; Copyright (C) 2010, rubikitch, all rights reserved. ;; Created: 2009-02-09 17:48:01 ;; Version: 0.2.3 ;; Last-Updated: [2010/03/29 18:08] ;; By: rubikitch ;; URL: http://www.emacswiki.org/emacs/download/anything-auto-install.el ;; Keywords: auto-install, anything ;; Compatibility: GNU Emacs 23.0.60.1 ;; ;; Features that might be required by this library: ;; ;; `auto-install' `anything' ;; ;;; This file is NOT part of GNU Emacs ;;; License ;; ;; 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, 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; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth ;; Floor, Boston, MA 02110-1301, USA. ;;; Commentary: ;; ;; Integrate auto-install.el with anything.el. ;; ;; You can use command `anything-auto-install-from-emacswiki' ;; install package from EmacsWiki.org. ;; ;; You can use comamnd `anything-auto-install-from-library' ;; update library. ;; ;; You can also make this package integrate with `anything', ;; just setup like below: ;; ;; (setq anythign-sources ;; (list ;; anything-c-source-auto-install-from-emacswiki ;; anything-c-source-auto-install-from-library ;; )) ;; ;;; Commands: ;; ;; Below are complete command list: ;; ;; `anything-auto-install-from-emacswiki' ;; Launch anything with auto-install separately. ;; `anything-auto-install-from-library' ;; Update library with `anything'. ;; `anything-auto-install-batch' ;; Batch install elisp libraries. ;; `anything-auto-install' ;; All-in-one command for elisp installation. ;; ;;; Customizable Options: ;; ;; Below are customizable option list: ;; ;;; Installation: ;; ;; Put anything-auto-install.el to your load-path. ;; The load-path is usually ~/elisp/. ;; It's set in your ~/.emacs like this: ;; (add-to-list 'load-path (expand-file-name "~/elisp")) ;; ;; And the following to your ~/.emacs startup file. ;; ;; (require 'anything-auto-install) ;; ;; And this package need `auto-install' and `anything', ;; make sure you have add package `auto-install' `auto-install' ;; in your load-path. ;; ;;; Customize: ;; ;; ;; ;; All of the above can customize by: ;; M-x customize-group RET anything-auto-install RET ;; ;;; Change log: ;; ;; 2009/05/30 ;; * All-in-one install command `anything-auto-install'. ;; ;; 2009/05/27 ;; * Support batch install. ;; ;; 2009/02/17 ;; * Clean up. ;; ;; 2009/02/12 ;; * Add `anything-c-source-auto-install-from-library' ;; * Add new command `anything-auto-install-from-library'. ;; ;; 2009/02/09 ;; * First released. ;; ;;; Acknowledgements: ;; ;; ;; ;;; TODO ;; ;; ;; ;;; Require (require 'anything) (require 'auto-install) ;;; Code: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Variable ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar anything-c-source-auto-install-from-emacswiki '((name . "Auto Install from EmacsWiki") (candidates . (lambda () (auto-install-update-emacswiki-package-name t) auto-install-package-name-list)) (action . (("Install from EmacsWiki.org" . (lambda (candidate) (auto-install-download (concat auto-install-emacswiki-base-url candidate)))) ("Update package name from EmacsWiki.org" . (lambda (candidate) (auto-install-update-emacswiki-package-name))))))) (defvar anything-c-source-auto-install-from-library '((name . "Auto Install from Library") (init . (anything-auto-install-init)) (candidates-in-buffer) (action . (("Update library" . (lambda (candidate) (auto-install-from-library candidate))))))) (defvar anything-c-source-auto-install-batch '((name . "Auto Install Batch") (candidates . (lambda () (mapcar 'car auto-install-batch-list))) (action . (("Batch Install Emacs Extension" . (lambda (candidate) (auto-install-batch candidate))))))) (defvar anything-c-source-auto-install-from-url '((name . "Auto Install from URL") (dummy) (action . (("Install from URL" . (lambda (candidate) (auto-install-from-url candidate))))))) (defvar anything-c-source-auto-install-from-gist '((name . "Auto Install from Gist") (dummy) (action . (("Install from Gist" . (lambda (candidate) (auto-install-from-gist candidate))))))) (defvar anything-auto-install-buffer "*anything auto install*") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Interactive Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun anything-auto-install-from-emacswiki (&optional file) "Launch anything with auto-install separately." (interactive) (if file (auto-install-from-emacswiki file) (anything 'anything-c-source-auto-install-from-emacswiki nil nil nil nil anything-auto-install-buffer))) (defun anything-auto-install-from-library () "Update library with `anything'." (interactive) (anything 'anything-c-source-auto-install-from-library nil nil nil nil anything-auto-install-buffer)) (defun anything-auto-install-batch () "Batch install elisp libraries." (interactive) (anything `anything-c-source-auto-install-batch nil nil nil nil anything-auto-install-buffer)) (defun anything-auto-install () "All-in-one command for elisp installation." (interactive) (anything '(anything-c-source-auto-install-batch anything-c-source-auto-install-from-emacswiki anything-c-source-auto-install-from-library anything-c-source-auto-install-from-url anything-c-source-auto-install-from-gist) nil nil nil nil anything-auto-install-buffer)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Uilties Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun anything-auto-install-init () "Init anything buffer status." (let ((anything-buffer (anything-candidate-buffer 'global)) (library-list (auto-install-get-library-list))) (with-current-buffer anything-buffer ;; Insert library. (dolist (library library-list) (insert (format "%s\n" library))) ;; Sort lines. (sort-lines nil (point-min) (point-max))))) (provide 'anything-auto-install) ;;; anything-auto-install.el ends here anything-el-1.287/anything-ipa.el0000644000175000017500000000766711447253044016216 0ustar takayatakaya;;; anything-ipa.el --- Anything interface of In Place Annotation ;; $Id: anything-ipa.el,v 1.6 2009/03/01 22:52:44 rubikitch Exp $ ;; Copyright (C) 2009 rubikitch ;; Author: rubikitch ;; Keywords: convenience, anything ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything-ipa.el ;; 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: ;; Anything interface of in place annotations. ;; Variable `anything-c-source-ipa' is source for in place annotations ;; in current buffer. And command `anything-ipa' is anything menu of ;; it. `anything-c-source-ipa-global' and `anything-ipa-global' are ;; global ones. ;;; Installation: ;; Get ipa.el and anything.el from EmacsWiki ;; http://www.emacswiki.org/cgi-bin/wiki/download/ipa.el ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything.el ;; ;; Then add the code below in your ~/.emacs. ;; (require 'anything-ipa) ;; ;;; History: ;; $Log: anything-ipa.el,v $ ;; Revision 1.6 2009/03/01 22:52:44 rubikitch ;; Use `ipa-annotation-face' for annotation text ;; ;; Revision 1.5 2009/02/13 01:18:32 rubikitch ;; migemize ;; ;; Revision 1.4 2009/02/13 00:49:36 rubikitch ;; *** empty log message *** ;; ;; Revision 1.3 2009/02/13 00:48:08 rubikitch ;; `anything-c-source-ipa': format change ;; ;; Revision 1.2 2009/02/13 00:46:16 rubikitch ;; New variable: `anything-c-source-ipa-global' ;; New command: `anything-ipa-global' ;; ;; Revision 1.1 2009/02/13 00:20:05 rubikitch ;; Initial revision ;; ;;; Code: (defvar anything-ipa-version "$Id: anything-ipa.el,v 1.6 2009/03/01 22:52:44 rubikitch Exp $") (eval-when-compile (require 'cl)) (require 'anything) (require 'ipa) ;;;; file-local source (defvar anything-c-source-ipa '((name . "In Place Annotations (Current Buffer)") (candidates . anything-ipa-candidates) (action . goto-char) (migemo)) "`anything' source of ipa in current-buffer.") (defun anything-ipa-candidates () (save-excursion (set-buffer anything-current-buffer) (loop for (overlay . text) in ipa-annotations-in-buffer for pos = (overlay-start overlay) for line = (progn (goto-char pos) (buffer-substring (point-at-bol) (point-at-eol))) for lineno = (line-number-at-pos pos) collect (cons (format "%5d:[%s]%s" lineno (propertize text 'face ipa-annotation-face) line) pos)))) (defun anything-ipa () "`anything' interface of ipa." (interactive) (anything 'anything-c-source-ipa)) ;;;; global source (defvar anything-c-source-ipa-global '((name . "In Place Annotations (global)") (init . (lambda () (anything-candidate-buffer (ipa-find-storage-file)))) (get-line . (lambda (s e) (unless (= s e) (cons (buffer-substring s e) s)))) (candidates-in-buffer) (migemo) (action ("Go To" . anything-ipa-go-to-annotation))) "`anything' source of all IPAs.") (defun anything-ipa-go-to-annotation (pos) (with-current-buffer (ipa-find-storage-file) (goto-char pos) (ipa-go-to-annotation))) (defun anything-ipa-global () "`anything' interface of ipa (global)." (interactive) (anything 'anything-c-source-ipa-global)) (provide 'anything-ipa) ;; How to save (DO NOT REMOVE!!) ;; (emacswiki-post "anything-ipa.el") ;;; anything-ipa.el ends here anything-el-1.287/anything.el0000644000175000017500000074726711447253044015456 0ustar takayatakaya;;;; anything.el --- open anything / QuickSilver-like candidate-selection framework ;; Copyright (C) 2007 Tamas Patrovics ;; 2008, 2009, 2010 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 (defvar anything-version nil) (setq anything-version "1.287") ;; 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/C-p/C-n/C-v/M-v, 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 ;; ;; Here is Japanese translation of `anything-sources' attributes. Thanks. ;; http://d.hatena.ne.jp/sirocco634/20091012/1255336649 ;;; Bug Report: ;; ;; If you have problems, send a bug report via C-c C-x C-b in anything session (best) ;; or M-x anything-send-bug-report outside anything session. ;; I implemented bug report feature because I want to know your current state. ;; It helps me to solve problems easily. ;; The step is: ;; 0) Setup mail in Emacs, the easiest way is: ;; (setq user-mail-address "your@mail.address") ;; (setq user-full-name "Your Full Name") ;; (setq smtpmail-smtp-server "your.smtp.server.jp") ;; (setq mail-user-agent 'message-user-agent) ;; (setq message-send-mail-function 'message-smtpmail-send-it) ;; 1) Be sure to use the LATEST version of anything.el. ;; 2) Enable debugger. M-x toggle-debug-on-error or (setq debug-on-error t) ;; 3) Use Lisp version instead of compiled one: (load "anything.el") ;; 4) Do it! ;; 5) If you got an error, please do not close *Backtrace* buffer. ;; 6) Type C-c C-x C-b (anything session, best!) ;; or M-x anything-send-bug-report (outside) ;; then M-x insert-buffer *Backtrace* (if you got error) ;; 7) Describe the bug using a precise recipe. ;; 8) Type C-c C-c to send. ;; # If you are a Japanese, please write in Japanese:-) ;;; Commands: ;; ;; Below are complete command list: ;; ;; `anything-open-last-log' ;; Open anything log file of last anything session. ;; `anything' ;; Select anything. In Lisp program, some optional arguments can be used. ;; `anything-resume' ;; Resurrect previously invoked `anything'. ;; `anything-at-point' ;; Same as `anything' except when C-u is pressed, the initial input is the symbol at point. ;; `anything-force-update' ;; Recalculate and update candidates. ;; `anything-select-action' ;; Select an action for the currently selected candidate. ;; `anything-previous-line' ;; Move selection to the previous line. ;; `anything-next-line' ;; Move selection to the next line. ;; `anything-previous-page' ;; Move selection back with a pageful. ;; `anything-next-page' ;; Move selection forward with a pageful. ;; `anything-beginning-of-buffer' ;; Move selection at the top. ;; `anything-end-of-buffer' ;; Move selection at the bottom. ;; `anything-previous-source' ;; Move selection to the previous source. ;; `anything-next-source' ;; Move selection to the next source. ;; `anything-select-with-prefix-shortcut' ;; Invoke default action with prefix shortcut. ;; `anything-select-with-digit-shortcut' ;; Invoke default action with digit/alphabet shortcut. ;; `anything-exit-minibuffer' ;; Select the current candidate by exiting the minibuffer. ;; `anything-help' ;; Help of `anything'. ;; `anything-debug-output' ;; Show all anything-related variables at this time. ;; `anything-delete-current-selection' ;; Delete the currently selected item. ;; `anything-delete-minibuffer-contents' ;; Same as `delete-minibuffer-contents' but this is a command. ;; `anything-toggle-resplit-window' ;; Toggle resplit anything window, vertically or horizontally. ;; `anything-select-2nd-action' ;; Select the 2nd action for the currently selected candidate. ;; `anything-select-3rd-action' ;; Select the 3rd action for the currently selected candidate. ;; `anything-select-4th-action' ;; Select the 4th action for the currently selected candidate. ;; `anything-select-2nd-action-or-end-of-line' ;; Select the 2nd action for the currently selected candidate if the point is at the end of minibuffer. ;; `anything-execute-persistent-action' ;; If a candidate is selected then perform the associated action without quitting anything. ;; `anything-scroll-other-window' ;; Scroll other window (not *Anything* window) upward. ;; `anything-scroll-other-window-down' ;; Scroll other window (not *Anything* window) downward. ;; `anything-toggle-visible-mark' ;; Toggle anything visible bookmark at point. ;; `anything-display-all-visible-marks' ;; Show all `anything' visible marks strings. ;; `anything-next-visible-mark' ;; Move next anything visible mark. ;; `anything-prev-visible-mark' ;; Move previous anything visible mark. ;; `anything-quit-and-find-file' ;; Drop into `find-file' from `anything' like `iswitchb-find-file'. ;; `anything-yank-selection' ;; Set minibuffer contents to current selection. ;; `anything-kill-selection-and-quit' ;; Store current selection to kill ring. ;; `anything-follow-mode' ;; If this mode is on, persistent action is executed everytime the cursor is moved. ;; `anything-migrate-sources' ;; Help to migrate to new `anything' way. ;; `anything-isearch' ;; Start incremental search within results. (UNMAINTAINED) ;; `anything-isearch-printing-char' ;; Add printing char to the pattern. ;; `anything-isearch-again' ;; Search again for the current pattern ;; `anything-isearch-delete' ;; Undo last event. ;; `anything-isearch-default-action' ;; Execute the default action for the selected candidate. ;; `anything-isearch-select-action' ;; Choose an action for the selected candidate. ;; `anything-isearch-cancel' ;; Cancel Anything isearch. ;; `anything-iswitchb-setup' ;; Integrate anything completion into iswitchb (UNMAINTAINED). ;; `anything-iswitchb-cancel-anything' ;; Cancel anything completion and return to standard iswitchb. ;; `anything-describe-anything-attribute' ;; Display the full documentation of ANYTHING-ATTRIBUTE (a symbol). ;; `anything-send-bug-report' ;; Send a bug report of anything.el. ;; `anything-send-bug-report-from-anything' ;; Send a bug report of anything.el in anything session. ;; ;;; Customizable Options: ;; ;; Below are customizable option list: ;; ;; 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/23. ;; ;; ;; 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.277 ;; ;; Default setting of `anything-save-configuration-functions' is changed. ;; Anything saves/restores window configuration instead of frame configuration now. ;; The default is changed because flickering is occurred in some environment. ;; ;; If you want to save and restore frame configuration, set this variable to ;; '(set-frame-configuration . current-frame-configuration) ;; ;; v1.276 ;; ;; Fitting frame is disabled by default, because some flickering occurred ;; in some environment. To enable fitting, set both ;; `anything-inhibit-fit-frame-flag' and `fit-frame-inhibit-fitting' to ;; nil. ;; ;; 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") ;; ;; `anything' accepts keyword arguments. See docstring. ;; [EVAL IT] (describe-function 'anything) ;; ;; `anything-enable-shortcuts' enables us to select candidate easily. ;; If 'prefix then they can be selected using . ;; The prefix key is `anything-select-with-prefix-shortcut'. ;; If the is a letter, pressing twice inputs the letter itself. ;; e.g. ;; (setq anything-enable-shortcuts 'prefix) ;; (define-key anything-map \"@\" 'anything-select-with-prefix-shortcut) ;; ;; You can edit current selection using `anything-edit-current-selection'. ;; It is useful after persistent-action. ;; ;; For `anything' users, setting `anything-sources' directly and ;; invoke M-x anything is obsolete way for now. Try M-x ;; `anything-migrate-sources'! ;; ;; If you want to create anything sources, yasnippet would help you. ;; http://yasnippet.googlecode.com/ ;; ;; Then get the snippet from ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything-source.yasnippet ;; ;; Put it in ~/.emacs.d/plugins/yasnippet/snippets/text-mode/emacs-lisp-mode/ ;; ;; `anything-interpret-value' is useful function to interpret value ;; like `candidates' attribute. ;; ;; (anything-interpret-value "literal") ; => "literal" ;; (anything-interpret-value (lambda () "lambda")) ; => "lambda" ;; (let ((source '((name . "lambda with source name")))) ;; (anything-interpret-value ;; (lambda () anything-source-name) ;; source)) ; => "lambda with source name" ;; (flet ((f () "function symbol")) ;; (anything-interpret-value 'f)) ; => "function symbol" ;; (let ((v "variable symbol")) ;; (anything-interpret-value 'v)) ; => "variable symbol" ;; (anything-interpret-value 'unbounded-1) ; error ;; ;; Now symbols are acceptable as candidates. So you do not have to use ;; `symbol-name' function. The source is much simpler. For example, ;; `apropos-internal' returns a list of symbols. ;; ;; (anything ;; '(((name . "Commands") ;; (candidates . (lambda () (apropos-internal anything-pattern 'commandp))) ;; (volatile) ;; (action . describe-function)))) ;; ;; To mark a candidate, press C-SPC as normal Emacs marking. To go to ;; marked candidate, press M-[ or M-]. ;; ;; `anything-map' is now Emacs-standard key bindings by default. If ;; you are using `iswitchb', execute `anything-iswitchb-setup'. Then ;; some key bindings are adjusted to `iswitchb'. Note that ;; anything-iswitchb is not maintained. ;; ;; There are many `anything' applications, using `anything' for ;; selecting candidate. In this case, if there is one candidate or no ;; candidate, popping up *anything* buffer is irritating. If one ;; candidate, you want to select it at once. If no candidate, you want ;; to quit `anything'. Set `anything-execute-action-at-once-if-one' ;; and `anything-quit-if-no-candidate' to non-nil to remedy it. Note ;; that setting these variables GLOBALLY is bad idea because of ;; delayed sources. These are meant to be let-binded. ;; See anything-etags.el for example. ;; ;; [EVAL IT] (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/anything-etags.el") ;; ;; ex. ;; (let ((anything-execute-action-at-once-if-one t) ;; (anything-quit-if-no-candidate (lambda () (message "No candidate")))) ;; (anything temporary-sources input)) ;; ;; `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 ;; ;; If you want to create anything sources, see anything-config.el. ;; It is huge collection of sources. You can learn from examples. ;; (@* "TODO") ;; ;; - process status indication ;; ;; - async sources doesn't honor digit-shortcut-count ;; ;; - anything-candidate-number-limit can't be nil everywhere ;; (@* "HISTORY") ;; ;; Change log of this file is found at ;; http://repo.or.cz/w/anything-config.git/history/master:/anything.el ;; ;; Change log of this project is found at ;; http://repo.or.cz/w/anything-config.git?a=shortlog (require 'cl) ;; (require 'anything-match-plugin nil t) ;; (@* "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 . "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'. You are STRONGLY recommended to define a command which calls `anything' or `anything-other-buffer' with argument rather than to set `anything-sources' externally. If you want to change `anything-sources' during `anything' invocation, use `anything-set-sources', never use `setq'. Attributes: ") ;; 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.") (defvaralias 'anything-enable-digit-shortcuts 'anything-enable-shortcuts "Alphabet shortcuts are usable now. Then `anything-enable-digit-shortcuts' should be renamed. `anything-enable-digit-shortcuts' is retained for compatibility.") (defvar anything-enable-shortcuts nil "*Whether to use digit/alphabet shortcut to select the first nine matches. If t then they can be selected using Ctrl+. If 'prefix then they can be selected using . The prefix key is `anything-select-with-prefix-shortcut'. If the is a letter, pressing twice inputs the letter itself. e.g. (setq anything-enable-shortcuts 'prefix) (define-key anything-map \"@\" 'anything-select-with-prefix-shortcut) If 'alphabet then they can be selected using Shift+ (deprecated). It is not recommended because you cannot input capital letters in pattern. Keys (digit/alphabet) are listed in `anything-shortcut-keys-alist'.") (defvar anything-shortcut-keys-alist '((alphabet . "asdfghjklzxcvbnmqwertyuiop") (prefix . "asdfghjklzxcvbnmqwertyuiop1234567890") (t . "123456789"))) (defvar anything-display-source-at-screen-top t "*If t, `anything-next-source' and `anything-previous-source' display candidates at the top of screen.") (defvar anything-candidate-number-limit 50 "*Do not show more candidates than this limit from individual 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 0.1 "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 "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 "M-<") 'anything-beginning-of-buffer) (define-key map (kbd "M->") 'anything-end-of-buffer) (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) (loop for c from ?A to ?Z do (define-key map (make-string 1 c) 'anything-select-with-digit-shortcut)) (define-key map (kbd "C-i") 'anything-select-action) (define-key map (kbd "C-z") 'anything-execute-persistent-action) (define-key map (kbd "C-e") 'anything-select-2nd-action-or-end-of-line) (define-key map (kbd "C-j") 'anything-select-3rd-action) (define-key map (kbd "C-o") 'anything-next-source) (define-key map (kbd "C-M-v") 'anything-scroll-other-window) (define-key map (kbd "M-") 'anything-scroll-other-window) (define-key map (kbd "C-M-y") 'anything-scroll-other-window-down) (define-key map (kbd "C-M-S-v") 'anything-scroll-other-window-down) (define-key map (kbd "M-") 'anything-scroll-other-window-down) (define-key map (kbd "C-SPC") 'anything-toggle-visible-mark) (define-key map (kbd "M-[") 'anything-prev-visible-mark) (define-key map (kbd "M-]") 'anything-next-visible-mark) (define-key map (kbd "C-k") 'anything-delete-minibuffer-contents) (define-key map (kbd "C-s") 'anything-isearch) (define-key map (kbd "C-r") 'undefined) (define-key map (kbd "C-t") 'anything-toggle-resplit-window) (define-key map (kbd "C-x C-f") 'anything-quit-and-find-file) (define-key map (kbd "C-c C-d") 'anything-delete-current-selection) (define-key map (kbd "C-c C-y") 'anything-yank-selection) (define-key map (kbd "C-c C-k") 'anything-kill-selection-and-quit) (define-key map (kbd "C-c C-f") 'anything-follow-mode) (define-key map (kbd "C-c C-u") 'anything-force-update) ;; Debugging command (define-key map "\C-c\C-x\C-d" 'anything-debug-output) (define-key map "\C-c\C-x\C-m" 'anything-display-all-visible-marks) (define-key map "\C-c\C-x\C-b" 'anything-send-bug-report-from-anything) ;; Use `describe-mode' key in `global-map' (dolist (k (where-is-internal 'describe-mode global-map)) (define-key map k 'anything-help)) ;; 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) (defalias 'anything-next-history-element 'next-history-element) (define-key map (kbd "M-p") 'anything-previous-history-element) (define-key map (kbd "M-n") 'anything-next-history-element) map) "Keymap for anything. If you execute `anything-iswitchb-setup', some keys are modified. See `anything-iswitchb-setup-keys'.") (defvar anything-isearch-map (let ((map (make-sparse-keymap))) (set-keymap-parent map (current-global-map)) (define-key map (kbd "") 'anything-isearch-default-action) (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 (loop for i from 32 below 256 do (define-key map (vector i) 'anything-isearch-printing-char)) map) "Keymap for anything incremental search.") (defgroup anything nil "Open anything." :prefix "anything-" :group 'convenience) (defface anything-header '((t (:inherit header-line))) "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-selection-face 'highlight "Face for currently selected item.") (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 item.") (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-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. This hook is run at the beginning of buffer. The first candidate is selected after running this hook. See also `anything-after-update-hook'.") (defvar anything-after-update-hook nil "Run after the anything buffer was updated according the new input pattern. This is very similar to `anything-update-hook' but selection is not moved. It is useful to select a particular object instead of the first one. ") (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 anything-source-in-each-line-flag anything-map anything-sources deferred-action-list) "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-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-window-configuration . current-window-configuration) "If you want to save and restore frame configuration, set this variable to '(set-frame-configuration . current-frame-configuration) Older version saves/restores frame configuration, but the default is changed now, because flickering is occurred in some environment. ") (defvar anything-persistent-action-use-special-display nil "If non-nil, use `special-display-function' in persistent action.") (defvar anything-execute-action-at-once-if-one nil "If non-nil and there is one candidate, execute the first action without selection. It is useful for `anything' applications.") (defvar anything-quit-if-no-candidate nil "if non-nil and there is no candidate, do not display *anything* buffer and quit. This variable accepts a function, which is executed if no candidate. It is useful for `anything' applications.") (defvar anything-scroll-amount nil "Scroll amount used by `anything-scroll-other-window' and `anything-scroll-other-window-down'. If you prefer scrolling line by line, set this value to 1.") (defvar anything-display-function 'anything-default-display-buffer "Function to display *anything* buffer. It is `anything-default-display-buffer' by default, which affects `anything-samewindow'.") (defvar anything-delayed-init-executed nil) (defvar anything-mode-line-string "\\\\[anything-help]:help \\[anything-select-action]:Acts \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\\[anything-select-3rd-action]:NthAct \\[anything-send-bug-report-from-anything]:BugReport" "Help string displayed in mode-line in `anything'. If nil, use default `mode-line-format'.") (defvar anything-help-message "\\The keys that are defined for `anything' are: \\{anything-map}" "Detailed help message string for `anything'. It also accepts function or variable symbol.") (put 'anything 'timid-completion 'disabled) (defvar anything-inhibit-fit-frame-flag t "If non-nil, inhibit fitting anything frame to its buffer. It is nil by default because some flickering occurred in some environment. To enable fitting, set both `anything-inhibit-fit-frame-flag' and `fit-frame-inhibit-fitting' to nil.") (defvar anything-source-in-each-line-flag nil "If non-nil, add anything-source text-property in each candidate. experimental feature.") (defvaralias 'anything-debug-variables 'anything-debug-forms) (defvar anything-debug-forms nil "Forms to show in `anything-debug-output'. Otherwise all variables started with `anything-' are shown. It is useful for debug.") (defvar anything-debug nil "If non-nil, write log message into *Anything Log* buffer. If `debug-on-error' is non-nil, write log message regardless of this variable. It is disabled by default because *Anything Log* grows quickly.") ;; (@* "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)) (defvar anything-issued-errors nil) (defvar anything-shortcut-keys nil) (defvar anything-once-called-functions nil) (defvar anything-follow-mode nil) (defvar anything-let-variables nil) ;; (@* "Utility: logging") (defun anything-log (format-string &rest args) "Log message if `debug-on-error' or `anything-debug' is non-nil. Messages are written to the *Anythingn Log* buffer. Arguments are same as `format'." (when (or debug-on-error anything-debug) (with-current-buffer (get-buffer-create "*Anything Log*") (buffer-disable-undo) (set (make-local-variable 'inhibit-read-only) t) (goto-char (point-max)) (insert (let ((tm (current-time))) (format "%s.%06d (%s) %s\n" (format-time-string "%H:%M:%S" tm) (nth 2 tm) (anything-log-get-current-function) (apply #'format (cons format-string args)))))))) (defmacro anything-log-eval (&rest exprs) "Write each EXPR evaluation result to the *Anything Log* buffer." `(anything-log-eval-internal ',exprs)) (defun anything-log-run-hook (hook) (anything-log "executing %s" hook) (when (boundp hook) (anything-log-eval (symbol-value hook)) (anything-log-eval (default-value hook))) (run-hooks hook) (anything-log "executed %s" hook)) (defun anything-log-eval-internal (exprs) (dolist (expr exprs) (condition-case err (anything-log "%S = %S" expr (eval expr)) (error (anything-log "%S = ERROR!" expr))))) (defun anything-log-get-current-function () "Get function name calling `anything-log'. The original idea is from `tramp-debug-message'." (loop with exclude-func-re = "^anything-\\(?:interpret\\|log\\|.*funcall\\)" for btn from 1 to 40 ;avoid inf-loop for btf = (second (backtrace-frame btn)) for fn = (if (symbolp btf) (symbol-name btf) "") if (and (string-match "^anything" fn) (not (string-match exclude-func-re fn))) return fn)) (defun anything-log-error (&rest args) "Accumulate error messages into `anything-issued-errors'." (apply 'anything-log (concat "ERROR: " (car args)) (cdr args)) (let ((msg (apply 'format args))) (unless (member msg anything-issued-errors) (add-to-list 'anything-issued-errors msg)))) (defvar anything-last-log-file nil) (defun anything-log-save-maybe () (when (stringp anything-debug) (let ((logdir (expand-file-name (format-time-string "%Y%m%d") anything-debug))) (make-directory logdir t) (with-current-buffer (get-buffer-create "*Anything Log*") (write-region (point-min) (point-max) (setq anything-last-log-file (expand-file-name (format-time-string "%Y%m%d-%H%M%S") logdir)) nil 'silent) (erase-buffer))))) (defun anything-open-last-log () "Open anything log file of last anything session." (interactive) (if anything-last-log-file (view-file anything-last-log-file) (switch-to-buffer "*Anything Log*"))) (defun anything-print-error-messages () "Print error messages in `anything-issued-errors'." (message "%s" (mapconcat 'identity (reverse anything-issued-errors) "\n"))) ;; (anything-log "test") ;; (switch-to-buffer-other-window "*Anything Log*") ;; (@* "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 (but not lambda), return itself, otherwise make a list with one element." (if (and (listp obj) (not (functionp obj))) obj (list obj))) ;; (@* "Anything API") (defmacro anything-let (varlist &rest body) "[OBSOLETE] Like `let'. Bind anything buffer local variables according to VARLIST then eval BODY." `(anything-let-internal (anything-let-eval-varlist ',varlist) (lambda () ,@body))) (put 'anything-let 'lisp-indent-function 1) (defmacro anything-let* (varlist &rest body) "[OBSOLETE] Like `let*'. Bind anything buffer local variables according to VARLIST then eval BODY." `(anything-let-internal (anything-let*-eval-varlist ',varlist) (lambda () ,@body))) (put 'anything-let* 'lisp-indent-function 1) (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) (defun anything-deferred-action-function () (dolist (f deferred-action-list) (funcall f))) (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)) (deferred-action-function 'anything-deferred-action-function)) (anything-log "save variables: %S" --orig-vars) (unwind-protect (progn ,@body) (loop for (var . value) in --orig-vars do (set var value)) (anything-log "restore variables")))) (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* (attribute-name &optional (src (anything-get-current-source))) "Get the value of ATTRIBUTE-NAME of SRC (source) and pass to `anything-interpret-value'. if SRC is omitted, use current source. It is useful to write your sources." (anything-interpret-value (anything-attr attribute-name src))) (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." (unless (and (listp sources) (loop for name in sources always (stringp name))) (error "invalid data in `anything-set-source-filter': %S" sources)) (setq anything-source-filter sources) (anything-log-eval anything-source-filter) (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'." (with-current-buffer anything-buffer (setq anything-compiled-sources nil anything-sources sources anything-last-sources-local sources) (anything-log-eval anything-compiled-sources anything-sources)) (unless no-init (anything-funcall-foreach 'init)) (unless no-update (anything-update))) (defvar anything-compile-source-functions '(anything-compile-source--type anything-compile-source--dummy anything-compile-source--disable-shortcuts anything-compile-source--candidates-in-buffer) "Functions to compile elements of `anything-sources' (plug-in).") (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 (prog1 (setq anything-compiled-sources (anything-compile-sources anything-sources anything-compile-source-functions)) (anything-log-eval anything-compiled-sources))))) (defun* anything-get-selection (&optional (buffer nil buffer-s) (force-display-part)) "Return the currently selected item or nil. if BUFFER is nil or unspecified, use anything-buffer as default value. If FORCE-DISPLAY-PART is non-nil, return the display string." (setq buffer (if (and buffer buffer-s) buffer anything-buffer)) (unless (anything-empty-buffer-p buffer) (with-current-buffer buffer (let ((selection (or (and (not force-display-part) (get-text-property (overlay-start anything-selection-overlay) 'anything-realvalue)) (let ((disp (buffer-substring-no-properties (overlay-start anything-selection-overlay) (1- (overlay-end anything-selection-overlay)))) (source (anything-get-current-source))) (anything-aif (and (not force-display-part) (assoc-default 'display-to-real source)) (anything-funcall-with-source source it disp) disp))))) (unless (equal selection "") (anything-log-eval selection) selection))))) (defun anything-get-action () "Return the associated action for the selected candidate." (unless (anything-empty-buffer-p (anything-buffer-get)) (anything-aif (anything-attr 'action-transformer) (anything-composed-funcall-with-source (anything-get-current-source) it (anything-attr 'action) (anything-get-selection)) (anything-attr 'action)))) (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) (or (get-text-property (point) 'anything-source) (block exit ;; 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 (or (anything-get-previous-header-pos) (anything-get-next-header-pos))) (source-name (save-excursion (unless header-pos (message "No candidates") (return-from exit nil)) (goto-char header-pos) (anything-current-line-contents)))) (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)) (modifiedp (/= source-tick buffer-tick))) (puthash key buffer-tick anything-tick-hash) (anything-log-eval buffer modifiedp) modifiedp)) (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)) (defvar anything-quit nil) (defun anything-run-after-quit (function &rest args) "Perform an action after quitting `anything'. The action is to call FUNCTION with arguments ARGS." (setq anything-quit t) (anything-log-eval function args) (apply 'run-with-idle-timer 0 nil function args) (anything-exit-minibuffer)) (defun define-anything-type-attribute (type definition &optional doc) "Register type attribute of TYPE as DEFINITION with DOC. DOC is displayed in `anything-type-attributes' docstring. Use this function is better than setting `anything-type-attributes' directly." (anything-add-type-attribute type definition) (and doc (anything-document-type-attribute type doc)) nil) (defvaralias 'anything-attributes 'anything-additional-attributes) (defvar anything-additional-attributes nil "List of all `anything' attributes.") (defun anything-document-attribute (attribute short-doc &optional long-doc) "Register ATTRIBUTE documentation introduced by plug-in. SHORT-DOC is displayed beside attribute name. LONG-DOC is displayed below attribute name and short documentation." (if long-doc (setq short-doc (concat "(" short-doc ")")) (setq long-doc short-doc short-doc "")) (add-to-list 'anything-additional-attributes attribute t) (put attribute 'anything-attrdoc (concat "- " (symbol-name attribute) " " short-doc "\n\n" long-doc "\n"))) (put 'anything-document-attribute 'lisp-indent-function 2) (defun anything-require-at-least-version (version) "Output error message unless anything.el is older than VERSION. This is suitable for anything applications." (when (and (string= "1." (substring version 0 2)) (string-match "1\.\\([0-9]+\\)" anything-version) (< (string-to-number (match-string 1 anything-version)) (string-to-number (substring version 2)))) (error "Please update anything.el!! M-x auto-install-batch anything You must have auto-install.el too. http://www.emacswiki.org/cgi-bin/wiki/download/auto-install.el "))) (defun anything-interpret-value (value &optional source) "interpret VALUE as variable, function or literal. If VALUE is a function, call it with no arguments and return the value. If SOURCE is `anything' source, `anything-source-name' is source name. If VALUE is a variable, return the value. If VALUE is a symbol, but it is not a function or a variable, cause an error. Otherwise, return VALUE itself." (cond ((and source (functionp value)) (anything-funcall-with-source source value)) ((functionp value) (funcall value)) ((and (symbolp value) (boundp value)) (symbol-value value)) ((symbolp value) (error "anything-interpret-value: Symbol must be a function or a variable")) (t value))) (defun anything-once (function &rest args) "Ensure FUNCTION with ARGS to be called once in `anything' session." (let ((spec (cons function args))) (unless (member spec anything-once-called-functions) (apply function args) (push spec anything-once-called-functions)))) ;; (@* "Core: API helper") (defun anything-empty-buffer-p (&optional buffer) (zerop (buffer-size (and buffer (get-buffer buffer))))) (defun anything-let-eval-varlist (varlist) (mapcar (lambda (pair) (if (listp pair) (cons (car pair) (eval (cadr pair))) (cons pair nil))) varlist)) (defun anything-let*-eval-varlist (varlist) (let ((vars (mapcar (lambda (pair) (or (car-safe pair) pair)) varlist))) (eval `(let ,vars ,@(mapcar (lambda (pair) (if (listp pair) `(setq ,(car pair) ,(cadr pair)) `(setq ,pair nil))) varlist) (mapcar (lambda (v) (cons v (symbol-value v))) ',vars))))) (defun anything-let-internal (binding bodyfunc) "Evaluate BODYFUNC and Set BINDING to anything buffer-local variables. BINDING is a list of (VARNAME . VALUE) pair." (setq anything-let-variables binding) (unwind-protect (funcall bodyfunc) (setq anything-let-variables nil))) ;; (@* "Core: tools") (defun anything-current-line-contents () "Current line strig without properties." (buffer-substring-no-properties (point-at-bol) (point-at-eol))) (defun anything-funcall-with-source (source func &rest args) "Call FUNC with ARGS with variable `anything-source-name' and `source' is bound. FUNC can be function list. Return the result of last function call." (let ((anything-source-name (assoc-default 'name source)) result) (anything-log-eval anything-source-name func args) (dolist (func (if (functionp func) (list func) func) result) (setq result (apply func args))))) (defun anything-funcall-foreach (sym) "Call the sym function(s) for each source if any." (dolist (source (anything-get-sources)) (anything-aif (assoc-default sym source) (anything-funcall-with-source source it)))) (defun anything-normalize-sources (sources) "If SOURCES is only one source, make a list." (cond ((or (and sources ; avoid nil (symbolp sources)) (and (listp sources) (assq 'name sources))) (list sources)) (sources) (t anything-sources))) (defun anything-approximate-candidate-number () "Approximate Number of candidates. It is used to check if candidate number is 0, 1, or 2+." (with-current-buffer anything-buffer (let ((lines (1- (line-number-at-pos (1- (point-max)))))) (if (zerop lines) 0 (save-excursion (goto-char (point-min)) (forward-line 1) (if (anything-pos-multiline-p) (if (search-forward anything-candidate-separator nil t) 2 1) lines)))))) (defmacro with-anything-quittable (&rest body) `(let (inhibit-quit) (condition-case v (progn ,@body) (quit (setq anything-quit t) (exit-minibuffer) (keyboard-quit))))) (put 'with-anything-quittable 'lisp-indent-function 0) (defun anything-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)) (defun anything-composed-funcall-with-source (source funcs &rest args) (if (functionp funcs) (apply 'anything-funcall-with-source source funcs args) (apply 'anything-funcall-with-source source (lambda (&rest args) (anything-compose args funcs)) args))) (defun anything-new-timer (variable timer) "Set new TIMER to VARIABLE. Old timer is cancelled." (anything-aif (symbol-value variable) (cancel-timer it)) (set variable timer)) ;; (@* "Core: entry point") (defconst anything-argument-keys '(:sources :input :prompt :resume :preselect :buffer :keymap)) ;;;###autoload (defun anything (&rest plist) "Select anything. In Lisp program, some optional arguments can be used. PLIST is a list like (:key1 val1 :key2 val2 ...) or (&optional sources input prompt resume preselect buffer keymap). Basic keywords are the following: - :sources Temporary value of `anything-sources'. It also accepts a symbol, interpreted as a variable of an anything source. It also accepts an alist representing an anything source, which is detected by (assq 'name ANY-SOURCES) - :input Temporary value of `anything-pattern', ie. initial input of minibuffer. - :prompt Prompt other than \"pattern: \". - :resume If t, Resurrect previously instance of `anything'. Skip the initialization. If 'noresume, this instance of `anything' cannot be resumed. - :preselect Initially selected candidate. Specified by exact candidate or a regexp. Note that it is not working with delayed sources. - :buffer `anything-buffer' instead of *anything*. - :keymap `anything-map' for current `anything' session. Of course, conventional arguments are supported, the two are same. (anything :sources sources :input input :prompt prompt :resume resume :preselect preselect :buffer buffer :keymap keymap) (anything sources input prompt resume preselect buffer keymap) Other keywords are interpreted as local variables of this anything session. The `anything-' prefix can be omitted. For example, (anything :sources 'anything-c-source-buffers :buffer \"*buffers*\" :candidate-number-limit 10) means starting anything session with `anything-c-source-buffers' source in *buffers* buffer and set `anything-candidate-number-limit' to 10 as session local variable. " (interactive) (if (keywordp (car plist)) (anything-let-internal (anything-parse-keys plist) (lambda () (apply 'anything (mapcar (lambda (key) (plist-get plist key)) anything-argument-keys)))) (apply 'anything-internal plist))) (defun* anything-resume (&optional (any-buffer anything-last-buffer) buffer-pattern (any-resume t)) "Resurrect previously invoked `anything'." (interactive) (when (or current-prefix-arg buffer-pattern) (setq any-buffer (anything-resume-select-buffer buffer-pattern))) (setq anything-compiled-sources nil) (anything (or (buffer-local-value 'anything-last-sources-local (get-buffer any-buffer)) anything-last-sources anything-sources) (buffer-local-value 'anything-input-local (get-buffer any-buffer)) nil any-resume nil any-buffer)) ;;; rubikitch: experimental ;;; I use this and check it whether I am convenient. ;;; I may introduce an option to control the behavior. (defun* anything-resume-window-only (&optional (any-buffer anything-last-buffer) buffer-pattern) (interactive) (anything-resume any-buffer buffer-pattern 'window-only)) ;;;###autoload (defun anything-at-point (&optional any-sources any-input any-prompt any-resume any-preselect any-buffer) "Same as `anything' except when C-u is pressed, the initial input is the symbol at point." (interactive) (anything any-sources (if current-prefix-arg (concat "\\b" (thing-at-point 'symbol) "\\b" (if (featurep 'anything-match-plugin) " " "")) any-input) any-prompt any-resume any-preselect any-buffer)) ;;;###autoload (defun anything-other-buffer (any-sources any-buffer) "Simplified interface of `anything' with other `anything-buffer'" (anything any-sources nil nil nil nil any-buffer)) ;;; (@* "Core: entry point helper") (defun anything-internal (&optional any-sources any-input any-prompt any-resume any-preselect any-buffer any-keymap) "Older interface of `anything'. It is called by `anything'." (anything-log "++++++++++++++++++++++++++++++++++++++++++++++++++++++++") (anything-log-eval any-prompt any-preselect any-buffer any-keymap) (unwind-protect (condition-case v (let ( ;; 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-quit (case-fold-search t) (anything-buffer (or any-buffer anything-buffer)) ;; cua-mode ; avoid error when region is selected ) (with-anything-restore-variables (anything-initialize-1 any-resume any-input any-sources) (anything-display-buffer anything-buffer) (anything-log "show prompt") (unwind-protect (anything-read-pattern-maybe any-prompt any-input any-preselect any-resume any-keymap) (anything-cleanup))) (prog1 (unless anything-quit (anything-execute-selection-action-1)) (anything-log "end session --------------------------------------------"))) (quit (anything-on-quit) (anything-log "end session (quit) -------------------------------------") nil)) (anything-log-save-maybe))) (defun anything-parse-keys (keys) (loop for (key value &rest _) on keys by #'cddr for symname = (substring (symbol-name key) 1) for sym = (intern (if (string-match "^anything-" symname) symname (concat "anything-" symname))) unless (memq key anything-argument-keys) collect (cons sym value))) (defun anything-resume-p (any-resume) "Whethre current anything session is resumed or not." (memq any-resume '(t window-only))) (defvar anything-buffers nil "All of `anything-buffer' in most recently used order.") (defun anything-initialize-1 (any-resume any-input any-sources) "The real initialization of `anything'. This function name should be `anything-initialize', but anything extensions may advice `anything-initalize'. I cannot rename, sigh." (anything-log "start initialization: any-resume=%S any-input=%S" any-resume any-input) (anything-frame/window-configuration 'save) (setq anything-sources (anything-normalize-sources any-sources)) (anything-log "sources = %S" anything-sources) (anything-hooks 'setup) (anything-current-position 'save) (if (anything-resume-p any-resume) (anything-initialize-overlays (anything-buffer-get)) (anything-initialize)) (unless (eq any-resume 'noresume) (anything-recent-push anything-buffer 'anything-buffers) (setq anything-last-buffer anything-buffer)) (when any-input (setq anything-input any-input anything-pattern any-input)) (and (anything-resume-p any-resume) (anything-funcall-foreach 'resume)) (anything-log "end initialization")) (defun anything-execute-selection-action-1 () (unwind-protect (anything-execute-selection-action) (anything-aif (get-buffer anything-action-buffer) (kill-buffer it)) (anything-log-run-hook 'anything-after-action-hook))) (defun anything-on-quit () (setq minibuffer-history (cons anything-input minibuffer-history)) (anything-current-position 'restore)) (defun anything-resume-select-buffer (input) (anything '(((name . "Resume anything buffer") (candidates . anything-buffers) (action . identity))) input nil 'noresume nil "*anything resume*")) (defun anything-recent-push (elt list-var) "Add ELT to the value of LIST-VAR as most recently used value." (let ((m (member elt (symbol-value list-var)))) (and m (set list-var (delq (car m) (symbol-value list-var)))) (push elt (symbol-value list-var)))) ;;; (@* "Core: Accessors") ;;; rubikitch: I love to create functions to control variables. (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.") (defun anything-current-position (save-or-restore) (case save-or-restore (save (setq anything-current-position (cons (point) (window-start)))) (restore (goto-char (car anything-current-position)) (set-window-start (selected-window) (cdr anything-current-position))))) ;;; FIXME I want to remove them. But anything-iswitchb uses them. (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)) (declare-function 'anything-frame/window-configuration "anything") (lexical-let (conf) (defun anything-frame/window-configuration (save-or-restore) (anything-log-eval anything-save-configuration-functions) (case save-or-restore (save (setq conf (funcall (cdr anything-save-configuration-functions)))) (restore (funcall (car anything-save-configuration-functions) conf))))) ;; (@* "Core: Display *anything* buffer") (defun anything-display-buffer (buf) "Display *anything* buffer." (funcall (with-current-buffer buf anything-display-function) buf)) (defun anything-default-display-buffer (buf) (funcall (if anything-samewindow 'switch-to-buffer 'pop-to-buffer) buf)) ;; (@* "Core: initialize") (defun anything-initialize () "Initialize anything settings and set up the anything buffer." (anything-log-run-hook 'anything-before-initialize-hook) (setq anything-once-called-functions nil) (setq anything-delayed-init-executed nil) (setq anything-current-buffer (current-buffer)) (setq anything-buffer-file-name buffer-file-name) (setq anything-issued-errors nil) (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) (anything-log-run-hook 'anything-after-initialize-hook)) (defun anything-read-pattern-maybe (any-prompt any-input any-preselect any-resume any-keymap) (if (anything-resume-p 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 (with-current-buffer (anything-buffer-get) (and any-keymap (set (make-local-variable 'anything-map) any-keymap)) anything-map))) (anything-log-eval (anything-approximate-candidate-number) anything-execute-action-at-once-if-one anything-quit-if-no-candidate) (cond ((and anything-execute-action-at-once-if-one (= (anything-approximate-candidate-number) 1)) (ignore)) ((and anything-quit-if-no-candidate (= (anything-approximate-candidate-number) 0)) (setq anything-quit t) (and (functionp anything-quit-if-no-candidate) (funcall anything-quit-if-no-candidate))) (t (read-string (or any-prompt "pattern: ") any-input))))) (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) (anything-log "kill local variables: %S" (buffer-local-variables)) (kill-all-local-variables) (buffer-disable-undo) (erase-buffer) (set (make-local-variable 'inhibit-read-only) t) (set (make-local-variable 'anything-last-sources-local) anything-sources) (set (make-local-variable 'anything-follow-mode) nil) (set (make-local-variable 'anything-display-function) anything-display-function) (anything-log-eval anything-display-function anything-let-variables) (loop for (var . val) in anything-let-variables do (set (make-local-variable var) val)) (setq cursor-type nil) (setq mode-name "Anything")) (anything-initialize-overlays anything-buffer) (get-buffer anything-buffer)) (defun anything-initialize-overlays (buffer) (anything-log "overlay setup") (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 anything-selection-face)) (cond (anything-enable-shortcuts (setq anything-shortcut-keys (assoc-default anything-enable-shortcuts anything-shortcut-keys-alist)) (unless anything-digit-overlays (setq anything-digit-overlays (loop for key across anything-shortcut-keys for overlay = (make-overlay (point-min) (point-min) (get-buffer buffer)) do (overlay-put overlay 'before-string (format "%s - " (upcase (make-string 1 key)))) collect overlay)))) (anything-digit-overlays (mapc 'delete-overlay anything-digit-overlays) (setq anything-digit-overlays nil)))) (defun anything-hooks (setup-or-cleanup) (let ((hooks '((deferred-action-list anything-check-minibuffer-input) (minibuffer-setup-hook anything-print-error-messages)))) (if (eq setup-or-cleanup 'setup) (dolist (args hooks) (apply 'add-hook args)) (dolist (args (reverse hooks)) (apply 'remove-hook args))))) ;; (@* "Core: clean up") ;;; TODO move (defun anything-cleanup () "Clean up the mess." (anything-log "start cleanup") (with-current-buffer anything-buffer (setq cursor-type t)) (bury-buffer anything-buffer) (anything-funcall-foreach 'cleanup) (anything-new-timer 'anything-check-minibuffer-input-timer nil) (anything-kill-async-processes) (anything-log-run-hook 'anything-cleanup-hook) (anything-hooks 'cleanup) (anything-frame/window-configuration 'restore)) ;; (@* "Core: input handling") (defun anything-check-minibuffer-input () "Extract input string from the minibuffer and check if it needs to be handled." (let ((delay (with-current-buffer anything-buffer anything-input-idle-delay))) (if (or (not delay) (anything-action-window)) (anything-check-minibuffer-input-1) (anything-new-timer 'anything-check-minibuffer-input-timer (run-with-idle-timer delay nil 'anything-check-minibuffer-input-1))))) (defun anything-check-minibuffer-input-1 () (with-anything-quittable (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-log-eval anything-pattern anything-input) (anything-update))) ;; (@* "Core: source compiler") (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: plug-in attribute documentation hack") ;; `anything-document-attribute' is public API. (defadvice documentation-property (after anything-document-attribute activate) "Hack to display plug-in attributes' documentation as `anything-sources' docstring." (when (eq symbol 'anything-sources) (setq ad-return-value (concat ad-return-value "\n" (mapconcat (lambda (sym) (get sym 'anything-attrdoc)) anything-additional-attributes "\n"))))) ;; (describe-variable 'anything-sources) ;; (documentation-property 'anything-sources 'variable-documentation) ;; (progn (ad-disable-advice 'documentation-property 'after 'anything-document-attribute) (ad-update 'documentation-property)) ;; (@* "Core: all candidates") (defun anything-process-delayed-init (source) (let ((name (assoc-default 'name source))) (unless (member name anything-delayed-init-executed) (anything-aif (assoc-default 'delayed-init source) (with-current-buffer anything-current-buffer (anything-funcall-with-source source it) (dolist (f (if (functionp it) (list it) it)) (add-to-list 'anything-delayed-init-executed name))))))) (defun anything-get-candidates (source) "Retrieve and return the list of candidates from SOURCE." (anything-process-delayed-init source) (let* ((candidate-source (assoc-default 'candidates source)) (type-error (lambda () (error (concat "Candidates must either be a function, " " a variable or a list: %s") candidate-source))) (candidates (condition-case err (anything-interpret-value candidate-source source) (error (funcall type-error))))) (cond ((processp candidates) candidates) ((listp candidates) (anything-transform-candidates candidates source)) (t (funcall type-error))))) (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))) (cond (candidate-cache (anything-log "use cached candidates") (cdr candidate-cache)) (t (anything-log "calculate candidates") (let ((candidates (anything-get-candidates source))) (cond ((processp candidates) (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)) ((not (assoc 'volatile source)) (setq candidate-cache (cons name candidates)) (push candidate-cache anything-candidate-cache))) candidates))))) ;;; (@* "Core: candidate transformers") (defun anything-process-candidate-transformer (candidates source) (anything-aif (assoc-default 'candidate-transformer source) (anything-composed-funcall-with-source source it candidates) candidates)) (defun anything-process-filtered-candidate-transformer (candidates source) (anything-aif (assoc-default 'filtered-candidate-transformer source) (anything-composed-funcall-with-source source it candidates source) candidates)) (defun anything-process-filtered-candidate-transformer-maybe (candidates source process-p) (if process-p (anything-process-filtered-candidate-transformer candidates source) candidates)) (defun anything-process-real-to-display (candidates source) (anything-aif (assoc-default 'real-to-display source) (setq candidates (anything-funcall-with-source source 'mapcar (lambda (cand_) (if (consp cand_) ;; override DISPLAY from candidate-transformer (cons (funcall it (cdr cand_)) (cdr cand_)) (cons (funcall it cand_) cand_))) candidates)) candidates)) (defun anything-transform-candidates (candidates source &optional process-p) "Transform CANDIDATES according to candidate transformers." (anything-process-real-to-display (anything-process-filtered-candidate-transformer-maybe (anything-process-candidate-transformer candidates source) source process-p) source)) ;; (@* "Core: narrowing candidates") (defun anything-candidate-number-limit (source) "`anything-candidate-number-limit' variable may be overridden by SOURCE. If (candidate-number-limit) is in SOURCE, show all candidates in SOURCE, ie. cancel the effect of `anything-candidate-number-limit'." (anything-aif (assq 'candidate-number-limit source) (or (cdr it) 99999999) (or anything-candidate-number-limit 99999999))) (defconst anything-default-match-functions (list (lambda (candidate) (string-match anything-pattern candidate)))) (defun anything-compute-matches (source) "Compute matches from SOURCE according to its settings." (if debug-on-error (anything-compute-matches-internal source) (condition-case v (anything-compute-matches-internal source) (error (anything-log-error "anything-compute-matches: error when processing source: %s" (assoc-default 'name source)) nil)))) (defun anything-candidate-get-display (candidate) "Get display part (searched) from CANDIDATE. CANDIDATE is a string, a symbol, or (DISPLAY . REAL) cons cell." (format "%s" (or (car-safe candidate) candidate))) (defun anything-process-pattern-transformer (pattern source) (anything-aif (assoc-default 'pattern-transformer source) (anything-composed-funcall-with-source source it pattern) pattern)) (defun anything-match-functions (source) (or (assoc-default 'match source) anything-default-match-functions)) (defmacro anything-accumulate-candidates-internal (cand newmatches hash item-count limit) "INTERNAL: add CAND (ITEM-COUNT th match) into NEWMATCHES. Use HASH to uniq NEWMATCHES. if ITEM-COUNT reaches LIMIT, exit from inner loop." `(unless (gethash ,cand ,hash) (puthash ,cand t ,hash) (push ,cand ,newmatches) (incf ,item-count) (when (= ,item-count ,limit) (setq exit t) (return)))) (defun anything-take-first-elements (seq n) (if (> (length seq) n) (setq seq (subseq seq 0 n)) seq)) (defun anything-match-from-candidates (cands matchfns limit) (let (matches) (condition-case nil (let ((item-count 0) exit) (clrhash anything-match-hash) (dolist (match matchfns) (let (newmatches) (dolist (candidate cands) (when (funcall match (anything-candidate-get-display candidate)) (anything-accumulate-candidates-internal candidate newmatches anything-match-hash item-count limit))) (setq matches (append matches (reverse newmatches))) (if exit (return))))) (invalid-regexp (setq matches nil))) matches)) (defun anything-compute-matches-internal (source) (let ((matchfns (anything-match-functions source)) (anything-source-name (assoc-default 'name source)) (limit (anything-candidate-number-limit source)) (anything-pattern (anything-process-pattern-transformer anything-pattern source))) (anything-process-filtered-candidate-transformer (if (or (equal anything-pattern "") (equal matchfns '(identity))) (anything-take-first-elements (anything-get-cached-candidates source) limit) (anything-match-from-candidates (anything-get-cached-candidates source) matchfns limit)) source))) ;; (anything '(((name . "error")(candidates . (lambda () (hage))) (action . identity)))) (defun anything-process-source (source) "Display matches from SOURCE according to its settings." (anything-log-eval (assoc-default 'name source)) (if (assq 'direct-insert-match source) ;experimental (anything-process-source--direct-insert-match source) (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)))) (anything-insert-header-from-source source) (if (not (assq 'multiline source)) (mapc 'anything-insert-match-with-digit-overlay matches) (let ((start (point)) separate) (dolist (match matches) (if separate (anything-insert-candidate-separator) (setq separate t)) (anything-insert-match-with-digit-overlay match)) (put-text-property start (point) 'anything-multiline t))))))) (defun anything-insert-match-with-digit-overlay (match) (declare (special source)) (anything-put-digit-overlay-maybe) (anything-insert-match match 'insert source)) (defun anything-put-digit-overlay-maybe () (when (and anything-enable-shortcuts (not (eq anything-digit-shortcut-count (length anything-digit-overlays)))) (move-overlay (nth anything-digit-shortcut-count anything-digit-overlays) (point-at-bol) (point-at-bol)) (incf anything-digit-shortcut-count))) (defun anything-process-source--direct-insert-match (source) "[EXPERIMENTAL] Insert candidates from `anything-candidate-buffer'" (anything-log-eval (assoc-default 'name source)) (let ((anything-source-name (assoc-default 'name source)) content-buf) (funcall (assoc-default 'candidates source)) (setq content-buf (anything-candidate-buffer)) (unless (anything-empty-buffer-p content-buf) (anything-insert-header-from-source source) (insert-buffer-substring content-buf) ;; TODO call anything-put-digit-overlay-maybe with loop ))) (defun anything-process-delayed-sources (delayed-sources) "Process delayed sources if the user is idle for `anything-idle-delay' seconds." (with-anything-quittable (anything-log-eval (mapcar (lambda (s) (assoc-default 'name s)) delayed-sources)) (with-current-buffer anything-buffer (save-excursion (goto-char (point-max)) (mapc 'anything-process-source delayed-sources) (when (and (not (anything-empty-buffer-p)) ;; no selection yet (= (overlay-start anything-selection-overlay) (overlay-end anything-selection-overlay))) (goto-char (point-min)) (anything-next-line))) (save-excursion (goto-char (point-min)) (anything-log-run-hook 'anything-update-hook)) (anything-maybe-fit-frame)))) ;; (@* "Core: *anything* buffer contents") (defvar anything-input-local nil) (defvar anything-process-delayed-sources-timer nil) (defun anything-update () "Update the list of matches in the anything buffer according to the current pattern." (anything-log "start update") (setq anything-digit-shortcut-count 0) (anything-kill-async-processes) (with-current-buffer (anything-buffer-get) (set (make-local-variable 'anything-input-local) anything-pattern) (erase-buffer) (when anything-enable-shortcuts (mapc 'delete-overlay anything-digit-overlays)) (let (delayed-sources) (unwind-protect (setq delayed-sources (loop for source in (remove-if-not 'anything-update-source-p (anything-get-sources)) if (anything-delayed-source-p source) collect source else do (anything-process-source source))) (anything-log-eval (mapcar (lambda (s) (assoc-default 'name s)) delayed-sources)) (anything-update-move-first-line) (if anything-test-mode (mapc 'anything-process-source delayed-sources) (anything-maybe-fit-frame) (when delayed-sources (anything-new-timer 'anything-process-delayed-sources-timer (run-with-idle-timer anything-idle-delay nil 'anything-process-delayed-sources delayed-sources))) ;; FIXME I want to execute anything-after-update-hook ;; AFTER processing delayed sources (anything-log-run-hook 'anything-after-update-hook)) (anything-log "end update"))))) (defun anything-update-source-p (source) (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)))) (defun anything-delayed-source-p (source) (or (assoc 'delayed source) (and anything-quick-update (< (window-height (get-buffer-window (current-buffer))) (line-number-at-pos (point-max)))))) (defun anything-update-move-first-line () (goto-char (point-min)) (save-excursion (anything-log-run-hook 'anything-update-hook)) (anything-next-line)) (defun anything-force-update () "Recalculate and update candidates. If current source has `update' attribute, a function without argument, call it before update." (interactive) (let ((source (anything-get-current-source))) (if source (anything-force-update--reinit source) (anything-erase-message) (mapc 'anything-force-update--reinit (anything-get-sources))) (let ((selection (anything-get-selection nil t))) (anything-update) (anything-keep-selection source selection)))) (defun anything-force-update--reinit (source) (anything-aif (anything-funcall-with-source source 'anything-candidate-buffer) (kill-buffer it)) (dolist (attr '(update init)) (anything-aif (assoc-default attr source) (anything-funcall-with-source source it))) (anything-remove-candidate-cache source)) (defun anything-erase-message () (message "")) (defun anything-keep-selection (source selection) (when (and source selection) (with-anything-window (anything-goto-source source) (forward-char -1) ;back to \n (if (search-forward (concat "\n" selection "\n") nil t) (forward-line -1) (goto-char (point-min)) (forward-line 1)) (anything-mark-current-line)))) (defun anything-remove-candidate-cache (source) (setq anything-candidate-cache (delete (assoc (assoc-default 'name source) anything-candidate-cache) anything-candidate-cache))) (defun anything-insert-match (match insert-function source) "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 (point-at-bol (point))) (string (or (car-safe match) match)) (realvalue (cdr-safe match))) (when (symbolp string) (setq string (symbol-name string))) (when (stringp string) (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) (and realvalue (put-text-property start (point-at-eol) 'anything-realvalue realvalue))) (when anything-source-in-each-line-flag (put-text-property start (point-at-eol) 'anything-source source)) (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) (anything-funcall-with-source source 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 (point-at-bol) (point-at-eol) 'anything-header t) (when display-string (overlay-put (make-overlay (point-at-bol) (point-at-eol)) '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 (point-at-bol) (point-at-eol) 'anything-candidate-separator t) (insert "\n")) ;; (@* "Core: async process") (defun anything-output-filter (process string) "Process output from PROCESS." (anything-output-filter-1 (assoc process anything-async-processes) string)) (defun anything-output-filter-1 (process-assoc string) (anything-log-eval string) (with-current-buffer anything-buffer (let ((source (cdr process-assoc))) (save-excursion (anything-aif (assoc-default 'insertion-marker source) (goto-char it) (goto-char (point-max)) (anything-insert-header-from-source source) (setcdr process-assoc (append source `((insertion-marker . ,(point-marker)))))) (anything-output-filter--process-source (car process-assoc) string source (anything-candidate-number-limit source)))) (anything-output-filter--post-process))) (defun anything-output-filter--process-source (process string source limit) (dolist (candidate (anything-transform-candidates (anything-output-filter--collect-candidates (split-string string "\n") (assoc 'incomplete-line source)) source t)) (anything-insert-match candidate 'insert-before-markers source) (incf (cdr (assoc 'item-count source))) (when (>= (assoc-default 'item-count source) limit) (anything-kill-async-process process) (return)))) (defun anything-output-filter--collect-candidates (lines incomplete-line-info) (anything-log-eval (cdr incomplete-line-info)) (butlast (loop for line in lines collect (if (cdr incomplete-line-info) (prog1 (concat (cdr incomplete-line-info) line) (setcdr incomplete-line-info nil)) line) finally (setcdr incomplete-line-info line)))) (defun anything-output-filter--post-process () (anything-maybe-fit-frame) (anything-log-run-hook 'anything-update-hook) (save-selected-window (select-window (get-buffer-window anything-buffer 'visible)) (anything-skip-noncandidate-line 'next) (anything-mark-current-line))) (defun anything-kill-async-processes () "Kill all known asynchronous processes according to `anything-async-processes'." "Kill locate process." (mapc 'anything-kill-async-process (mapcar 'car anything-async-processes)) (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 preserve-saved-action) "If a candidate was selected then perform the associated action." (anything-log "executing action") (setq action (anything-get-default-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)))) (setq selection (or selection (anything-get-selection) (and (assoc 'accept-empty source) ""))) (unless preserve-saved-action (setq anything-saved-action nil)) (if (and selection action) (anything-funcall-with-source source action (anything-coerce-selection selection source))))) (defun anything-coerce-selection (selection source) "Coerce source with coerce function." (anything-aif (assoc-default 'coerce source) (anything-funcall-with-source source it selection) selection)) (defun anything-get-default-action (action) (if (and (listp action) (not (functionp action))) (cdar action) action)) (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) (anything-set-pattern anything-input 'noupdate)) (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))) (if (functionp actions) (message "Sole action: %s" actions) (anything-show-action-buffer actions) (anything-delete-minibuffer-contents) (setq anything-pattern 'dummy) ; so that it differs from the previous one (anything-check-minibuffer-input)))))) (defun anything-show-action-buffer (actions) (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") (volatile) (candidates . ,actions) (candidate-number-limit)))) (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))) ;; (@* "Core: selection") (defun anything-move-selection-common (move-func unit direction) "Move the selection marker to a new position determined by UNIT and DIRECTION." (unless (or (anything-empty-buffer-p (anything-buffer-get)) (not (anything-window))) (with-anything-window (funcall move-func) (anything-skip-noncandidate-line direction) (anything-display-source-at-screen-top-maybe unit) (when (anything-get-previous-header-pos) (anything-mark-current-line)) (anything-display-mode-line (anything-get-current-source))))) (defun anything-display-source-at-screen-top-maybe (unit) (when (and anything-display-source-at-screen-top (eq unit 'source)) (set-window-start (selected-window) (save-excursion (forward-line -1) (point))))) (defun anything-skip-noncandidate-line (direction) (anything-skip-header-and-separator-line direction) (and (bobp) (forward-line 1)) ;skip first header (and (eobp) (forward-line -1)) ;avoid last empty line ) (defun anything-skip-header-and-separator-line (direction) (while (and (not (bobp)) (or (anything-pos-header-line-p) (anything-pos-candidate-separator-p))) (forward-line (if (and (eq direction 'previous) (not (eq (point-at-bol) (point-min)))) -1 1)))) (defvar anything-mode-line-string-real nil) (defun anything-display-mode-line (source) (set (make-local-variable 'anything-mode-line-string) (anything-interpret-value (or (assoc-default 'mode-line source) (default-value 'anything-mode-line-string)) source)) (if anything-mode-line-string (setq mode-line-format '(" " mode-line-buffer-identification " " (line-number-mode "%l") " " (anything-follow-mode "(F)") " " anything-mode-line-string-real "-%-") anything-mode-line-string-real (substitute-command-keys anything-mode-line-string)) (setq mode-line-format (default-value 'mode-line-format))) (setq header-line-format (anything-interpret-value (assoc-default 'header-line source) source))) (defun anything-previous-line () "Move selection to the previous line." (interactive) (anything-move-selection-common (lambda () (if (not (anything-pos-multiline-p)) (forward-line -1) ;double forward-line is meaningful (forward-line -1) ;because evaluation order is important (anything-skip-header-and-separator-line 'previous) (let ((header-pos (anything-get-previous-header-pos)) (separator-pos (anything-get-previous-candidate-separator-pos))) (when header-pos (goto-char (if (or (null separator-pos) (< separator-pos header-pos)) header-pos ; first candidate separator-pos)) (forward-line 1))))) 'line 'previous)) (defun anything-next-line () "Move selection to the next line." (interactive) (anything-move-selection-common (lambda () (if (not (anything-pos-multiline-p)) (forward-line 1) (let ((header-pos (anything-get-next-header-pos)) (separator-pos (anything-get-next-candidate-separator-pos))) (cond ((and separator-pos (or (null header-pos) (< separator-pos header-pos))) (goto-char separator-pos)) (header-pos (goto-char header-pos)))))) 'line 'next)) (defun anything-previous-page () "Move selection back with a pageful." (interactive) (anything-move-selection-common (lambda () (condition-case nil (scroll-down) (beginning-of-buffer (goto-char (point-min))))) 'page 'previous)) (defun anything-next-page () "Move selection forward with a pageful." (interactive) (anything-move-selection-common (lambda () (condition-case nil (scroll-up) (end-of-buffer (goto-char (point-max))))) 'page 'next)) (defun anything-beginning-of-buffer () "Move selection at the top." (interactive) (anything-move-selection-common (lambda () (goto-char (point-min))) 'edge 'previous)) (defun anything-end-of-buffer () "Move selection at the bottom." (interactive) (anything-move-selection-common (lambda () (goto-char (point-max))) 'edge 'next)) (defun anything-previous-source () "Move selection to the previous source." (interactive) (anything-move-selection-common (lambda () (forward-line -1) (if (bobp) (goto-char (point-max)) (anything-skip-header-and-separator-line 'previous)) (goto-char (anything-get-previous-header-pos)) (forward-line 1)) 'source 'previous)) (defun anything-next-source () "Move selection to the next source." (interactive) (anything-move-selection-common (lambda () (goto-char (or (anything-get-next-header-pos) (point-min)))) 'source 'next)) (defun anything-goto-source (source-or-name) "Move the selection to the source (SOURCE-OR-NAME)." (anything-move-selection-common (lambda () (goto-char (point-min)) (let ((name (if (stringp source-or-name) source-or-name (assoc-default 'name source-or-name)))) (condition-case err (while (not (string= name (anything-current-line-contents))) (goto-char (anything-get-next-header-pos))) (error (message ""))))) 'source 'next)) (defun anything-mark-current-line () "Move selection overlay to current line." (move-overlay anything-selection-overlay (point-at-bol) (if (anything-pos-multiline-p) (let ((header-pos (anything-get-next-header-pos)) (separator-pos (anything-get-next-candidate-separator-pos))) (or (and (null header-pos) separator-pos) (and header-pos separator-pos (< separator-pos header-pos) separator-pos) header-pos (point-max))) (1+ (point-at-eol)))) (anything-follow-execute-persistent-action-maybe)) (defun anything-this-command-key () (event-basic-type (elt (this-command-keys-vector) 0))) ;; (progn (read-key-sequence "Key: ") (p (anything-this-command-key))) (defun anything-select-with-shortcut-internal (types get-key-func) (if (memq anything-enable-shortcuts types) (save-selected-window (select-window (anything-window)) (let* ((key (funcall get-key-func)) (overlay (ignore-errors (nth (position key anything-shortcut-keys) anything-digit-overlays)))) (if (not (and overlay (overlay-buffer overlay))) (when (numberp key) (select-window (minibuffer-window)) (self-insert-command 1)) (goto-char (overlay-start overlay)) (anything-mark-current-line) (anything-exit-minibuffer)))) (self-insert-command 1))) (defun anything-select-with-prefix-shortcut () "Invoke default action with prefix shortcut." (interactive) (anything-select-with-shortcut-internal '(prefix) (lambda () (read-event "Select shortcut key: ")))) (defun anything-select-with-digit-shortcut () "Invoke default action with digit/alphabet shortcut." (interactive) (anything-select-with-shortcut-internal '(alphabet t) 'anything-this-command-key)) ;; (setq anything-enable-shortcuts 'prefix) ;; (define-key anything-map "@" 'anything-select-with-prefix-shortcut) ;; (define-key anything-map (kbd "") 'anything-select-with-prefix-shortcut) (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 (point-at-bol) 'anything-header) (get-text-property (point-at-bol) 'anything-header-separator))) (defun anything-pos-candidate-separator-p () "Return t if the current line is a candidate separator." (get-text-property (point-at-bol) 'anything-candidate-separator)) ;; (@* "Core: help") (defun anything-help-internal (bufname insert-content-fn) "Show long message during `anything' session." (save-window-excursion (select-window (anything-window)) (delete-other-windows) (switch-to-buffer (get-buffer-create bufname)) (erase-buffer) (funcall insert-content-fn) (setq mode-line-format "%b (SPC,C-v:NextPage b,M-v:PrevPage other:Exit)") (setq cursor-type nil) (goto-char 1) (anything-help-event-loop))) (defun anything-help-event-loop () (ignore-errors (loop for event = (read-event) do (case event ((?\C-v ? ) (scroll-up)) ((?\M-v ?b) (scroll-down)) (t (return)))))) (defun anything-help () "Help of `anything'." (interactive) (anything-help-internal " *Anything Help*" (lambda () (insert (substitute-command-keys (anything-interpret-value anything-help-message))) (org-mode)))) (defun anything-debug-output () "Show all anything-related variables at this time." (interactive) (anything-help-internal " *Anything Debug*" 'anything-debug-output-function)) (defun anything-debug-output-function (&optional vars) (message "Calculating all anything-related values...") (insert "If you debug some variables or forms, set `anything-debug-forms' to a list of forms.\n\n") (dolist (v (or vars anything-debug-forms (apropos-internal "^anything-" 'boundp))) (insert "** " (pp-to-string v) "\n" (pp-to-string (eval v)) "\n")) (message "Calculating all anything-related values...Done")) ;; (@* "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. It is disabled by default because some flickering occurred in some environment. To enable fitting, set both `anything-inhibit-fit-frame-flag' and `fit-frame-inhibit-fitting' to nil. 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 (not anything-inhibit-fit-frame-flag) (anything-window) (require 'fit-frame nil t) (boundp 'fit-frame-inhibit-fitting-flag) (not fit-frame-inhibit-fitting-flag)) (ignore-errors (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) (with-anything-window (when candidate-or-regexp (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))) (defun anything-edit-current-selection-internal (func) (with-anything-window (beginning-of-line) (let ((realvalue (get-text-property (point) 'anything-realvalue))) (funcall func) (beginning-of-line) (and realvalue (put-text-property (point) (point-at-eol) 'anything-realvalue realvalue)) (anything-mark-current-line)))) (defmacro anything-edit-current-selection (&rest forms) "Evaluate FORMS at current selection in the anything buffer. You can edit the line." `(anything-edit-current-selection-internal (lambda () ,@forms))) (put 'anything-edit-current-selection 'lisp-indent-function 0) (defun anything-set-pattern (pattern &optional noupdate) "Set minibuffer contents to PATTERN. if optional NOUPDATE is non-nil, anything buffer is not changed." (with-selected-window (minibuffer-window) (delete-minibuffer-contents) (insert pattern)) (when noupdate (setq anything-pattern pattern) (anything-hooks 'cleanup) (run-with-idle-timer 0 nil 'anything-hooks 'setup))) (defun anything-delete-minibuffer-contents () "Same as `delete-minibuffer-contents' but this is a command." (interactive) (anything-set-pattern "")) (defalias 'anything-delete-minibuffer-content 'anything-delete-minibuffer-contents) ;; (@* "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)) ;; `define-anything-type-attribute' is public API. (defun anything-add-type-attribute (type definition) (anything-aif (assq type anything-type-attributes) (setq anything-type-attributes (delete it anything-type-attributes))) (push (cons type definition) anything-type-attributes)) (defvar anything-types nil) (defun anything-document-type-attribute (type doc) (add-to-list 'anything-types type t) (put type 'anything-typeattrdoc (concat "- " (symbol-name type) "\n\n" doc "\n"))) (defadvice documentation-property (after anything-document-type-attribute activate) "Hack to display type attributes' documentation as `anything-type-attributes' docstring." (when (eq symbol 'anything-type-attributes) (setq ad-return-value (concat ad-return-value "\n\n++++ Types currently defined ++++\n" (mapconcat (lambda (sym) (get sym 'anything-typeattrdoc)) anything-types "\n"))))) ;; (@* "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 source '((candidates "dummy") (accept-empty) (match identity) (filtered-candidate-transformer . anything-dummy-candidate) (disable-shortcuts) (volatile))) source)) ;; (@* "Built-in plug-in: disable-shortcuts") (defvar anything-orig-enable-shortcuts nil) (defun anything-save-enable-shortcuts () (anything-once (lambda () (setq anything-orig-enable-shortcuts anything-enable-shortcuts anything-enable-shortcuts nil)))) (defun anything-compile-source--disable-shortcuts (source) (if (assoc 'disable-shortcuts source) (append `((init ,@(anything-mklist (assoc-default 'init source)) anything-save-enable-shortcuts) (resume ,@(anything-mklist (assoc-default 'resume source)) anything-save-enable-shortcuts) (cleanup ,@(anything-mklist (assoc-default 'cleanup source)) (lambda () (setq anything-enable-shortcuts anything-orig-enable-shortcuts)))) 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 pattern get-line-fn search-fns 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))) (endp (if search-from-end #'bobp #'eobp))) (goto-char (1- start-point)) (if (string= pattern "") (anything-initial-candidates-from-candidate-buffer endp get-line-fn limit search-from-end) (anything-search-from-candidate-buffer pattern get-line-fn search-fns limit search-from-end start-point endp)))))) (defun anything-point-is-moved (proc) "If point is moved after executing PROC, return t, otherwise nil." (/= (point) (progn (funcall proc) (point)))) (defun anything-search-from-candidate-buffer (pattern get-line-fn search-fns limit search-from-end start-point endp) (let (buffer-read-only matches exit newmatches) (anything-search-from-candidate-buffer-internal (lambda () (clrhash anything-cib-hash) (dolist (searcher search-fns) (goto-char start-point) (setq newmatches nil) (loop with item-count = 0 while (funcall searcher pattern nil t) for cand = (funcall get-line-fn (point-at-bol) (point-at-eol)) do (anything-accumulate-candidates-internal cand newmatches anything-cib-hash item-count limit) unless (anything-point-is-moved (lambda () (if search-from-end (goto-char (1- (point-at-bol))) (forward-line 1)))) return nil) (setq matches (append matches (nreverse newmatches))) (if exit (return))) (delq nil matches))))) (defun anything-initial-candidates-from-candidate-buffer (endp get-line-fn limit search-from-end) (delq nil (loop with next-line-fn = (if search-from-end (lambda (x) (goto-char (max (1- (point-at-bol)) 1))) #'forward-line) until (funcall endp) for i from 1 to limit collect (funcall get-line-fn (point-at-bol) (point-at-eol)) do (funcall next-line-fn 1)))) (defun anything-search-from-candidate-buffer-internal (search-fn) (goto-char (point-min)) (insert "\n") (goto-char (point-max)) (insert "\n") (unwind-protect (funcall search-fn) (goto-char (point-min)) (delete-char 1) (goto-char (1- (point-max))) (delete-char 1) (set-buffer-modified-p nil))) (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 local candidates buffer, named \" *anything candidates:SOURCE*ANYTHING-CURRENT-BUFFER\". " (let* ((global-bname (format " *anything candidates:%s*" anything-source-name)) (local-bname (format " *anything candidates:%s*%s" anything-source-name (buffer-name anything-current-buffer))) (register-func (lambda () (setq anything-candidate-buffer-alist (cons (cons anything-source-name create-or-buffer) (delete (assoc anything-source-name anything-candidate-buffer-alist) anything-candidate-buffer-alist))))) (kill-buffers-func (lambda () (loop for b in (buffer-list) if (string-match (format "^%s" (regexp-quote global-bname)) (buffer-name b)) do (kill-buffer b)))) (create-func (lambda () (with-current-buffer (get-buffer-create (if (eq create-or-buffer 'global) global-bname local-bname)) (buffer-disable-undo) (erase-buffer) (font-lock-mode -1)))) (return-func (lambda () (or (get-buffer local-bname) (get-buffer global-bname) (anything-aif (assoc-default anything-source-name anything-candidate-buffer-alist) (and (buffer-live-p it) it)))))) (when create-or-buffer (funcall register-func) (unless (bufferp create-or-buffer) (and (eq create-or-buffer 'global) (funcall kill-buffers-func)) (funcall create-func))) (funcall return-func))) (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: resplit anything window") (defun anything-toggle-resplit-window () "Toggle resplit anything window, vertically or horizontally." (interactive) (with-anything-window (let ((before-height (window-height))) (delete-window) (set-window-buffer (select-window (if (= (window-height) before-height) (split-window-vertically) (split-window-horizontally))) anything-buffer)))) ;; (@* "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)) (defun anything-select-2nd-action-or-end-of-line () "Select the 2nd action for the currently selected candidate if the point is at the end of minibuffer. Otherwise goto the end of minibuffer." (interactive) (if (eolp) (anything-select-nth-action 1) (end-of-line))) ;; (@* "Utility: Persistent Action") (defmacro with-anything-display-same-window (&rest body) "Make `pop-to-buffer' and `display-buffer' display in the same window." `(let ((display-buffer-function 'anything-persistent-action-display-buffer)) ,@body)) (put 'with-anything-display-same-window 'lisp-indent-function 0) (defun* anything-execute-persistent-action (&optional (attr 'persistent-action)) "If a candidate is selected then perform the associated action without quitting anything." (interactive) (anything-log "executing persistent-action") (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)))) (anything-log-eval (current-buffer)) (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) (anything-log-run-hook 'anything-after-persistent-action-hook))))) (defun anything-persistent-action-display-buffer (buf &optional not-this-window) "Make `pop-to-buffer' and `display-buffer' display in the same window in persistent action. If `anything-persistent-action-use-special-display' is non-nil and BUF is to be displayed by `special-display-function', use it. Otherwise ignores `special-display-buffer-names' and `special-display-regexps'." (let* ((name (buffer-name buf)) display-buffer-function pop-up-windows (same-window-regexps (unless (and anything-persistent-action-use-special-display (or (member name (mapcar (lambda (x) (or (car-safe x) x)) special-display-buffer-names)) (remove-if-not (lambda (x) (string-match (or (car-safe x) x) name)) special-display-regexps))) '(".")))) (display-buffer buf not-this-window))) ;; scroll-other-window(-down)? for persistent-action (defun anything-scroll-other-window-base (command) (save-selected-window (select-window (some-window (lambda (w) (not (string= anything-buffer (buffer-name (window-buffer w))))) 'no-minibuffer 'current-frame)) (funcall command anything-scroll-amount))) (defun anything-scroll-other-window () "Scroll other window (not *Anything* window) upward." (interactive) (anything-scroll-other-window-base 'scroll-up)) (defun anything-scroll-other-window-down () "Scroll other window (not *Anything* window) downward." (interactive) (anything-scroll-other-window-base 'scroll-down)) ;; (@* "Utility: Visible Mark") (defface anything-visible-mark '((((min-colors 88) (background dark)) (:background "green1" :foreground "black")) (((background dark)) (:background "green" :foreground "black")) (((min-colors 88)) (:background "green1")) (t (:background "green"))) "Face for visible mark." :group 'anything) (defvar anything-visible-mark-face 'anything-visible-mark) (defvar anything-visible-mark-overlays nil) (defun anything-clear-visible-mark () (with-current-buffer (anything-buffer-get) (mapc 'delete-overlay anything-visible-mark-overlays) (set (make-local-variable 'anything-visible-mark-overlays) nil))) (add-hook 'anything-after-initialize-hook 'anything-clear-visible-mark) (defvar anything-c-marked-candidate-list nil "[OBSOLETE] DO NOT USE!!") (defvar anything-marked-candidates nil "Marked candadates. List of (source . real) pair.") (defun anything-this-visible-mark () (loop for o in anything-visible-mark-overlays when (equal (point-at-bol) (overlay-start o)) do (return o))) (defun anything-delete-visible-mark (overlay) (setq anything-c-marked-candidate-list (remove (anything-current-line-contents) anything-c-marked-candidate-list)) (setq anything-marked-candidates (remove (cons (anything-get-current-source) (anything-get-selection)) anything-marked-candidates)) (delete-overlay overlay) (setq anything-visible-mark-overlays (delq overlay anything-visible-mark-overlays))) (defun anything-make-visible-mark () (let ((o (make-overlay (point-at-bol) (1+ (point-at-eol))))) (overlay-put o 'face anything-visible-mark-face) (overlay-put o 'source (assoc-default 'name (anything-get-current-source))) (overlay-put o 'string (buffer-substring (overlay-start o) (overlay-end o))) (add-to-list 'anything-visible-mark-overlays o)) (push (anything-current-line-contents) anything-c-marked-candidate-list) (push (cons (anything-get-current-source) (anything-get-selection)) anything-marked-candidates)) (defun anything-toggle-visible-mark () "Toggle anything visible bookmark at point." (interactive) (with-anything-window (anything-aif (anything-this-visible-mark) (anything-delete-visible-mark it) (anything-make-visible-mark)) (anything-next-line))) (defun anything-display-all-visible-marks () "Show all `anything' visible marks strings." (interactive) (lexical-let ((overlays (reverse anything-visible-mark-overlays))) (anything-run-after-quit (lambda () (with-output-to-temp-buffer "*anything visible marks*" (dolist (o overlays) (princ (overlay-get o 'string)))))))) (defun anything-marked-candidates () "Marked candidates (real value) of current source if any, otherwise 1-element list of current selection. It is analogous to `dired-get-marked-files'." (with-current-buffer (anything-buffer-get) (let ((cands (if anything-marked-candidates (loop with current-src = (anything-get-current-source) for (source . real) in (reverse anything-marked-candidates) when (equal current-src source) collect (anything-coerce-selection real source)) (list (anything-get-selection))))) (anything-log-eval cands) cands))) (defun anything-reset-marked-candidates () (with-current-buffer (anything-buffer-get) (set (make-local-variable 'anything-c-marked-candidate-list) nil) (set (make-local-variable 'anything-marked-candidates) nil))) (add-hook 'anything-after-initialize-hook 'anything-reset-marked-candidates) ;; (add-hook 'anything-after-action-hook 'anything-reset-marked-candidates) (defun anything-current-source-name= (name) (save-excursion (goto-char (anything-get-previous-header-pos)) (equal name (anything-current-line-contents)))) (defun anything-revive-visible-mark () (with-current-buffer anything-buffer (dolist (o anything-visible-mark-overlays) (goto-char (point-min)) (while (and (search-forward (overlay-get o 'string) nil t) (anything-current-source-name= (overlay-get o 'source))) ;; Now the next line of visible mark (move-overlay o (point-at-bol 0) (1+ (point-at-eol 0))))))) (add-hook 'anything-update-hook 'anything-revive-visible-mark) (defun anything-next-point-in-list (curpos points &optional prev) (cond ;; rule out special cases ((null points) curpos) ((and prev (< curpos (car points))) curpos) ((< (car (last points)) curpos) (if prev (car (last points)) curpos)) (t (nth (if prev (loop for pt in points for i from 0 if (<= curpos pt) do (return (1- i))) (loop for pt in points for i from 0 if (< curpos pt) do (return i))) points)))) (defun anything-next-visible-mark (&optional prev) "Move next anything visible mark." (interactive) (with-anything-window (goto-char (anything-next-point-in-list (point) (sort (mapcar 'overlay-start anything-visible-mark-overlays) '<) prev)) (anything-mark-current-line))) (defun anything-prev-visible-mark () "Move previous anything visible mark." (interactive) (anything-next-visible-mark t)) ;; (@* "Utility: `find-file' integration") (defun anything-quit-and-find-file () "Drop into `find-file' from `anything' like `iswitchb-find-file'. If current selection is a buffer or a file, `find-file' from its directory." (interactive) (anything-run-after-quit (lambda (f) (if (file-exists-p f) (let ((default-directory (file-name-directory f))) (call-interactively 'find-file)) (call-interactively 'find-file))) (anything-aif (get-buffer (anything-get-selection)) (buffer-file-name it) (expand-file-name (anything-get-selection))))) ;; (@* "Utility: Selection Paste") (defun anything-yank-selection () "Set minibuffer contents to current selection." (interactive) (anything-set-pattern (anything-get-selection nil t))) (defun anything-kill-selection-and-quit () "Store current selection to kill ring. You can paste it by typing C-y." (interactive) (anything-run-after-quit (lambda (sel) (kill-new sel) (message "Killed: %s" sel)) (anything-get-selection nil t))) ;; (@* "Utility: Automatical execution of persistent-action") (add-to-list 'minor-mode-alist '(anything-follow-mode " AFollow")) (defun anything-follow-mode () "If this mode is on, persistent action is executed everytime the cursor is moved." (interactive) (with-current-buffer anything-buffer (setq anything-follow-mode (not anything-follow-mode)) (message "anything-follow-mode is %s" (if anything-follow-mode "enabled" "disabled")))) (defun anything-follow-execute-persistent-action-maybe () "Execute persistent action after `anything-input-idle-delay' secs when `anything-follow-mode' is enabled." (and (buffer-local-value 'anything-follow-mode (get-buffer-create anything-buffer)) (sit-for anything-input-idle-delay) (anything-window) (anything-get-selection) (save-excursion (anything-execute-persistent-action)))) ;; (@* "Utility: Migrate `anything-sources' to my-anything command") (defun anything-migrate-sources () "Help to migrate to new `anything' way." (interactive) (with-current-buffer (get-buffer-create "*anything migrate*") (erase-buffer) (insert (format "\ Setting `anything-sources' directly is not good because `anything' is not for one command. For now, interactive use of `anything' (M-x anything) is only for demonstration purpose. So you should define commands calling `anything'. I help you to migrate to the new way. The code below is automatically generated from current `anything-sources' value. You can use the `my-anything' command now! Copy and paste it to your .emacs. Then substitute `my-anything' for `anything' bindings in all `define-key', `local-set-key' and `global-set-key' calls. \(defun my-anything () \"Anything command for you. It is automatically generated by `anything-migrate-sources'.\" (interactive) (anything-other-buffer '%S \"*my-anything*\")) " anything-sources)) (eval-last-sexp nil) (substitute-key-definition 'anything 'my-anything global-map) (pop-to-buffer (current-buffer)))) ;; (@* "Utility: Incremental search within results (unmaintained)") (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-deferred-action-list nil "Original value of deferred-action-list 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. (UNMAINTAINED)" (interactive) (if (anything-empty-buffer-p (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-deferred-action-list (default-value 'deferred-action-list)) (setq-default deferred-action-list nil) (add-hook 'deferred-action-list '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-event))) (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 deferred-action-list anything-isearch-original-deferred-action-list) (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 (unmaintained)") (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 (UNMAINTAINED). 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. Some key bindings in `anything-map' are modified. See also `anything-iswitchb-setup-keys'." (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)) (anything-iswitchb-setup-keys) (message "Iswitchb integration is activated.")) (defun anything-iswitchb-setup-keys () "Modify `anything-map' for anything-iswitchb users. 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. Binding M-s is used instead of C-s, because C-s has a binding in iswitchb. You can rebind it AFTER `anything-iswitchb-setup'. Unbind C-r to prevent problems during anything-isearch." (define-key anything-map (kbd "C-s") nil) (define-key anything-map (kbd "M-p") nil) (define-key anything-map (kbd "M-n") nil) (define-key anything-map (kbd "M-v") nil) (define-key anything-map (kbd "C-v") nil) (define-key anything-map (kbd "C-p") 'anything-previous-history-element) (define-key anything-map (kbd "C-n") 'anything-next-history-element) (define-key anything-map (kbd "M-s") nil) (define-key anything-map (kbd "M-s") 'anything-isearch) (define-key anything-map (kbd "C-r") nil)) (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 'deferred-action-list 'anything-iswitchb-check-input))) (defun anything-iswitchb-minibuffer-exit () (remove-hook 'minibuffer-exit-hook 'anything-iswitchb-minibuffer-exit) (remove-hook 'deferred-action-list '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 (anything-empty-buffer-p anything-buffer) 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))))) ;; (@* "CUA workaround") (defadvice cua-delete-region (around anything-avoid-cua activate) (ignore-errors ad-do-it)) (defadvice copy-region-as-kill (around anything-avoid-cua activate) (if cua-mode (ignore-errors ad-do-it) ad-do-it)) ;;(@* "Attribute Documentation") (defun anything-describe-anything-attribute (anything-attribute) "Display the full documentation of ANYTHING-ATTRIBUTE (a symbol)." (interactive (list (intern (completing-read "Describe anything attribute: " (mapcar 'symbol-name anything-additional-attributes))))) (with-output-to-temp-buffer "*Help*" (princ (get anything-attribute 'anything-attrdoc)))) (anything-document-attribute '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. ") (anything-document-attribute '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. ") (anything-document-attribute '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 whose members are strings, symbols or (DISPLAY . REAL) pairs. In case of (DISPLAY . REAL) pairs, 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. 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'. ") (anything-document-attribute 'action "mandatory if type attribute is not provided" " It is a list of (DISPLAY . FUNCTION) pairs or FUNCTION. 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. ") (anything-document-attribute 'coerce "optional" " It's a function called with one argument: the selected candidate. This function is intended for type convertion. In normal case, the selected candidate (string) is passed to action function. If coerce function is specified, it is called just before action function. Example: converting string to symbol (coerce . intern) ") (anything-document-attribute '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. ") (anything-document-attribute '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. ") (anything-document-attribute 'delayed-init "optional" " Function called with no parameters before candidate function is called. It is similar with `init' attribute, but its evaluation is deferred. It is useful to combine with ") (anything-document-attribute '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. ") (anything-document-attribute 'candidate-transformer "optional" " It's a function or a list of functions 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. If it is a list of functions, it calls each function sequentially. This can be used to transform or remove items from the list of candidates. Note that `candidates' is run already, so the given transformer function should also be able to handle candidates with (DISPLAY . REAL) format. ") (anything-document-attribute '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 `candidates' and `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. ") (anything-document-attribute 'action-transformer "optional" " It's a function or a list of functions 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. If it is a list of functions, it calls each function sequentially. The function should return a transformed action list. This can be used to customize the list of actions based on the currently selected candidate. ") (anything-document-attribute 'pattern-transformer "optional" " It's a function or a list of functions called with one argument before computing matches. Its argument is `anything-pattern'. Functions should return transformed `anything-pattern'. It is useful to change interpretation of `anything-pattern'. ") (anything-document-attribute 'delayed "optional" " Candidates from the source are shown only if the user stops typing and is idle for `anything-idle-delay' seconds. ") (anything-document-attribute '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. ") (anything-document-attribute '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. ") (anything-document-attribute '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. ") (anything-document-attribute '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. ") (anything-document-attribute '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. ") (anything-document-attribute '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. ") (anything-document-attribute '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'. ") (anything-document-attribute '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. ") (anything-document-attribute 'real-to-display "optional" " Function called with one parameter; the selected candidate. The inverse of display-to-real attribute. The function transforms the selected candidate, which is passed to the action function, for display. The real-to-display attribute provides the other 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 DISPLAY can be generated from REAL, real-to-display is more convenient. Note that DISPLAY parts returned from candidates / candidate-transformer are IGNORED as the name `display-to-real' says. ") (anything-document-attribute '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. ") (anything-document-attribute 'candidate-number-limit "optional" " Override `anything-candidate-number-limit' only for this source. ") (anything-document-attribute 'accept-empty "optional" " Pass empty string \"\" to action function. ") (anything-document-attribute 'disable-shortcuts "optional" " Disable `anything-enable-shortcuts' in current `anything' session. This attribute is implemented by plug-in. ") (anything-document-attribute 'dummy "optional" " Set `anything-pattern' to candidate. If this attribute is specified, The candidates attribute is ignored. This attribute is implemented by plug-in. This plug-in implies disable-shortcuts plug-in. ") (anything-document-attribute 'multiline "optional" " Enable to selection multiline candidates. ") (anything-document-attribute 'update "optional" " Function called with no parameters when \\\\[anything-force-update] is pressed. ") (anything-document-attribute 'mode-line "optional" " source local `anything-mode-line-string'. (included in `mode-line-format') It accepts also variable/function name. ") (anything-document-attribute 'header-line "optional" " source local `header-line-format'. It accepts also variable/function name. ") (anything-document-attribute 'resume "optional" " Function called with no parameters when `anything-resume' is started.") ;; (@* "Bug Report") (defvar anything-maintainer-mail-address (concat "rubiki" "tch@ru" "by-lang.org")) (defvar anything-bug-report-salutation "Describe bug below, using a precise recipe. When I executed M-x ... How to send a bug report: 1) Be sure to use the LATEST version of anything.el. 2) Enable debugger. M-x toggle-debug-on-error or (setq debug-on-error t) 3) Use Lisp version instead of compiled one: (load \"anything.el\") 4) If you got an error, please paste *Backtrace* buffer. 5) Type C-c C-c to send. # If you are a Japanese, please write in Japanese:-)") (defvar anything-no-dump-variables '(anything-candidate-buffer-alist anything-digit-overlays anything-help-message anything-candidate-cache ) "Variables not to dump in bug report.") (defun anything-dumped-variables-in-bug-report () (let ((hash (make-hash-table))) (loop for var in (apropos-internal "anything-" 'boundp) for vname = (symbol-name var) unless (or (string-match "-map$" vname) (string-match "^anything-c-source-" vname) (string-match "-hash$" vname) (string-match "-face$" vname) (memq var anything-no-dump-variables)) collect var))) (defun anything-send-bug-report () "Send a bug report of anything.el." (interactive) (with-current-buffer (or anything-last-buffer (current-buffer)) (reporter-submit-bug-report anything-maintainer-mail-address "anything.el" (anything-dumped-variables-in-bug-report) nil nil anything-bug-report-salutation))) (defun anything-send-bug-report-from-anything () "Send a bug report of anything.el in anything session." (interactive) (anything-run-after-quit 'anything-send-bug-report)) ;; (@* "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-shortcuts anything-candidate-cache (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-1 nil input sources) (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 anything-log-run-hook => 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-interpret-value") (expect "literal" (anything-interpret-value "literal")) (expect "lambda" (anything-interpret-value (lambda () "lambda"))) (expect "lambda with source name" (let ((source '((name . "lambda with source name")))) (anything-interpret-value (lambda () anything-source-name) source))) (expect "function symbol" (flet ((f () "function symbol")) (anything-interpret-value 'f))) (expect "variable symbol" (let ((v "variable symbol")) (anything-interpret-value 'v))) (expect (error error *) (anything-interpret-value 'unbounded-1)) (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")))))) (expect '("foo" "bar") (let ((var '("foo" "bar"))) (anything-get-candidates '((name . "foo") (candidates . var))))) (expect (error error *) (anything-get-candidates '((name . "foo") (candidates . "err")))) (expect (error error *) (let ((var "err")) (anything-get-candidates '((name . "foo") (candidates . var))))) (expect (error error *) (anything-get-candidates '((name . "foo") (candidates . unDeFined-syMbol)))) (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))))) (expect '(a b c) (let ((anything-pattern "[abc]") anything-candidate-number-limit) (anything-compute-matches '((name . "FOO") (candidates a b c) (volatile))))) (expect '(("foo" . "FOO") ("bar" . "BAR")) (let ((anything-pattern "")) (anything-compute-matches '((name . "FOO") (candidates ("foo" . "FOO") ("bar" . "BAR")) (volatile))))) (expect '(("foo" . "FOO")) (let ((anything-pattern "foo")) (anything-compute-matches '((name . "FOO") (candidates ("foo" . "FOO") ("bar" . "foo")) (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")) (expect "TestSource" (let (x) (anything-test-candidates '(((name . "TestSource") (candidates "a") (match (lambda (c) (setq x anything-source-name))))) "a") x)) (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-transform-candidates in process") (expect (mock (anything-composed-funcall-with-source '((name . "FOO") (candidates "foo" "bar") (filtered-candidate-transformer . (lambda (cands src) (mapcar 'upcase cands)))) (lambda (cands src) (mapcar 'upcase cands)) '("foo" "bar") '((name . "FOO") (candidates "foo" "bar") (filtered-candidate-transformer . (lambda (cands src) (mapcar 'upcase cands)))) t)) (stub anything-process-candidate-transformer => '("foo" "bar")) (anything-transform-candidates '("foo" "bar") '((name . "FOO") (candidates "foo" "bar") (filtered-candidate-transformer . (lambda (cands src) (mapcar 'upcase cands)))) t) ) (desc "anything-candidates-in-buffer-1") (expect nil (anything-candidates-in-buffer-1 nil "" 'buffer-substring-no-properties '(re-search-forward) 50 nil)) (expect '("foo+" "bar+" "baz+") (with-temp-buffer (insert "foo+\nbar+\nbaz+\n") (anything-candidates-in-buffer-1 (current-buffer) "" 'buffer-substring-no-properties '(re-search-forward) 5 nil))) (expect '("foo+" "bar+") (with-temp-buffer (insert "foo+\nbar+\nbaz+\n") (anything-candidates-in-buffer-1 (current-buffer) "" 'buffer-substring-no-properties '(re-search-forward) 2 nil))) (expect '("foo+") (with-temp-buffer (insert "foo+\nbar+\nbaz+\n") (anything-candidates-in-buffer-1 (current-buffer) "oo\\+" 'buffer-substring-no-properties '(re-search-forward) 50 nil))) (expect '("foo+") (with-temp-buffer (insert "foo+\nbar+\nbaz+\n") (anything-candidates-in-buffer-1 (current-buffer) "oo+" #'buffer-substring-no-properties '(search-forward) 50 nil))) (expect '("foo+" "bar+") (with-temp-buffer (insert "foo+\nbar+\nbaz+\n") (anything-candidates-in-buffer-1 (current-buffer) "." 'buffer-substring-no-properties '(re-search-forward) 2 nil))) (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)))) '(re-search-forward) 50 nil))) (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\\+")) ;; BUG remain empty string, but the pattern is rare case. (expect '(("a" ("" "a" "b"))) (anything-test-candidates '(((name . "a") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "a\nb\n")))) (candidates-in-buffer))) "a*")) (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)))))) (expect "buf1" (let (anything-candidate-buffer-alist (anything-source-name "foo") (buf1 (get-buffer-create "buf1")) (buf2 (get-buffer-create "buf2"))) (anything-candidate-buffer buf1) (anything-candidate-buffer buf2) (prog1 (buffer-name (anything-candidate-buffer buf1)) (kill-buffer buf1) (kill-buffer buf2)))) (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-get-default-action") (expect 'upcase (anything-get-default-action '(("upcase" . upcase)))) (expect 'downcase (anything-get-default-action '(("downcase" . downcase)))) (expect (lambda (x) (capitalize x)) (anything-get-default-action (lambda (x) (capitalize x)))) (expect 'identity (anything-get-default-action 'identity)) (desc "anything-execute-selection-action") (expect "FOO" (anything-execute-selection-action "foo" '(("upcase" . upcase)) nil)) (expect "FOO" (anything-execute-selection-action "foo" '(("upcase" . (lambda (c) (upcase c)))) nil)) (desc "display-to-real attribute") (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*") (expect "generic" (let (v (value1 "generic")) (anything-test-candidates '(((name . "FOO") (hoge . value1) (init . (lambda () (setq v (anything-attr* 'hoge))))))) 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 anything-log-run-hook) ;; (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 anything-log-run-hook) (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 "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))) (expect '(((name . "test"))) (anything-normalize-sources '((name . "test")))) (expect '(((name . "test"))) (anything-normalize-sources '(((name . "test"))))) (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 '("a" "b" "c" "d") (let ((anything-pattern "[abcd]") (anything-candidate-number-limit 2)) (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c" "d") (candidate-number-limit) (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))) (expect '((lambda ())) (anything-mklist (lambda ()))) (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))) "\\+")) (expect '(("a" ("c2" "c1"))) (anything-test-candidates '(((name . "a") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "c1\nc2\n")))) (search-from-end) (candidates-in-buffer))))) ;; BUG remain empty string, but the pattern is rare case. (expect '(("a" ("c" "b" "a" ""))) (anything-test-candidates '(((name . "a") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "a\nb\nc\n")))) (search-from-end) (candidates-in-buffer))) "a*")) (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)) (desc "anything-execute-action-at-once-if-once") (expect "HOGE" (let ((anything-execute-action-at-once-if-one t)) (anything '(((name . "one test1") (candidates "hoge") (action . upcase)))))) (expect "ANY" (let ((anything-execute-action-at-once-if-one t)) (anything '(((name . "one test2") (candidates "hoge" "any") (action . upcase))) "an"))) ;; candidates > 1 (expect (mock (read-string "word: " nil)) (let ((anything-execute-action-at-once-if-one t)) (anything '(((name . "one test3") (candidates "hoge" "foo" "bar") (action . identity))) nil "word: "))) (desc "anything-quit-if-no-candidate") (expect nil (let ((anything-quit-if-no-candidate t)) (anything '(((name . "zero test1") (candidates) (action . upcase)))))) (expect 'called (let (v (anything-quit-if-no-candidate (lambda () (setq v 'called)))) (anything '(((name . "zero test2") (candidates) (action . upcase)))) v)) (desc "real-to-display attribute") (expect '(("test" (("DDD" . "ddd")))) (anything-test-candidates '(((name . "test") (candidates "ddd") (real-to-display . upcase) (action . identity))))) (expect '(("test" (("DDD" . "ddd")))) (anything-test-candidates '(((name . "test") (candidates ("ignored" . "ddd")) (real-to-display . upcase) (action . identity))))) (expect '(("Commands" (("xxxhoge" . "hoge") ("xxxboke" . "boke")))) (anything-test-candidates '(((name . "Commands") (candidates "hoge" "boke") (real-to-display . (lambda (x) (concat "xxx" x))) (action . identity))) "xxx")) (expect "test\nDDD\n" (anything-test-update '(((name . "test") (candidates "ddd") (real-to-display . upcase) (action . identity))) "") (with-current-buffer (anything-buffer-get) (buffer-string))) (desc "real-to-display and candidate-transformer attribute") (expect '(("test" (("DDD" . "ddd")))) (anything-test-candidates '(((name . "test") (candidates "ddd") (candidate-transformer (lambda (cands) (mapcar (lambda (c) (cons "X" c)) cands))) (real-to-display . upcase) (action . identity))))) (expect "test\nDDD\n" (anything-test-update '(((name . "test") (candidates "ddd") (candidate-transformer (lambda (cands) (mapcar (lambda (c) (cons "X" c)) cands))) (real-to-display . upcase) (action . identity))) "") (with-current-buffer (anything-buffer-get) (buffer-string))) (desc "real-to-display and candidates-in-buffer") (expect '(("test" (("A" . "a") ("B" . "b")))) (anything-test-candidates '(((name . "test") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (erase-buffer) (insert "a\nb\n")))) (candidates-in-buffer) (real-to-display . upcase) (action . identity))))) (expect "test\nA\nB\n" (stub read-string) (anything '(((name . "test") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (erase-buffer) (insert "a\nb\n")))) (candidates-in-buffer) (real-to-display . upcase) (action . identity)))) (with-current-buffer (anything-buffer-get) (buffer-string))) (desc "Symbols are acceptable as candidate.") (expect '(("test" (sym "str"))) (anything-test-candidates '(((name . "test") (candidates sym "str"))))) (expect '(("test" ((sym . realsym) ("str" . "realstr")))) (anything-test-candidates '(((name . "test") (candidates (sym . realsym) ("str" . "realstr")))))) (expect '(("test" (sym))) (anything-test-candidates '(((name . "test") (candidates sym "str"))) "sym")) (expect '(("test" ("str"))) (anything-test-candidates '(((name . "test") (candidates sym "str"))) "str")) (expect '(("test" ((sym . realsym)))) (anything-test-candidates '(((name . "test") (candidates (sym . realsym) ("str" . "realstr")))) "sym")) (expect '(("test" (("str" . "realstr")))) (anything-test-candidates '(((name . "test") (candidates (sym . realsym) ("str" . "realstr")))) "str")) (desc "multiple transformers") (expect '(("test" (""))) (anything-test-candidates '(((name . "test") (candidates "foo") (candidate-transformer . (lambda (cands) (anything-compose (list cands) (list (lambda (c) (mapcar 'upcase c)) (lambda (c) (list (concat "<" (car c) ">"))))))))))) (expect '("") (anything-composed-funcall-with-source '((name . "test")) (list (lambda (c) (mapcar 'upcase c)) (lambda (c) (list (concat "<" (car c) ">")))) '("foo")) ) (expect '(("test" (""))) (anything-test-candidates '(((name . "test") (candidates "foo") (candidate-transformer (lambda (c) (mapcar 'upcase c)) (lambda (c) (list (concat "<" (car c) ">")))))))) (expect '(("test" (""))) (anything-test-candidates '(((name . "test") (candidates "bar") (filtered-candidate-transformer (lambda (c s) (mapcar 'upcase c)) (lambda (c s) (list (concat "<" (car c) ">")))))))) (expect '(("find-file" . find-file) ("view-file" . view-file)) (stub zerop => nil) (stub anything-get-current-source => '((name . "test") (action) (action-transformer . (lambda (a s) (anything-compose (list a s) (list (lambda (a s) (push '("view-file" . view-file) a)) (lambda (a s) (push '("find-file" . find-file) a)))))))) (anything-get-action)) (expect '(("find-file" . find-file) ("view-file" . view-file)) (stub zerop => nil) (stub anything-get-current-source => '((name . "test") (action) (action-transformer (lambda (a s) (push '("view-file" . view-file) a)) (lambda (a s) (push '("find-file" . find-file) a))))) (anything-get-action)) (desc "define-anything-type-attribute") (expect '((file (action . find-file))) (let (anything-type-attributes) (define-anything-type-attribute 'file '((action . find-file))) anything-type-attributes)) (expect '((file (action . find-file))) (let ((anything-type-attributes '((file (action . view-file))))) (define-anything-type-attribute 'file '((action . find-file))) anything-type-attributes)) (expect '((file (action . find-file)) (buffer (action . switch-to-buffer))) (let (anything-type-attributes) (define-anything-type-attribute 'buffer '((action . switch-to-buffer))) (define-anything-type-attribute 'file '((action . find-file))) anything-type-attributes)) (desc "anything-approximate-candidate-number") (expect 0 (with-temp-buffer (let ((anything-buffer (current-buffer))) (anything-approximate-candidate-number)))) (expect 1 (with-temp-buffer (let ((anything-buffer (current-buffer))) (insert "Title\n" "candiate1\n") (anything-approximate-candidate-number)))) (expect t (with-temp-buffer (let ((anything-buffer (current-buffer))) (insert "Title\n" "candiate1\n" "candiate2\n") (<= 2 (anything-approximate-candidate-number))))) (expect 1 (with-temp-buffer (let ((anything-buffer (current-buffer))) (insert "Title\n" (propertize "multi\nline\n" 'anything-multiline t)) (anything-approximate-candidate-number)))) (expect t (with-temp-buffer (let ((anything-buffer (current-buffer)) (anything-candidate-separator "-----")) (insert "Title\n" (propertize "multi\nline1\n" 'anything-multiline t) "-----\n" (propertize "multi\nline2\n" 'anything-multiline t)) (<= 2 (anything-approximate-candidate-number))))) (desc "delayed-init attribute") (expect 0 (let ((value 0)) (anything-test-candidates '(((name . "test") (delayed-init . (lambda () (incf value))) (candiates "abc") (requires-pattern . 2))) "") value)) (expect 1 (let ((value 0)) (anything-test-candidates '(((name . "test") (delayed-init . (lambda () (incf value))) (candiates "abc") (requires-pattern . 2))) "abc") value)) (expect 2 (let ((value 0)) (anything-test-candidates '(((name . "test") (delayed-init (lambda () (incf value)) (lambda () (incf value))) (candiates "abc") (requires-pattern . 2))) "abc") value)) (expect t (let (value) (with-temp-buffer (anything-test-candidates '(((name . "test") (delayed-init . (lambda () (setq value (eq anything-current-buffer (current-buffer))))) (candiates "abc") (requires-pattern . 2))) "abc") value))) (desc "pattern-transformer attribute") (expect '(("test2" ("foo")) ("test3" ("bar"))) (anything-test-candidates '(((name . "test1") (candidates "foo" "bar")) ((name . "test2") (pattern-transformer . (lambda (pat) (substring pat 1))) (candidates "foo" "bar")) ((name . "test3") (pattern-transformer . (lambda (pat) "bar")) (candidates "foo" "bar"))) "xfoo")) (expect '(("test2" ("foo")) ("test3" ("bar"))) (anything-test-candidates '(((name . "test1") (candidates "foo" "bar")) ((name . "test2") (pattern-transformer (lambda (pat) (substring pat 1))) (candidates "foo" "bar")) ((name . "test3") (pattern-transformer (lambda (pat) "bar")) (candidates "foo" "bar"))) "xfoo")) (expect '(("test2" ("foo")) ("test3" ("bar"))) (anything-test-candidates '(((name . "test1") (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "foo\nbar\n")))) (candidates-in-buffer)) ((name . "test2") (pattern-transformer . (lambda (pat) (substring pat 1))) (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "foo\nbar\n")))) (candidates-in-buffer)) ((name . "test3") (pattern-transformer . (lambda (pat) "bar")) (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global) (insert "foo\nbar\n")))) (candidates-in-buffer))) "xfoo")) (desc "anything-recent-push") (expect '("foo" "bar" "baz") (let ((lst '("bar" "baz"))) (anything-recent-push "foo" 'lst))) (expect '("foo" "bar" "baz") (let ((lst '("foo" "bar" "baz"))) (anything-recent-push "foo" 'lst))) (expect '("foo" "bar" "baz") (let ((lst '("bar" "foo" "baz"))) (anything-recent-push "foo" 'lst))) (desc "anything-require-at-least-version") (expect nil (anything-require-at-least-version "1.1")) (expect nil (anything-require-at-least-version "1.200")) (expect nil (anything-require-at-least-version (and (string-match "1\.\\([0-9]+\\)" anything-version) (match-string 0 anything-version)))) (expect (error) (anything-require-at-least-version "1.999")) (expect (error) (anything-require-at-least-version "1.2000")) (desc "anything-once") (expect 2 (let ((i 0)) (anything-test-candidates '(((name . "1") (init . (lambda () (incf i)))) ((name . "2") (init . (lambda () (incf i)))))) i)) (expect 1 (let ((i 0)) (anything-test-candidates '(((name . "1") (init . (lambda () (anything-once (lambda () (incf i)))))) ((name . "2") (init . (lambda () (anything-once (lambda () (incf i)))))))) i)) (expect 1 (let ((i 0)) (flet ((init1 () (anything-once (lambda () (incf i))))) (anything-test-candidates '(((name . "1") (init . init1)) ((name . "2") (init . init1))))) i)) (desc "anything-marked-candidates") (expect '("mark3" "mark1") (let* ((source '((name . "mark test"))) (anything-marked-candidates `((,source . "mark1") (((name . "other")) . "mark2") (,source . "mark3")))) (stub anything-buffer-get => (current-buffer)) (stub anything-get-current-source => source) (anything-marked-candidates))) (expect '("current") (let* ((source '((name . "mark test"))) (anything-marked-candidates nil)) (stub anything-get-current-source => source) (stub anything-get-selection => "current") (anything-marked-candidates))) (desc "anything-marked-candidates with coerce") (expect '(mark3 mark1) (let* ((source '((name . "mark test") (coerce . intern))) (anything-marked-candidates `((,source . "mark1") (((name . "other")) . "mark2") (,source . "mark3")))) (stub anything-buffer-get => (current-buffer)) (stub anything-get-current-source => source) (anything-marked-candidates))) (desc "anything-let") (expect '(1 10000 nil) (let ((a 9999) (b 8) (c) (anything-buffer (exps-tmpbuf))) (anything-let ((a 1) (b (1+ a)) c) (anything-create-anything-buffer)) (with-current-buffer anything-buffer (list a b c)))) (expect (non-nil) (let ((a 9999) (b 8) (c) (anything-buffer (exps-tmpbuf))) (anything-let ((a 1) (b (1+ a)) c) (anything-create-anything-buffer)) (with-current-buffer anything-buffer (and (assq 'a (buffer-local-variables)) (assq 'b (buffer-local-variables)) (assq 'c (buffer-local-variables)))))) (expect 'retval (let ((a 9999) (b 8) (c) (anything-buffer (exps-tmpbuf))) (anything-let ((a 1) (b (1+ a)) c) 'retval))) (desc "anything-let*") (expect '(1 2 nil) (let ((a 9999) (b 8) (c) (anything-buffer (exps-tmpbuf))) (anything-let* ((a 1) (b (1+ a)) c) (anything-create-anything-buffer)) (with-current-buffer anything-buffer (list a b c)))) (expect (non-nil) (let ((a 9999) (b 8) (c) (anything-buffer (exps-tmpbuf))) (anything-let* ((a 1) (b (1+ a)) c) (anything-create-anything-buffer)) (with-current-buffer anything-buffer (and (assq 'a (buffer-local-variables)) (assq 'b (buffer-local-variables)) (assq 'c (buffer-local-variables)))))) (expect 'retval* (let ((a 9999) (b 8) (c) (anything-buffer (exps-tmpbuf))) (anything-let* ((a 1) (b (1+ a)) c) 'retval*))) (desc "anything with keyword") (expect (mock (anything-internal 'test-source "input" "prompt: " nil "preselect" "*test*" nil)) (anything :sources 'test-source :input "input" :prompt "prompt: " :resume nil :preselect "preselect" :buffer "*test*" :keymap nil)) (expect (mock (anything-internal 'test-source nil nil nil nil "*test*" nil)) (anything :sources 'test-source :buffer "*test*" :candidate-number-limit 20)) (expect (mock (anything-internal 'test-source nil nil nil nil "*test*" nil)) (anything 'test-source nil nil nil nil "*test*" nil)) (desc "anything-log-eval-internal") (expect (mock (anything-log "%S = %S" '(+ 1 2) 3)) (anything-log-eval-internal '((+ 1 2)))) (expect (mock (anything-log "%S = ERROR!" 'unDeFined)) (anything-log-eval-internal '(unDeFined))) (desc "anything-output-filter--collect-candidates") (expect '("a" "b" "") (split-string "a\nb\n" "\n")) (expect '("a" "b") (anything-output-filter--collect-candidates '("a" "b" "") (cons 'incomplete-line ""))) (expect '("a" "b") (split-string "a\nb" "\n")) (expect '("a") (anything-output-filter--collect-candidates '("a" "b") (cons 'incomplete-line ""))) (expect '(incomplete-line . "b") (let ((incomplete-line-info (cons 'incomplete-line ""))) (anything-output-filter--collect-candidates '("a" "b") incomplete-line-info) incomplete-line-info)) (expect '("" "c" "") (split-string "\nc\n" "\n")) (expect '("b" "c") ;; "a\nb" + "\nc\n" (let ((incomplete-line-info (cons 'incomplete-line ""))) (anything-output-filter--collect-candidates '("a" "b") incomplete-line-info) (anything-output-filter--collect-candidates '("" "c" "") incomplete-line-info))) (desc "coerce attribute") (expect "string" (anything :sources '(((name . "test") (candidates "string") (action . identity))) :execute-action-at-once-if-one t)) (expect 'symbol (anything :sources '(((name . "test") (candidates "symbol") (coerce . intern) (action . identity))) :execute-action-at-once-if-one t)) (expect 'real (anything :sources '(((name . "test") (candidates ("display" . "real")) (coerce . intern) (action . identity))) :execute-action-at-once-if-one t)) (expect 'real (anything :sources '(((name . "test") (candidates) (candidate-transformer (lambda (c) '(("display" . "real")))) (coerce . intern) (action . identity))) :execute-action-at-once-if-one t)) (expect 'real (anything :sources '(((name . "test") (candidates) (filtered-candidate-transformer (lambda (c s) '(("display" . "real")))) (coerce . intern) (action . identity))) :execute-action-at-once-if-one t)) (expect 'real (anything :sources '(((name . "test") (candidates "dummy") (display-to-real (lambda (disp) "real")) (coerce . intern) (action . identity))) :execute-action-at-once-if-one t)) (desc "anything-next-point-in-list") (expect 10 (anything-next-point-in-list 5 '(10 20) nil)) (expect 20 (anything-next-point-in-list 15 '(10 20) nil)) (expect 25 (anything-next-point-in-list 25 '(10 20) nil)) (expect 5 (anything-next-point-in-list 5 '(10 20) t)) (expect 10 (anything-next-point-in-list 15 '(10 20) t)) (expect 20 (anything-next-point-in-list 25 '(10 20) t)) (expect 5 (anything-next-point-in-list 5 '() nil)) (expect 5 (anything-next-point-in-list 5 '() t)) (expect 10 (anything-next-point-in-list 5 '(10) nil)) (expect 10 (anything-next-point-in-list 15 '(10) t)) (expect 20 (anything-next-point-in-list 10 '(10 20) nil)) (expect 10 (anything-next-point-in-list 20 '(10 20) t)) (expect 20 (anything-next-point-in-list 30 '(10 20 30) t)) ))) (provide 'anything) ;; How to save (DO NOT REMOVE!!) ;; (progn (magit-push) (emacswiki-post "anything.el")) ;;; anything.el ends here anything-el-1.287/ipa.el0000644000175000017500000005106711447253044014370 0ustar takayatakaya;;; ipa.el --- In-place annotations ;; Copyright (C) 2007 Tamas Patrovics ;; 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: ;;; With this package you can add annotations to your files without ;;; modifying them. Each file can have multiple annotations at various ;;; buffer positions. The annotation texts are not parts of the files, ;;; they are stored separately. ;;; ;;; All annotations are stored in a common file, so searching ;;; annotations is trivial. ;;; ;;; ;;; Installation: ;;; ;;; (require 'ipa) ;;; ;;; ;;; The following commands can be used: ;;; ;;; ipa-insert - insert annotation at point ;;; ;;; ipa-edit - edit the first annotation after point ;;; (with universal argument: before point) ;;; ;;; ipa-next - goes to the next annotation in the buffer ;;; ;;; ipa-previous - goes to the previous annotation in the buffer ;;; ;;; ipa-move - move the first annotation after point ;;; (with universal argument: before point) ;;; ;;; ipa-toggle - hide/show annotations ;;; ;;; ipa-show - show all saved annotations for the current file ;;; (in the storage buffer you can press Enter on any ;;; annotation to go to its location) ;;; ;;; ipa-jump - jump to any annotation with id completion ;;; ;;; Annotations can optionally have ids in their ;;; text with the following format: [id]annotation-text ;;; ;;; The id itself doesn't appear in the annotated ;;; buffer. It only serves the purpose of giving a ;;; unique id to the annotation, so that you can jump ;;; to it quickly. ;;; ;;; If an annotation has an id, but no other text ;;; then it is effectively the same as a usual ;;; bookmark in emacs. ;;; ;;; Only annotations appearing in `ipa-file' can be ;;; jumped to, so unsaved annotations does not count. ;;; If there are more annotations defined with the ;;; same id then the first one found in `ipa-file' is ;;; used. ;;; ;;; ;;; Annotations are saved when the file itself is saved. If the file ;;; is not modified annotations are saved immediately when ;;; added/changed. ;;; ;; Tested on Emacs 22. ;;; Code: ;; User configuration (defvar ipa-file "~/.ipa" "File where annotations are stored, but see also `ipa-file-function'") (defvar ipa-file-function 'ipa-get-global-file "Function to get the name of the annotation storage file. By default it returns `ipa-file', but it can be used, for example, to use different storage files in each directory. See `ipa-get-directory-file'") (defvar ipa-context-size 16 "Length of before and after context of annotation position in characters used to reposition the annotation if the annotated file is changed behind Emacs's back.") (defvar ipa-annotation-face 'highlight "Face for annotations.") (defvar ipa-file-face 'header-line "Face for header lines in the IpA buffer.") ;;---------------------------------------------------------------------- (defvar ipa-annotations-in-buffer nil) (make-variable-buffer-local 'ipa-annotations-in-buffer) (defvar ipa-annotation-display t) (defconst ipa-line-continuation "|") (defconst ipa-file-marker "\f") (defconst ipa-file-regexp (concat "^" ipa-file-marker "\\s-*")) (defconst ipa-annotation-id-regexp "\\s-*\\[\\(.+\\)?\\]\\(.*\\)") (defvar ipa-pos-info-face '(face nil invisible t)) (defvar ipa-font-lock-keywords `((,(concat ipa-file-regexp "\\(.*\\)\n") . ipa-file-face) ("^|" . (0 ipa-annotation-face t)) (ipa-font-lock-pos-info . ((1 ipa-pos-info-face t) (2 ipa-annotation-face t))))) (define-derived-mode ipa-mode fundamental-mode "IPA" (set (make-local-variable 'font-lock-defaults) '(ipa-font-lock-keywords))) (define-key ipa-mode-map (kbd "") 'ipa-go-to-annotation) (defvar ipa-overriding-map (let ((map (make-sparse-keymap))) (define-key map (kbd "") 'ipa-move-left) (define-key map (kbd "") 'ipa-move-right) (define-key map (kbd "") 'ipa-move-line-up) (define-key map (kbd "") 'ipa-move-line-down) (define-key map (kbd "") 'ipa-move-page-up) (define-key map (kbd "") 'ipa-move-page-down) (define-key map (kbd "") 'ipa-move-finish) (define-key map (kbd "") 'ipa-move-cancel) (define-key map (kbd "h") 'ipa-move-help) map)) (defvar ipa-old-global-map nil) (defvar ipa-overlay-being-moved nil) (defvar ipa-original-position-of-overlay-being-moved nil) (defun ipa-insert () (interactive) (unless ipa-annotation-display (ipa-toggle)) (let ((text (read-string "text: "))) (if (equal text "") (message "Empty annotations are not inserted.") (ipa-create-overlay (point) text) (if (ipa-get-buffer-file-name) (ipa-save-annotations-if-necessary) (message "Annotations in this buffer will be saved only if you save the buffer as a file."))))) (defun ipa-edit (&optional arg) (interactive "P") (unless ipa-annotation-display (ipa-toggle)) (let ((annotation (if arg (ipa-previous) (ipa-next)))) (if annotation (let* ((text (read-string "text (empty to remove): " (cdr annotation)))) (if (equal text "") (progn (delete-overlay (car annotation)) (setq ipa-annotations-in-buffer (delq annotation ipa-annotations-in-buffer)) (message "Deleted annotation.")) (ipa-set-overlay-text (car annotation) text) (setcdr annotation text) (message "Updated annotation.")) (ipa-save-annotations-if-necessary t))))) (defun ipa-move (&optional arg) (interactive "P") (unless ipa-annotation-display (ipa-toggle)) (let ((annotation (if arg (ipa-previous) (ipa-next)))) (when annotation (setq ipa-overlay-being-moved (car annotation)) (setq ipa-original-position-of-overlay-being-moved (overlay-start ipa-overlay-being-moved)) (setq ipa-old-global-map global-map) (use-global-map ipa-overriding-map) (setq overriding-terminal-local-map ipa-overriding-map) (add-hook 'post-command-hook 'ipa-show-help)))) (defun ipa-show-help () (message (substitute-command-keys (concat "Press \\[ipa-move-help] for help, " "\\[ipa-move-cancel] to cancel.")))) (defun ipa-move-cancel () (interactive) (goto-char ipa-original-position-of-overlay-being-moved) (move-overlay ipa-overlay-being-moved (point) (point)) (ipa-cleanup) (message "Moving of annotation is canceled.")) (defun ipa-move-help () (interactive) (tooltip-show (substitute-command-keys "\\{ipa-overriding-map}"))) (defun ipa-move-finish () (interactive) (ipa-cleanup) (ipa-sort-overlays) (ipa-save-annotations-if-necessary)) (defun ipa-cleanup () (interactive) (use-global-map ipa-old-global-map) (setq overriding-terminal-local-map nil) (remove-hook 'post-command-hook 'ipa-show-help)) (defun ipa-move-left () (interactive) (ipa-move-overlay 'backward-char)) (defun ipa-move-right () (interactive) (ipa-move-overlay 'forward-char)) (defun ipa-move-line-up () (interactive) (ipa-move-overlay 'previous-line)) (defun ipa-move-line-down () (interactive) (ipa-move-overlay 'next-line)) (defun ipa-move-page-up () (interactive) (ipa-move-overlay 'scroll-down)) (defun ipa-move-page-down () (interactive) (ipa-move-overlay 'scroll-up)) (defun ipa-move-overlay (movefunc) (condition-case nil (funcall movefunc) (beginning-of-buffer (goto-char (point-min))) (end-of-buffer (goto-char (point-max)))) (move-overlay ipa-overlay-being-moved (point) (point))) (defun ipa-next () (interactive) (unless ipa-annotation-display (ipa-toggle)) (let ((annotations ipa-annotations-in-buffer) annotation) (while (and annotations (not annotation)) (if (> (overlay-start (car (car annotations))) (point)) (setq annotation (car annotations)) (pop annotations))) (if (not annotation) (message "No annotations found after point.") (goto-char (overlay-start (car annotation))) (ipa-warn-if-annotation-is-empty (car annotation))) annotation)) (defun ipa-previous () (interactive) (unless ipa-annotation-display (ipa-toggle)) (let ((annotations ipa-annotations-in-buffer) (continue t) annotation) (while (and annotations continue) (if (> (overlay-start (car (car annotations))) (point)) (setq continue nil) (setq annotation (pop annotations)))) (if (not annotation) (message "No annotations found before point.") (goto-char (1- (overlay-start (car annotation)))) (ipa-warn-if-annotation-is-empty (car annotation))) annotation)) (defun ipa-warn-if-annotation-is-empty (overlay) (if (equal (overlay-get overlay 'before-string) "") (message "The text of this annotation is empty."))) (defun ipa-toggle (&optional arg) (interactive "P") (setq ipa-annotation-display (if arg (> (prefix-numeric-value arg) 0) (not ipa-annotation-display))) (if ipa-annotation-display (dolist (buffer (buffer-list)) (with-current-buffer buffer (dolist (annotation ipa-annotations-in-buffer) (ipa-set-overlay-text (car annotation) (cdr annotation)) (message "Annotations are shown.")))) (dolist (buffer (buffer-list)) (with-current-buffer buffer (dolist (annotation ipa-annotations-in-buffer) (ipa-set-overlay-text (car annotation) "") (message "Annotations are hidden.")))))) (defun ipa-show () (interactive) (if (not (ipa-get-buffer-file-name)) (message "This buffer has no associated file.") (let ((filename (ipa-get-buffer-file-name))) (with-current-buffer (ipa-find-storage-file) (goto-char (point-min)) (if (re-search-forward (concat ipa-file-regexp filename "\n") nil t) (switch-to-buffer (current-buffer)) (message "No annotations found for file.")))))) (defun ipa-save-annotations-in-buffer (&optional even-if-empty) (when (or ipa-annotations-in-buffer even-if-empty) (let ((filename (ipa-get-buffer-file-name)) (buffer (current-buffer)) (annotations ipa-annotations-in-buffer)) (with-current-buffer (ipa-find-storage-file) (save-excursion (goto-char (point-min)) (unless (re-search-forward (concat ipa-file-regexp filename "\n") nil t) (goto-char (point-max)) (insert ipa-file-marker " " filename "\n")) (let ((start (point))) (if (re-search-forward ipa-file-regexp nil t) (beginning-of-line) (goto-char (point-max))) (delete-region start (point))) (if annotations (dolist (annotation annotations) (let* ((pos (overlay-start (car annotation))) (pos-info (with-current-buffer buffer (list 'pos pos 'before (if (>= (- pos (point-min)) ipa-context-size) (buffer-substring-no-properties (- pos ipa-context-size) pos)) 'after (if (>= (- (point-max) pos) ipa-context-size) (buffer-substring-no-properties pos (+ pos ipa-context-size))))))) (insert (let ((print-escape-newlines t)) (prin1-to-string pos-info)) ":" (replace-regexp-in-string "\n" (concat "\n" ipa-line-continuation) (cdr annotation)) "\n\n"))) ;; delete header (let ((end (point))) (forward-line -1) (delete-region (point) end))) (save-buffer) (message "Annotations saved.")))))) (add-hook 'after-save-hook 'ipa-save-annotations-in-buffer) (defun ipa-load-annotations-into-buffer () (let ((filename (ipa-get-buffer-file-name)) (buffer (current-buffer))) (with-current-buffer (ipa-find-storage-file) (save-excursion (goto-char (point-min)) (if (re-search-forward (concat ipa-file-regexp filename "\n") nil t) (let ((end (save-excursion (if (re-search-forward ipa-file-regexp nil t) (line-beginning-position) (point-max))))) (with-current-buffer buffer (setq ipa-annotations-in-buffer nil)) (let (text pos) (while (< (point) end) (if (and (not (looking-at ipa-line-continuation)) text) (with-current-buffer buffer (ipa-create-overlay pos text) (setq text nil) (setq pos nil))) (cond ((let ((pos-info (ipa-get-pos-info))) (when pos-info (let ((after (plist-get pos-info 'after)) (before (plist-get pos-info 'before))) (with-current-buffer buffer (save-excursion ;; using the same algorithm as bookmarks (goto-char (plist-get pos-info 'pos)) (if (and after (search-forward after nil t)) (goto-char (match-beginning 0))) (if (and before (search-backward before nil t)) (goto-char (match-end 0))) (setq pos (point))))) (if (looking-at ":\\(.+\\)") (setq text (match-string 1)) (error "Annotation storage format error")) ;; making it explicit t))) ((looking-at ipa-line-continuation) (setq text (concat text "\n" (buffer-substring (1+ (point)) (line-end-position))))) (t 'skip)) (forward-line 1))) (message "Resaving annotations so that positions are updated...") (with-current-buffer buffer (ipa-save-annotations-in-buffer)) (message "Annotations loaded."))))))) (add-hook 'find-file-hook 'ipa-load-annotations-into-buffer) (add-hook 'dired-after-readin-hook 'ipa-load-annotations-into-buffer) (defun ipa-get-pos-info () (and (looking-at "(") (read (current-buffer)))) (defun ipa-set-overlay-text (overlay text) (if (string-match ipa-annotation-id-regexp text) (setq text (match-string 2 text))) (overlay-put overlay 'before-string (if (equal text "") "" (propertize (concat "[" text "]") 'face ipa-annotation-face)))) (defun ipa-save-annotations-if-necessary (&optional even-if-empty) (if (and (ipa-get-buffer-file-name) (not (buffer-modified-p))) (ipa-save-annotations-in-buffer even-if-empty))) (defun ipa-create-overlay (pos text) (let ((overlay (make-overlay pos pos nil t nil))) (ipa-set-overlay-text overlay text) (push (cons overlay text) ipa-annotations-in-buffer) (ipa-sort-overlays))) (defun ipa-sort-overlays () (setq ipa-annotations-in-buffer (sort ipa-annotations-in-buffer (lambda (first second) (< (overlay-start (car first)) (overlay-start (car second))))))) (defun ipa-find-storage-file () (with-current-buffer (find-file-noselect (funcall ipa-file-function)) (ipa-mode) (current-buffer))) (defun ipa-get-global-file () ipa-file) (defun ipa-get-directory-file () (let ((current-file (ipa-get-buffer-file-name))) (if current-file (concat (if (file-directory-p current-file) current-file (file-name-directory current-file)) (file-name-nondirectory ipa-file))))) (defun ipa-go-to-annotation () (interactive) (cond ((save-excursion (beginning-of-line) (looking-at (concat ipa-file-regexp "\\(.*\\)"))) (unless ipa-annotation-display (ipa-toggle)) (find-file (match-string 1))) ((let ((pos-info (save-excursion (beginning-of-line) (ipa-get-pos-info)))) (when pos-info (save-excursion (if (not (re-search-backward ipa-file-regexp nil t)) (error "Containing file header is not found") (ipa-go-to-annotation) (goto-char (plist-get pos-info 'pos)) t))))) ((save-excursion (beginning-of-line) (looking-at ipa-line-continuation)) (save-excursion (if (re-search-backward "^(" nil t) (ipa-go-to-annotation) (error "Containing annotation is not found")))) (t (message "There is nothing on the current line.")))) (defun ipa-font-lock-pos-info (limit) (when (re-search-forward "^(" limit t) (beginning-of-line) (let ((sexp-start (point)) sexp-end colon-end) (forward-sexp) (setq sexp-end (point)) (forward-char) (setq colon-end (point)) (set-match-data (list sexp-start ;; whole colon-end sexp-start ;; sexp sexp-end sexp-end ;; colon colon-end))) t)) (defun ipa-jump () (interactive) (with-current-buffer (ipa-find-storage-file) (save-excursion (goto-char (point-min)) (let (ids) (while (re-search-forward "^(" nil t) (backward-char) (forward-sexp) (if (looking-at (concat ":" ipa-annotation-id-regexp)) (let ((id (match-string-no-properties 1))) (unless (some (lambda (id-info) (equal (car id-info) id)) ids) (push (cons id (point)) ids))))) (if ids (let ((selected (completing-read "Jump to annotation: " ids nil t))) (unless (equal selected "") (goto-char (assoc-default selected ids)) (ipa-go-to-annotation))) (message "There are no annotations with ids.")))))) (defun ipa-get-buffer-file-name () (let ((name (or (buffer-file-name) (save-excursion (goto-char (point-min)) (dired-current-directory))))) (if name (file-truename name)))) (provide 'ipa) ;;; ipa.el ends here anything-el-1.287/anything-grep.el0000644000175000017500000004156011447253044016370 0ustar takayatakaya;;; anything-grep.el --- search refinement of grep result with anything ;; $Id: anything-grep.el,v 1.27 2010-03-21 11:31:04 rubikitch Exp $ ;; Copyright (C) 2008, 2009, 2010 rubikitch ;; Author: rubikitch ;; Keywords: convenience, unix ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything-grep.el ;; 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: ;; Do grep in anything buffer. When we search information with grep, ;; we often narrow the candidates. Let's use `anything' to do it. ;;; Commands: ;; ;; Below are complete command list: ;; ;; `anything-grep' ;; Run grep in `anything' buffer to narrow results. ;; `anything-grep-by-name' ;; Do `anything-grep' from predefined location. ;; `anything-grep-by-name-reversed' ;; Do `anything-grep' from predefined location. ;; ;;; Customizable Options: ;; ;; Below are customizable option list: ;; ;; `anything-grep' is simple interface to grep a query. It asks ;; directory to grep. The grep process is synchronous process. You may ;; have to wait when you grep the target for the first time. But once ;; the target is on the disk cache, queries are grepped at lightning ;; speed. Even if older Pentium4 computer, grepping from 180MB takes ;; only 0.2s! GNU grep is amazingly fast. ;; `anything-grep-by-name' asks query and predefined location. It is ;; good idea to have ack (ack-grep), grep implemented in Perl, to ;; exclude unneeded files. Such as RCS, .svn and so on. ;; ack -- better than grep, a power search tool for programmers ;; http://petdance.com/ack/ ;;; History: ;; $Log: anything-grep.el,v $ ;; Revision 1.27 2010-03-21 11:31:04 rubikitch ;; Resume bug fix ;; ;; Revision 1.26 2010/03/21 11:13:30 rubikitch ;; `anything-grep' works asynchronously ;; ;; Revision 1.25 2010/03/21 06:34:25 rubikitch ;; New function: `anything-grep-by-name-reversed' ;; ;; Revision 1.24 2010/03/21 06:28:42 rubikitch ;; update copyright ;; ;; Revision 1.23 2010/03/21 06:28:32 rubikitch ;; refactoring ;; ;; Revision 1.22 2009/12/28 08:56:56 rubikitch ;; `anything-grep-by-name': INCOMPATIBLE!!! swap optional arguments ;; `anything-grep-by-name' can utilize `repeat-complex-command'. ;; ;; Revision 1.21 2009/12/18 11:01:11 rubikitch ;; `agrep-real-to-display': erase "nil" message ;; ;; Revision 1.20 2009/06/25 03:36:38 rubikitch ;; `agrep-real-to-display': avoid error ;; auto-document ;; ;; Revision 1.19 2009/02/03 21:06:49 rubikitch ;; fontify file name and line number. ;; New variable: `anything-grep-fontify-file-name' ;; ;; Revision 1.18 2009/02/03 20:48:12 rubikitch ;; multi-line support. ;; New variable: `anything-grep-multiline' ;; ;; Revision 1.17 2009/02/03 20:35:03 rubikitch ;; Use `anything-quit-if-no-candidate' not to open *anything* buffer when no matches found. ;; ;; Revision 1.16 2009/01/20 09:56:19 rubikitch ;; New variable: `anything-grep-filter-command' ;; ;; Revision 1.15 2009/01/03 07:04:30 rubikitch ;; copyright ;; ;; Revision 1.14 2009/01/02 16:00:07 rubikitch ;; * Fixed invalid value of `anything-grep-alist'. ;; * Implemented functionality to search all buffers with `buffer-file-name'. ;; See `anything-grep-alist'. ;; ;; Revision 1.13 2008/12/29 09:43:59 rubikitch ;; Rename variables: ;; `agrep-goto-hook' => `anything-grep-goto-hook' ;; `agrep-find-file-function' => `anything-grep-find-file-function' ;; ;; Revision 1.12 2008/12/29 09:40:23 rubikitch ;; document ;; ;; Revision 1.11 2008/12/29 07:58:37 rubikitch ;; refactoring ;; ;; Revision 1.10 2008/10/21 18:02:02 rubikitch ;; use *anything grep* buffer instead. ;; ;; Revision 1.9 2008/10/12 17:17:23 rubikitch ;; `anything-grep-by-name': swapped query order ;; ;; Revision 1.8 2008/10/09 00:33:40 rubikitch ;; New variable: `anything-grep-save-buffers-before-grep' ;; ;; Revision 1.7 2008/10/09 00:26:00 rubikitch ;; `anything-grep-by-name': nil argument ;; ;; Revision 1.6 2008/10/05 15:43:09 rubikitch ;; changed spec: `anything-grep-alist' ;; ;; Revision 1.5 2008/10/02 18:27:55 rubikitch ;; Use original fontify code instead of font-lock. ;; New variable: `agrep-find-file-function' ;; ;; Revision 1.4 2008/10/01 18:18:18 rubikitch ;; use ack-grep command to select files for search. ;; ;; Revision 1.3 2008/10/01 17:18:59 rubikitch ;; silence byte compiler ;; ;; Revision 1.2 2008/10/01 17:17:59 rubikitch ;; many bug fix ;; New command: `anything-grep-by-name' ;; ;; Revision 1.1 2008/10/01 10:58:59 rubikitch ;; Initial revision ;; ;;; Code: (defvar anything-grep-version "$Id: anything-grep.el,v 1.27 2010-03-21 11:31:04 rubikitch Exp $") (require 'anything) (require 'grep) (defvar anything-grep-save-buffers-before-grep nil "Do `save-some-buffers' before performing `anything-grep'.") (defvar anything-grep-goto-hook nil "List of functions to be called after `agrep-goto' opens file.") (defvar anything-grep-find-file-function 'find-file "Function to visit a file with. It takes one argument, a file name to visit.") (defvar anything-grep-multiline t "If non-nil, use multi-line display. It is prettier. Use anything.el v1.147 or newer.") (defvar anything-grep-fontify-file-name t "If non-nil, fontify file name and line number of matches.") (defvar anything-grep-alist '(("buffers" ("egrep -Hin %s $buffers" "/")) ("memo" ("ack-grep -af | xargs egrep -Hin %s" "~/memo")) ("PostgreSQL" ("egrep -Hin %s *.txt" "~/doc/postgresql-74/")) ("~/bin and ~/ruby" ("ack-grep -afG 'rb$' | xargs egrep -Hin %s" "~/ruby") ("ack-grep -af | xargs egrep -Hin %s" "~/bin"))) "Mapping of location and command/pwd used by `anything-grep-by-name'. The command is grep command line. Note that %s is replaced by query. The command is typically \"ack-grep -af | xargs egrep -Hin %s\", which means regexp/case-insensitive search for all files (including subdirectories) except unneeded files. The occurrence of $file in command is replaced with `buffer-file-name' of all buffers. The pwd is current directory to grep. The format is: ((LOCATION1 (COMMAND1-1 PWD1-1) (COMMAND1-2 PWD1-2) ...) (LOCATION2 (COMMAND2-1 PWD2-1) (COMMAND2-2 PWD2-2) ...) ...) ") (defvar anything-grep-filter-command nil "If non-nil, filter the result of grep command. For example, normalizing many Japanese encodings to EUC-JP, set this variable to \"ruby -rkconv -pe '$_.replace $_.toeuc'\". The command is converting standard input to EUC-JP line by line. ") ;; (@* "core") (defvar anything-grep-sources nil "`anything-sources' for last invoked `anything-grep'.") (defvar anything-grep-buffer-name nil) (defun anything-grep-base (sources &optional bufname) "Invoke `anything' for `anything-grep'." (and anything-grep-save-buffers-before-grep (save-some-buffers (not compilation-ask-about-save) nil)) (setq anything-grep-sources sources) (setq anything-grep-buffer-name (or bufname "*anything grep*")) (let ((anything-quit-if-no-candidate t) (anything-compile-source-functions (cons 'anything-compile-source--agrep-init anything-compile-source-functions))) (anything sources nil nil nil nil bufname))) ;; (anything (list (agrep-source "grep -Hin agrep anything-grep.el" default-directory) (agrep-source "grep -Hin pwd anything-grep.el" default-directory))) (defun agrep-source (command pwd) "Anything Source of `anything-grep'." `((command . ,command) (pwd . ,pwd) (name . ,(format "%s [%s]" command pwd)) (action . agrep-goto) (anything-grep) (candidate-number-limit . 9999) (migemo) ;; to inherit faces (candidates-in-buffer) (get-line . buffer-substring) ,@(when anything-grep-multiline '((multiline) (real-to-display . agrep-real-to-display))))) (defun anything-compile-source--agrep-init (source) (if (assq 'anything-grep source) (append '((init . agrep-init) (candidates)) source) source)) (defun agrep-init () (agrep-create-buffer (anything-attr 'command) (anything-attr 'pwd))) (defun agrep-real-to-display (file-line-content) (if (string-match ":\\([0-9]+\\):" file-line-content) (format "%s:%s\n %s" (substring file-line-content 0 (match-beginning 0)) (match-string 1 file-line-content) (substring file-line-content (match-end 0))) file-line-content)) (defvar agrep-source-local nil) (defvar agrep-waiting-source nil "`anything' sources to get together in `agrep-sentinel'.") (defun agrep-do-grep (command pwd) "Insert result of COMMAND. The current directory is PWD. GNU grep is expected for COMMAND. The grep result is colorized." (let ((process-environment process-environment)) (when (eq grep-highlight-matches t) ;; Modify `process-environment' locally bound in `call-process-shell-command'. (setenv "GREP_OPTIONS" (concat (getenv "GREP_OPTIONS") " --color=always")) ;; for GNU grep 2.5.1 (setenv "GREP_COLOR" "01;31") ;; for GNU grep 2.5.1-cvs (setenv "GREP_COLORS" "mt=01;31:fn=:ln=:bn=:se=:ml=:cx=:ne")) (set (make-local-variable 'agrep-source-local) (anything-get-current-source)) (add-to-list 'agrep-waiting-source agrep-source-local) (set-process-sentinel (start-process-shell-command "anything-grep" (current-buffer) (format "cd %s; %s" pwd command)) 'agrep-sentinel))) (defvar agrep-do-after-minibuffer-exit nil) (defun agrep-minibuffer-exit-hook () (when agrep-do-after-minibuffer-exit (run-at-time 1 nil agrep-do-after-minibuffer-exit) (setq agrep-do-after-minibuffer-exit nil))) (add-hook 'minibuffer-exit-hook 'agrep-minibuffer-exit-hook) (defun agrep-show (func) (if (active-minibuffer-window) (setq agrep-do-after-minibuffer-exit func) (funcall func))) ;; (anything-grep "sleep 1; grep -Hin grep anything-grep.el" "~/src/anything-config/extensions/") (defun agrep-sentinel (proc stat) (with-current-buffer (process-buffer proc) (setq agrep-waiting-source (delete agrep-source-local agrep-waiting-source)) (agrep-fontify)) (unless agrep-waiting-source ;; call anything (agrep-show (lambda () (let ((anything-quit-if-no-candidate (lambda () (message "No matches")))) (anything anything-grep-sources nil nil nil nil anything-grep-buffer-name)))))) (defun agrep-fontify () "Fontify the result of `agrep-do-grep'." ;; Color matches. (goto-char 1) (while (re-search-forward "\\(\033\\[01;31m\\)\\(.*?\\)\\(\033\\[[0-9]*m\\)" nil t) (put-text-property (match-beginning 2) (match-end 2) 'face grep-match-face) (replace-match "" t t nil 1) (replace-match "" t t nil 3)) ;; Delete other escape sequences. (goto-char 1) (while (re-search-forward "\\(\033\\[[0-9;]*[mK]\\)" nil t) (replace-match "" t t nil 0)) (when anything-grep-fontify-file-name (goto-char 1) (while (re-search-forward ":\\([0-9]+\\):" nil t) (put-text-property (point-at-bol) (match-beginning 0) 'face compilation-info-face) (put-text-property (match-beginning 1) (match-end 1) 'face compilation-line-face) (forward-line 1)))) ;; (anything-grep "grep -n grep *.el" "~/emacs/init.d") (defun agrep-create-buffer (command pwd) "Create candidate buffer for `anything-grep'. Its contents is fontified grep result." (with-current-buffer (anything-candidate-buffer 'global) (setq default-directory pwd) (agrep-do-grep command pwd) (current-buffer))) ;; (display-buffer (agrep-create-buffer "grep --color=always -Hin agrep anything-grep.el" default-directory)) ;; (anything '(((name . "test") (init . (lambda () (anything-candidate-buffer (get-buffer " *anything grep:grep --color=always -Hin agrep anything-grep.el*")) )) (candidates-in-buffer) (get-line . buffer-substring)))) (defun agrep-goto (file-line-content) "Visit the source for the grep result at point." (string-match ":\\([0-9]+\\):" file-line-content) (save-match-data (funcall anything-grep-find-file-function (expand-file-name (substring file-line-content 0 (match-beginning 0)) (anything-attr 'pwd)))) (goto-line (string-to-number (match-string 1 file-line-content))) (run-hooks 'anything-grep-goto-hook)) ;; (@* "simple grep interface") (defun anything-grep (command pwd) "Run grep in `anything' buffer to narrow results. It asks COMMAND for grep command line and PWD for current directory." (interactive (progn (grep-compute-defaults) (let ((default (grep-default-command))) (list (read-from-minibuffer "Run grep (like this): " (if current-prefix-arg default grep-command) nil nil 'grep-history (if current-prefix-arg nil default)) (read-directory-name "Directory: " default-directory default-directory t))))) (anything-grep-base (list (agrep-source (agrep-preprocess-command command) pwd)) (format "*anything grep:%s [%s]*" command (abbreviate-file-name pwd)))) ;; (anything-grep "grep -Hin agrep anything-grep.el" default-directory) (defun agrep-preprocess-command (command) (with-temp-buffer (insert command) (goto-char 1) (when (search-forward "$buffers" nil t) (delete-region (match-beginning 0) (match-end 0)) (insert (mapconcat 'shell-quote-argument (delq nil (mapcar 'buffer-file-name (buffer-list))) " "))) (when anything-grep-filter-command (goto-char (point-max)) (insert "|" anything-grep-filter-command)) (buffer-string))) ;; (@* "grep in predefined files") (defvar agbn-last-name nil "The last used name by `anything-grep-by-name'.") (defun agrep-by-name-read-info (&rest kinds) (let* ((default (or (thing-at-point 'symbol) "")) (result (mapcar (lambda (kind) (case kind ('query (read-string (format "Grep query (default:%s): " default) nil nil default)) ('name (completing-read "Grep by name: " anything-grep-alist nil t nil nil agbn-last-name)))) kinds))) (if (cdr result) ; length >= 1 result (car result)))) (defun anything-grep-by-name (&optional query name) "Do `anything-grep' from predefined location. It asks NAME for location name and QUERY." (interactive (agrep-by-name-read-info 'query 'name)) (setq query (or query (agrep-by-name-read-info 'query))) (setq name (or name (agrep-by-name-read-info 'name))) (setq agbn-last-name name) (anything-aif (assoc-default name anything-grep-alist) (progn (grep-compute-defaults) (anything-grep-base (mapcar (lambda (args) (destructuring-bind (cmd dir) args (agrep-source (format (agrep-preprocess-command cmd) (shell-quote-argument query)) dir))) it) (format "*anything grep:%s [%s]" query name))) (error "no such name %s" name))) (defun anything-grep-by-name-reversed (&optional name query) "Do `anything-grep' from predefined location. It asks QUERY and NAME for location name. Difference with `anything-grep-by-name' is prompt order." (interactive (agrep-by-name-read-info (quote name) (quote query))) (anything-grep-by-name query name)) ;;;; 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 "agrep-by-name-read-info") (expect "query1" (stub read-string => "query1") (agrep-by-name-read-info 'query)) (expect "elinit" (stub completing-read => "elinit") (agrep-by-name-read-info 'name)) (expect '("query1" "elinit") (stub read-string => "query1") (stub completing-read => "elinit") (agrep-by-name-read-info 'query 'name)) (expect '("elinit" "query1") (stub read-string => "query1") (stub completing-read => "elinit") (agrep-by-name-read-info 'name 'query)) ))) (provide 'anything-grep) ;; How to save (DO NOT REMOVE!!) ;; (progn (magit-push) (emacswiki-post "anything-grep.el")) ;;; anything-grep.el ends here