Emacs config utilizing prelude as a base
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

12620 lines
511 KiB

  1. ;;; anything-config.el --- Applications libary for `anything.el'
  2. ;; Filename: anything-config.el
  3. ;; Description: Applications libary for `anything.el'
  4. ;; Author: Tassilo Horn <tassilo@member.fsf.org>
  5. ;; Maintainer: Tassilo Horn <tassilo@member.fsf.org>
  6. ;; rubikitch <rubikitch@ruby-lang.org>
  7. ;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
  8. ;; Copyright (C) 2007 ~ 2011, Tassilo Horn, all rights reserved.
  9. ;; Copyright (C) 2009, Andy Stewart, all rights reserved.
  10. ;; Copyright (C) 2009 ~ 2012, rubikitch, all rights reserved.
  11. ;; Copyright (C) 2009 ~ 2012, Thierry Volpiatto, all rights reserved.
  12. ;; Created: 2009-02-16 21:38:23
  13. ;; X-URL: <http://repo.or.cz/w/anything-config.git>
  14. ;; MailingList: <https://groups.google.com/group/emacs-anything?hl=en>
  15. ;; Keywords: anything, anything-config
  16. ;; Compatibility: GNU Emacs 22 ~ 24
  17. ;; Dependencies: `anything.el', `anything-match-plugin.el'.
  18. ;;; This file is NOT part of GNU Emacs
  19. ;;; License
  20. ;;
  21. ;; This program is free software; you can redistribute it and/or modify
  22. ;; it under the terms of the GNU General Public License as published by
  23. ;; the Free Software Foundation; either version 3, or (at your option)
  24. ;; any later version.
  25. ;; This program is distributed in the hope that it will be useful,
  26. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  27. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  28. ;; GNU General Public License for more details.
  29. ;; You should have received a copy of the GNU General Public License
  30. ;; along with this program; see the file COPYING. If not, write to
  31. ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  32. ;; Floor, Boston, MA 02110-1301, USA.
  33. ;;; Commentary:
  34. ;;
  35. ;; Predefined configurations for `anything.el'
  36. ;;
  37. ;; For quick start, try `anything-for-files' to open files.
  38. ;;
  39. ;; To configure anything you should define anything command
  40. ;; with your favorite sources, like below:
  41. ;;
  42. ;; (defun my-anything ()
  43. ;; (interactive)
  44. ;; (anything-other-buffer
  45. ;; '(anything-c-source-buffers
  46. ;; anything-c-source-file-name-history
  47. ;; anything-c-source-info-pages
  48. ;; anything-c-source-info-elisp
  49. ;; anything-c-source-man-pages
  50. ;; anything-c-source-locate
  51. ;; anything-c-source-emacs-commands)
  52. ;; " *my-anything*"))
  53. ;;
  54. ;; Then type M-x my-anything to use sources.
  55. ;;
  56. ;; Defining own command is better than setup `anything-sources'
  57. ;; directly, because you can define multiple anything commands with
  58. ;; different sources. Each anything command should have own anything
  59. ;; buffer, because M-x anything-resume revives anything command.
  60. ;; NOTE: What you find on Emacswiki is mostly deprecated and not maintained,
  61. ;; don't complain if you use such code or configuration and something
  62. ;; doesn't work.
  63. ;;; Autodoc documentation:
  64. ;; ---------------------
  65. ;; * Commands defined here are:
  66. ;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "anything-" :docstring t)
  67. ;; `anything-configuration'
  68. ;; Customize `anything'.
  69. ;; `anything-c-buffer-help'
  70. ;; Help command for anything buffers.
  71. ;; `anything-ff-help'
  72. ;; Help command for `anything-find-files'.
  73. ;; `anything-read-file-name-help'
  74. ;; Not documented.
  75. ;; `anything-generic-file-help'
  76. ;; Not documented.
  77. ;; `anything-grep-help'
  78. ;; Not documented.
  79. ;; `anything-pdfgrep-help'
  80. ;; Not documented.
  81. ;; `anything-etags-help'
  82. ;; The help function for etags.
  83. ;; `anything-c-ucs-help'
  84. ;; Help command for `anything-ucs'.
  85. ;; `anything-c-bookmark-help'
  86. ;; Help command for bookmarks.
  87. ;; `anything-show-this-source-only'
  88. ;; Show all candidates of this source.
  89. ;; `anything-test-sources'
  90. ;; List all anything sources for test.
  91. ;; `anything-select-source'
  92. ;; [OBSOLETE] Select source.
  93. ;; `anything-insert-buffer-name'
  94. ;; Insert buffer name.
  95. ;; `anything-quit-and-find-file'
  96. ;; Drop into `anything-find-files' from `anything'.
  97. ;; `anything-mark-all'
  98. ;; Mark all visible unmarked candidates in current source.
  99. ;; `anything-unmark-all'
  100. ;; Unmark all candidates in all sources of current anything session.
  101. ;; `anything-toggle-all-marks'
  102. ;; Toggle all marks.
  103. ;; `anything-buffer-diff-persistent'
  104. ;; Toggle diff buffer without quitting anything.
  105. ;; `anything-buffer-revert-persistent'
  106. ;; Revert buffer without quitting anything.
  107. ;; `anything-buffer-save-persistent'
  108. ;; Save buffer without quitting anything.
  109. ;; `anything-buffer-run-kill-buffers'
  110. ;; Run kill buffer action from `anything-c-source-buffers-list'.
  111. ;; `anything-buffer-run-grep'
  112. ;; Run Grep action from `anything-c-source-buffers-list'.
  113. ;; `anything-buffer-run-zgrep'
  114. ;; Run Grep action from `anything-c-source-buffers-list'.
  115. ;; `anything-buffer-run-query-replace-regexp'
  116. ;; Run Query replace regexp action from `anything-c-source-buffers-list'.
  117. ;; `anything-buffer-run-query-replace'
  118. ;; Run Query replace action from `anything-c-source-buffers-list'.
  119. ;; `anything-buffer-switch-other-window'
  120. ;; Run switch to other window action from `anything-c-source-buffers-list'.
  121. ;; `anything-buffer-switch-other-frame'
  122. ;; Run switch to other frame action from `anything-c-source-buffers-list'.
  123. ;; `anything-buffer-switch-to-elscreen'
  124. ;; Run switch to elscreen action from `anything-c-source-buffers-list'.
  125. ;; `anything-buffer-run-ediff'
  126. ;; Run ediff action from `anything-c-source-buffers-list'.
  127. ;; `anything-buffer-run-ediff-merge'
  128. ;; Run ediff action from `anything-c-source-buffers-list'.
  129. ;; `anything-ff-run-toggle-auto-update'
  130. ;; Not documented.
  131. ;; `anything-ff-run-switch-to-history'
  132. ;; Run Switch to history action from `anything-c-source-find-files'.
  133. ;; `anything-ff-run-grep'
  134. ;; Run Grep action from `anything-c-source-find-files'.
  135. ;; `anything-ff-run-pdfgrep'
  136. ;; Run Pdfgrep action from `anything-c-source-find-files'.
  137. ;; `anything-ff-run-zgrep'
  138. ;; Run Grep action from `anything-c-source-find-files'.
  139. ;; `anything-ff-run-copy-file'
  140. ;; Run Copy file action from `anything-c-source-find-files'.
  141. ;; `anything-ff-run-rename-file'
  142. ;; Run Rename file action from `anything-c-source-find-files'.
  143. ;; `anything-ff-run-byte-compile-file'
  144. ;; Run Byte compile file action from `anything-c-source-find-files'.
  145. ;; `anything-ff-run-load-file'
  146. ;; Run Load file action from `anything-c-source-find-files'.
  147. ;; `anything-ff-run-eshell-command-on-file'
  148. ;; Run eshell command on file action from `anything-c-source-find-files'.
  149. ;; `anything-ff-run-ediff-file'
  150. ;; Run Ediff file action from `anything-c-source-find-files'.
  151. ;; `anything-ff-run-ediff-merge-file'
  152. ;; Run Ediff merge file action from `anything-c-source-find-files'.
  153. ;; `anything-ff-run-symlink-file'
  154. ;; Run Symlink file action from `anything-c-source-find-files'.
  155. ;; `anything-ff-run-hardlink-file'
  156. ;; Run Hardlink file action from `anything-c-source-find-files'.
  157. ;; `anything-ff-run-delete-file'
  158. ;; Run Delete file action from `anything-c-source-find-files'.
  159. ;; `anything-ff-run-complete-fn-at-point'
  160. ;; Run complete file name action from `anything-c-source-find-files'.
  161. ;; `anything-ff-run-switch-to-eshell'
  162. ;; Run switch to eshell action from `anything-c-source-find-files'.
  163. ;; `anything-ff-run-switch-other-window'
  164. ;; Run switch to other window action from `anything-c-source-find-files'.
  165. ;; `anything-ff-run-switch-other-frame'
  166. ;; Run switch to other frame action from `anything-c-source-find-files'.
  167. ;; `anything-ff-run-open-file-externally'
  168. ;; Run open file externally command action from `anything-c-source-find-files'.
  169. ;; `anything-ff-run-locate'
  170. ;; Run locate action from `anything-c-source-find-files'.
  171. ;; `anything-ff-run-gnus-attach-files'
  172. ;; Run gnus attach files command action from `anything-c-source-find-files'.
  173. ;; `anything-ff-run-etags'
  174. ;; Run Etags command action from `anything-c-source-find-files'.
  175. ;; `anything-ff-run-print-file'
  176. ;; Run Print file action from `anything-c-source-find-files'.
  177. ;; `anything-ff-run-toggle-basename'
  178. ;; Not documented.
  179. ;; `anything-find-files-down-one-level'
  180. ;; Go down one level like unix command `cd ..'.
  181. ;; `anything-ff-properties-persistent'
  182. ;; Show properties without quitting anything.
  183. ;; `anything-ff-persistent-delete'
  184. ;; Delete current candidate without quitting.
  185. ;; `anything-ff-run-kill-buffer-persistent'
  186. ;; Execute `anything-ff-kill-buffer-fname' whitout quitting.
  187. ;; `anything-ff-rotate-left-persistent'
  188. ;; Rotate image left without quitting anything.
  189. ;; `anything-ff-rotate-right-persistent'
  190. ;; Rotate image right without quitting anything.
  191. ;; `anything-c-goto-precedent-file'
  192. ;; Go to precedent file in anything grep/etags buffers.
  193. ;; `anything-c-goto-next-file'
  194. ;; Go to precedent file in anything grep/etags buffers.
  195. ;; `anything-c-grep-run-persistent-action'
  196. ;; Run grep persistent action from `anything-do-grep-1'.
  197. ;; `anything-c-grep-run-default-action'
  198. ;; Run grep default action from `anything-do-grep-1'.
  199. ;; `anything-c-grep-run-other-window-action'
  200. ;; Run grep goto other window action from `anything-do-grep-1'.
  201. ;; `anything-c-grep-run-save-buffer'
  202. ;; Run grep save results action from `anything-do-grep-1'.
  203. ;; `anything-yank-text-at-point'
  204. ;; Yank text at point in minibuffer.
  205. ;; `anything-c-bookmark-run-jump-other-window'
  206. ;; Jump to bookmark from keyboard.
  207. ;; `anything-c-bookmark-run-delete'
  208. ;; Delete bookmark from keyboard.
  209. ;; `anything-c-bmkext-run-edit'
  210. ;; Run `bmkext-edit-bookmark' from keyboard.
  211. ;; `anything-yaoddmuse-cache-pages'
  212. ;; Fetch the list of files on emacswiki and create cache file.
  213. ;; `anything-eval-new-line-and-indent'
  214. ;; Not documented.
  215. ;; `anything-call-source-from-anything'
  216. ;; Call anything source within `anything' session.
  217. ;; `anything-create-from-anything'
  218. ;; Run `anything-create' from `anything' as a fallback.
  219. ;; `anything-c-ucs-persistent-insert'
  220. ;; Not documented.
  221. ;; `anything-c-ucs-persistent-forward'
  222. ;; Not documented.
  223. ;; `anything-c-ucs-persistent-backward'
  224. ;; Not documented.
  225. ;; `anything-c-ucs-persistent-delete'
  226. ;; Not documented.
  227. ;; `anything-lisp-completion-at-point'
  228. ;; Anything lisp symbol completion at point.
  229. ;; `anything-c-complete-file-name-at-point'
  230. ;; Complete file name at point.
  231. ;; `anything-lisp-completion-at-point-or-indent'
  232. ;; First call indent and second call complete lisp symbol.
  233. ;; `anything-lisp-completion-or-file-name-at-point'
  234. ;; Complete lisp symbol or filename at point.
  235. ;; `anything-w32-shell-execute-open-file'
  236. ;; Not documented.
  237. ;; `anything-c-set-variable'
  238. ;; Set value to VAR interactively.
  239. ;; `anything-c-adaptive-save-history'
  240. ;; Save history information to file given by `anything-c-adaptive-history-file'.
  241. ;; `anything-c-reset-adaptative-history'
  242. ;; Delete all `anything-c-adaptive-history' and his file.
  243. ;; `anything-mini'
  244. ;; Preconfigured `anything' lightweight version (buffer -> recentf).
  245. ;; `anything-for-files'
  246. ;; Preconfigured `anything' for opening files.
  247. ;; `anything-recentf'
  248. ;; Preconfigured `anything' for `recentf'.
  249. ;; `anything-info-at-point'
  250. ;; Preconfigured `anything' for searching info at point.
  251. ;; `anything-show-kill-ring'
  252. ;; Preconfigured `anything' for `kill-ring'.
  253. ;; `anything-minibuffer-history'
  254. ;; Preconfigured `anything' for `minibuffer-history'.
  255. ;; `anything-gentoo'
  256. ;; Preconfigured `anything' for gentoo linux.
  257. ;; `anything-imenu'
  258. ;; Preconfigured `anything' for `imenu'.
  259. ;; `anything-google-suggest'
  260. ;; Preconfigured `anything' for google search with google suggest.
  261. ;; `anything-yahoo-suggest'
  262. ;; Preconfigured `anything' for Yahoo searching with Yahoo suggest.
  263. ;; `anything-for-buffers'
  264. ;; Preconfigured `anything' for buffers.
  265. ;; `anything-buffers-list'
  266. ;; Preconfigured `anything' to list buffers.
  267. ;; `anything-bbdb'
  268. ;; Preconfigured `anything' for BBDB.
  269. ;; `anything-locate'
  270. ;; Preconfigured `anything' for Locate.
  271. ;; `anything-w3m-bookmarks'
  272. ;; Preconfigured `anything' for w3m bookmark.
  273. ;; `anything-firefox-bookmarks'
  274. ;; Preconfigured `anything' for firefox bookmark.
  275. ;; `anything-colors'
  276. ;; Preconfigured `anything' for color.
  277. ;; `anything-bookmarks'
  278. ;; Preconfigured `anything' for bookmarks.
  279. ;; `anything-c-pp-bookmarks'
  280. ;; Preconfigured `anything' for bookmarks (pretty-printed).
  281. ;; `anything-c-insert-latex-math'
  282. ;; Preconfigured anything for latex math symbols completion.
  283. ;; `anything-register'
  284. ;; Preconfigured `anything' for Emacs registers.
  285. ;; `anything-man-woman'
  286. ;; Preconfigured `anything' for Man and Woman pages.
  287. ;; `anything-org-keywords'
  288. ;; Preconfigured `anything' for org keywords.
  289. ;; `anything-emms'
  290. ;; Preconfigured `anything' for emms sources.
  291. ;; `anything-eev-anchors'
  292. ;; Preconfigured `anything' for eev anchors.
  293. ;; `anything-bm-list'
  294. ;; Preconfigured `anything' for visible bookmarks.
  295. ;; `anything-timers'
  296. ;; Preconfigured `anything' for timers.
  297. ;; `anything-list-emacs-process'
  298. ;; Preconfigured `anything' for emacs process.
  299. ;; `anything-occur'
  300. ;; Preconfigured Anything for Occur source.
  301. ;; `anything-browse-code'
  302. ;; Preconfigured anything to browse code.
  303. ;; `anything-org-headlines'
  304. ;; Preconfigured anything to show org headlines.
  305. ;; `anything-regexp'
  306. ;; Preconfigured anything to build regexps.
  307. ;; `anything-c-copy-files-async'
  308. ;; Preconfigured anything to copy file list FLIST to DEST asynchronously.
  309. ;; `anything-find-files'
  310. ;; Preconfigured `anything' for anything implementation of `find-file'.
  311. ;; `anything-write-file'
  312. ;; Preconfigured `anything' providing completion for `write-file'.
  313. ;; `anything-insert-file'
  314. ;; Preconfigured `anything' providing completion for `insert-file'.
  315. ;; `anything-dired-rename-file'
  316. ;; Preconfigured `anything' to rename files from dired.
  317. ;; `anything-dired-copy-file'
  318. ;; Preconfigured `anything' to copy files from dired.
  319. ;; `anything-dired-symlink-file'
  320. ;; Preconfigured `anything' to symlink files from dired.
  321. ;; `anything-dired-hardlink-file'
  322. ;; Preconfigured `anything' to hardlink files from dired.
  323. ;; `anything-do-grep'
  324. ;; Preconfigured anything for grep.
  325. ;; `anything-do-pdfgrep'
  326. ;; Preconfigured anything for pdfgrep.
  327. ;; `anything-c-etags-select'
  328. ;; Preconfigured anything for etags.
  329. ;; `anything-filelist'
  330. ;; Preconfigured `anything' to open files instantly.
  331. ;; `anything-filelist+'
  332. ;; Preconfigured `anything' to open files/buffers/bookmarks instantly.
  333. ;; `anything-M-x'
  334. ;; Preconfigured `anything' for Emacs commands.
  335. ;; `anything-manage-advice'
  336. ;; Preconfigured `anything' to disable/enable function advices.
  337. ;; `anything-bookmark-ext'
  338. ;; Preconfigured `anything' for bookmark-extensions sources.
  339. ;; `anything-simple-call-tree'
  340. ;; Preconfigured `anything' for simple-call-tree. List function relationships.
  341. ;; `anything-mark-ring'
  342. ;; Preconfigured `anything' for `anything-c-source-mark-ring'.
  343. ;; `anything-global-mark-ring'
  344. ;; Preconfigured `anything' for `anything-c-source-global-mark-ring'.
  345. ;; `anything-all-mark-rings'
  346. ;; Preconfigured `anything' for `anything-c-source-global-mark-ring' and `anything-c-source-mark-ring'.
  347. ;; `anything-yaoddmuse-emacswiki-edit-or-view'
  348. ;; Preconfigured `anything' to edit or view EmacsWiki page.
  349. ;; `anything-yaoddmuse-emacswiki-post-library'
  350. ;; Preconfigured `anything' to post library to EmacsWiki.
  351. ;; `anything-eval-expression'
  352. ;; Preconfigured anything for `anything-c-source-evaluation-result'.
  353. ;; `anything-eval-expression-with-eldoc'
  354. ;; Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support.
  355. ;; `anything-calcul-expression'
  356. ;; Preconfigured anything for `anything-c-source-calculation-result'.
  357. ;; `anything-surfraw'
  358. ;; Preconfigured `anything' to search PATTERN with search ENGINE.
  359. ;; `anything-call-source'
  360. ;; Preconfigured `anything' to call anything source.
  361. ;; `anything-execute-anything-command'
  362. ;; Preconfigured `anything' to execute preconfigured `anything'.
  363. ;; `anything-create'
  364. ;; Preconfigured `anything' to do many create actions from STRING.
  365. ;; `anything-top'
  366. ;; Preconfigured `anything' for top command.
  367. ;; `anything-select-xfont'
  368. ;; Preconfigured `anything' to select Xfont.
  369. ;; `anything-world-time'
  370. ;; Preconfigured `anything' to show world time.
  371. ;; `anything-apt'
  372. ;; Preconfigured `anything' : frontend of APT package manager.
  373. ;; `anything-esh-pcomplete'
  374. ;; Preconfigured anything to provide anything completion in eshell.
  375. ;; `anything-eshell-history'
  376. ;; Preconfigured anything for eshell history.
  377. ;; `anything-c-run-external-command'
  378. ;; Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
  379. ;; `anything-ratpoison-commands'
  380. ;; Preconfigured `anything' to execute ratpoison commands.
  381. ;; `anything-ucs'
  382. ;; Preconfigured anything for `ucs-names' math symbols.
  383. ;; `anything-c-apropos'
  384. ;; Preconfigured anything to describe commands, functions, variables and faces.
  385. ;; `anything-xrandr-set'
  386. ;; Not documented.
  387. ;; * User variables defined here:
  388. ;; [EVAL] (autodoc-document-lisp-buffer :type 'user-variable :prefix "anything-" :var-value t)
  389. ;; `anything-c-adaptive-history-file'
  390. ;; Default Value: "~/.emacs.d/anything-c-adaptive-history"
  391. ;; `anything-c-adaptive-history-length'
  392. ;; Default Value: 50
  393. ;; `anything-c-google-suggest-url'
  394. ;; Default Value: "http://google.com/complete/search?output=toolbar&q="
  395. ;; `anything-c-google-suggest-search-url'
  396. ;; Default Value: "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
  397. ;; `anything-google-suggest-use-curl-p'
  398. ;; Default Value: nil
  399. ;; `anything-c-yahoo-suggest-url'
  400. ;; Default Value: "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=G [...]
  401. ;; `anything-c-yahoo-suggest-search-url'
  402. ;; Default Value: "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
  403. ;; `anything-c-boring-buffer-regexp'
  404. ;; Default Value: "\\ (\\` \\)\\|\\*anything\\|\\*ac-mode\\| \\*Echo Area\\| \\*Minibuf"
  405. ;; `anything-c-boring-file-regexp'
  406. ;; Default Value: "/\\ (?:\\(?:\\.\\(?:git\\|hg\\|svn\\)\\|CVS\\|_darcs\\)\\)\\(?:/\\|$\\)\\| [...]
  407. ;; `anything-kill-ring-threshold'
  408. ;; Default Value: 10
  409. ;; `anything-c-kill-ring-max-lines-number'
  410. ;; Default Value: nil
  411. ;; `anything-su-or-sudo'
  412. ;; Default Value: "su"
  413. ;; `anything-for-files-prefered-list'
  414. ;; Default Value: (anything-c-source-ffap-line anything-c-source-ffap-guesser anything-c-sou [...]
  415. ;; `anything-create--actions-private'
  416. ;; Default Value: nil
  417. ;; `anything-allow-skipping-current-buffer'
  418. ;; Default Value: nil
  419. ;; `anything-c-enable-eval-defun-hack'
  420. ;; Default Value: t
  421. ;; `anything-tramp-verbose'
  422. ;; Default Value: 0
  423. ;; `anything-raise-command'
  424. ;; Default Value: nil
  425. ;; `anything-command-map-prefix-key'
  426. ;; Default Value: "<f5> a"
  427. ;; `anything-c-browse-code-regexp-lisp'
  428. ;; Default Value: "^ * (def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|type\\|th [...]
  429. ;; `anything-c-browse-code-regexp-python'
  430. ;; Default Value: "\\<def\\>\\|\\<class\\>"
  431. ;; `anything-c-browse-code-regexp-alist'
  432. ;; Default Value: ((lisp-interaction-mode . "^ *(def\\(un\\|subst\\|macro\\|face\\|alias\\|a [...]
  433. ;; `anything-c-external-programs-associations'
  434. ;; Default Value: nil
  435. ;; `anything-ff-auto-update-initial-value'
  436. ;; Default Value: t
  437. ;; `anything-c-copy-async-prefered-emacs'
  438. ;; Default Value: "emacs"
  439. ;; `anything-ff-lynx-style-map'
  440. ;; Default Value: t
  441. ;; `anything-ff-history-max-length'
  442. ;; Default Value: 100
  443. ;; `anything-ff-smart-completion'
  444. ;; Default Value: t
  445. ;; `anything-ff-default-kbsize'
  446. ;; Default Value: 1024.0
  447. ;; `anything-ff-tramp-not-fancy'
  448. ;; Default Value: t
  449. ;; `anything-ff-exif-data-program'
  450. ;; Default Value: "exiftran"
  451. ;; `anything-ff-exif-data-program-args'
  452. ;; Default Value: "-d"
  453. ;; `anything-c-grep-use-ioccur-style-keys'
  454. ;; Default Value: t
  455. ;; `anything-c-pdfgrep-default-read-command'
  456. ;; Default Value: "xpdf '%f' %p"
  457. ;; `anything-c-etags-tag-file-name'
  458. ;; Default Value: "TAGS"
  459. ;; `anything-c-etags-tag-file-search-limit'
  460. ;; Default Value: 10
  461. ;; `anything-c-etags-use-regexp-search'
  462. ;; Default Value: nil
  463. ;; `anything-c-etags-search-regexp'
  464. ;; Default Value: "^.+: .+ \\<%s"
  465. ;; `anything-c-filelist-file-name'
  466. ;; Default Value: nil
  467. ;; `anything-c-eldoc-in-minibuffer-show-fn'
  468. ;; Default Value: anything-c-show-info-in-mode-line
  469. ;; `anything-c-turn-on-show-completion'
  470. ;; Default Value: t
  471. ;; `anything-c-show-completion-use-special-display'
  472. ;; Default Value: t
  473. ;; `anything-c-show-completion-min-window-height'
  474. ;; Default Value: 7
  475. ;; `anything-lisp-completion-or-indent-delay'
  476. ;; Default Value: 0.6
  477. ;; `anything-c-default-external-file-browser'
  478. ;; Default Value: "nautilus"
  479. ;; `anything-c-use-adaptative-sorting'
  480. ;; Default Value: nil
  481. ;; `anything-ff-newfile-prompt-p'
  482. ;; Default Value: t
  483. ;; `anything-ff-avfs-directory'
  484. ;; Default Value: nil
  485. ;; `anything-ff-file-compressed-list'
  486. ;; Default Value: ("gz" "bz2" "zip" "7z")
  487. ;; `anything-locate-db-file-regexp'
  488. ;; Default Value: "m?locate.db$"
  489. ;; `anything-c-locate-command'
  490. ;; Default Value: nil
  491. ;; `anything-c-show-info-in-mode-line-delay'
  492. ;; Default Value: 12
  493. ;; `anything-c-copy-files-async-log-file'
  494. ;; Default Value: "/tmp/dired.log"
  495. ;; `anything-ff-printer-list'
  496. ;; Default Value: nil
  497. ;; `anything-ff-transformer-show-only-basename'
  498. ;; Default Value: nil
  499. ;; `anything-ff-quick-delete-dont-prompt-for-deletion'
  500. ;; Default Value: nil
  501. ;; `anything-ff-signal-error-on-dot-files'
  502. ;; Default Value: t
  503. ;; `anything-completing-read-handlers-alist'
  504. ;; Default Value: ((describe-function . anything-completing-read-symbols) (describe-variabl [...]
  505. ;; * Anything sources defined here:
  506. ;; [EVAL] (autodoc-document-lisp-buffer :type 'anything-source :prefix "anything-" :any-sname t)
  507. ;; `anything-c-source-regexp' (Regexp Builder)
  508. ;; `anything-c-source-buffers' (Buffers)
  509. ;; `anything-c-source-buffer-not-found' (Create buffer)
  510. ;; `anything-c-source-buffers-list' (Buffers)
  511. ;; `anything-c-source-file-name-history' (File Name History)
  512. ;; `anything-c-source-files-in-current-dir' (Files from Current Directory)
  513. ;; `anything-c-source-files-in-current-dir+' (Files from Current Directory)
  514. ;; `anything-c-source-find-files' (Find Files)
  515. ;; `anything-c-source-write-file' (Write File)
  516. ;; `anything-c-source-insert-file' (Insert File)
  517. ;; `anything-c-source-copy-files' (Copy Files)
  518. ;; `anything-c-source-symlink-files' (Symlink Files)
  519. ;; `anything-c-source-hardlink-files' (Hardlink Files)
  520. ;; `anything-c-source-file-cache' (File Cache)
  521. ;; `anything-c-source-locate' (Locate)
  522. ;; `anything-c-source-recentf' (Recentf)
  523. ;; `anything-c-source-ffap-guesser' (File at point)
  524. ;; `anything-c-source-ffap-line' (File/Lineno at point)
  525. ;; `anything-c-source-files-in-all-dired' (Files in all dired buffer.)
  526. ;; `anything-c-source-filelist' (FileList)
  527. ;; `anything-c-source-info-pages' (Info Pages)
  528. ;; `anything-c-source-man-pages' (Manual Pages)
  529. ;; `anything-c-source-complex-command-history' (Complex Command History)
  530. ;; `anything-c-source-extended-command-history' (Emacs Commands History)
  531. ;; `anything-c-source-emacs-commands' (Emacs Commands)
  532. ;; `anything-c-source-emacs-functions' (Emacs Functions)
  533. ;; `anything-c-source-emacs-functions-with-abbrevs' (Emacs Functions)
  534. ;; `anything-c-source-advice' (Function Advice)
  535. ;; `anything-c-source-emacs-variables' (Emacs Variables)
  536. ;; `anything-c-source-lacarte' (Lacarte)
  537. ;; `anything-c-source-bookmarks' (Bookmarks)
  538. ;; `anything-c-source-bookmark-set' (Set Bookmark)
  539. ;; `anything-c-source-bm' (Visible Bookmarks)
  540. ;; `anything-c-source-bookmarks-ssh' (Bookmarks-ssh)
  541. ;; `anything-c-source-bookmarks-su' (Bookmarks-root)
  542. ;; `anything-c-source-bookmarks-local' (Bookmarks-Local)
  543. ;; `anything-c-source-bmkext-addressbook' (Bookmark Addressbook)
  544. ;; `anything-c-source-bookmark-w3m' (Bookmark W3m)
  545. ;; `anything-c-source-bookmark-images' (Bookmark Images)
  546. ;; `anything-c-source-bookmark-man' (Bookmark Woman&Man)
  547. ;; `anything-c-source-bookmark-gnus' (Bookmark Gnus)
  548. ;; `anything-c-source-bookmark-info' (Bookmark Info)
  549. ;; `anything-c-source-bookmark-files&dirs' (Bookmark Files&Directories)
  550. ;; `anything-c-source-bookmark-su-files&dirs' (Bookmark Root-Files&Directories)
  551. ;; `anything-c-source-bookmark-ssh-files&dirs' (Bookmark Ssh-Files&Directories)
  552. ;; `anything-c-source-firefox-bookmarks' (Firefox Bookmarks)
  553. ;; `anything-c-source-w3m-bookmarks' (W3m Bookmarks)
  554. ;; `anything-c-source-elisp-library-scan' (Elisp libraries (Scan))
  555. ;; `anything-c-source-imenu' (Imenu)
  556. ;; `anything-c-source-ctags' (Exuberant ctags)
  557. ;; `anything-c-source-etags-select' (Etags)
  558. ;; `anything-c-source-semantic' (Semantic Tags)
  559. ;; `anything-c-source-simple-call-tree-functions-callers' (Function is called by)
  560. ;; `anything-c-source-simple-call-tree-callers-functions' (Function calls)
  561. ;; `anything-c-source-commands-and-options-in-file' (Commands/Options in file)
  562. ;; `anything-c-source-customize-face' (Customize Face)
  563. ;; `anything-c-source-colors' (Colors)
  564. ;; `anything-c-source-tracker-search' (Tracker Search)
  565. ;; `anything-c-source-mac-spotlight' (mdfind)
  566. ;; `anything-c-source-picklist' (Picklist)
  567. ;; `anything-c-source-kill-ring' (Kill Ring)
  568. ;; `anything-c-source-mark-ring' (mark-ring)
  569. ;; `anything-c-source-global-mark-ring' (global-mark-ring)
  570. ;; `anything-c-source-register' (Registers)
  571. ;; `anything-c-source-latex-math' (Latex Math Menu)
  572. ;; `anything-c-source-fixme' (TODO/FIXME/DRY comments)
  573. ;; `anything-c-source-rd-headline' (RD HeadLine)
  574. ;; `anything-c-source-oddmuse-headline' (Oddmuse HeadLine)
  575. ;; `anything-c-source-emacs-source-defun' (Emacs Source DEFUN)
  576. ;; `anything-c-source-emacs-lisp-expectations' (Emacs Lisp Expectations)
  577. ;; `anything-c-source-emacs-lisp-toplevels' (Emacs Lisp Toplevel / Level 4 Comment / Linkd Star)
  578. ;; `anything-c-source-yaoddmuse-emacswiki-edit-or-view' (Yaoddmuse Edit or View (EmacsWiki))
  579. ;; `anything-c-source-yaoddmuse-emacswiki-post-library' (Yaoddmuse Post library (EmacsWiki))
  580. ;; `anything-c-source-eev-anchor' (Anchors)
  581. ;; `anything-c-source-org-headline' (Org HeadLine)
  582. ;; `anything-c-source-org-keywords' (Org Keywords)
  583. ;; `anything-c-source-bbdb' (BBDB)
  584. ;; `anything-c-source-evaluation-result' (Evaluation Result)
  585. ;; `anything-c-source-calculation-result' (Calculation Result)
  586. ;; `anything-c-source-google-suggest' (Google Suggest)
  587. ;; `anything-c-source-yahoo-suggest' (Yahoo Suggest)
  588. ;; `anything-c-source-emms-streams' (Emms Streams)
  589. ;; `anything-c-source-emms-dired' (Music Directory)
  590. ;; `anything-c-source-emms-files' (Emms files)
  591. ;; `anything-c-source-jabber-contacts' (Jabber Contacts)
  592. ;; `anything-c-source-call-source' (Call anything source)
  593. ;; `anything-c-source-anything-commands' (Preconfigured Anything)
  594. ;; `anything-c-source-occur' (Occur)
  595. ;; `anything-c-source-browse-code' (Browse code)
  596. ;; `anything-c-source-create' (Create)
  597. ;; `anything-c-source-minibuffer-history' (Minibuffer History)
  598. ;; `anything-c-source-elscreen' (Elscreen)
  599. ;; `anything-c-source-top' (Top (Press C-c C-u to refresh))
  600. ;; `anything-c-source-absolute-time-timers' (Absolute Time Timers)
  601. ;; `anything-c-source-idle-time-timers' (Idle Time Timers)
  602. ;; `anything-c-source-xrandr-change-resolution' (Change Resolution)
  603. ;; `anything-c-source-xfonts' (X Fonts)
  604. ;; `anything-c-source-ucs' (Ucs names)
  605. ;; `anything-c-source-emacs-process' (Emacs Process)
  606. ;; `anything-c-source-time-world' (Time World List)
  607. ;; `anything-c-source-apt' (APT)
  608. ;; `anything-c-source-gentoo' (Portage sources)
  609. ;; `anything-c-source-use-flags' (Use Flags)
  610. ;; `anything-c-source-ratpoison-commands' (Ratpoison Commands)
  611. ;; `anything-c-source-esh' (Eshell completions)
  612. ;; `anything-c-source-eshell-history' (Eshell history)
  613. ;; *** END auto-documentation
  614. ;;; For Maintainers:
  615. ;;
  616. ;; Install developer-tools/autodoc.el and
  617. ;; Evaluate (autodoc-update-all) before commit or run it interactively.
  618. ;; This function generates anything-c-source-* / functions / options list.
  619. ;;
  620. ;; [EVAL IT] (autodoc-update-all)
  621. ;;
  622. ;; Please write details documentation about function, then others will
  623. ;; read code more easier. -- Andy Stewart
  624. ;;
  625. ;;; Change log:
  626. ;;
  627. ;; Change log of this file is found at
  628. ;; http://repo.or.cz/w/anything-config.git/history/master:/anything-config.el
  629. ;;
  630. ;; Change log of this project is found at
  631. ;; http://repo.or.cz/w/anything-config.git?a=shortlog
  632. ;;; Contributors:
  633. ;;
  634. ;; Tamas Patrovics
  635. ;; Tassilo Horn <tassilo@member.fsf.org>
  636. ;; Vagn Johansen <gonz808@hotmail.com>
  637. ;; Mathias Dahl <mathias.dahl@gmail.com>
  638. ;; Bill Clementson <billclem@gmail.com>
  639. ;; Stefan Kamphausen (see http://www.skamphausen.de for more informations)
  640. ;; Drew Adams <drew.adams@oracle.com>
  641. ;; Jason McBrayer <jmcbray@carcosa.net>
  642. ;; Andy Stewart <lazycat.manatee@gmail.com>
  643. ;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
  644. ;; rubikitch <rubikitch@ruby-lang.org>
  645. ;; Scott Vokes <vokes.s@gmail.com>
  646. ;; Kenichirou Oyama <k1lowxb@gmail.com>
  647. ;;; TODO
  648. ;;
  649. ;; - Fix documentation, now many functions haven't documentations.
  650. ;;
  651. ;;; Code:
  652. ;;; Require
  653. ;;
  654. ;;
  655. (require 'anything)
  656. (require 'thingatpt)
  657. (require 'ffap)
  658. (require 'cl)
  659. (eval-when-compile (require 'dired))
  660. (require 'dired-aux)
  661. (require 'dired-x)
  662. (require 'tramp)
  663. (require 'grep)
  664. (require 'url)
  665. (require 'xml)
  666. (eval-when-compile (require 'org)) ; Shut up byte compiler about org-directory.
  667. (eval-when-compile (require 'semantic nil t))
  668. (require 'anything-match-plugin)
  669. ;;; Declare external functions
  670. ;;
  671. ;;
  672. (declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach))
  673. (declare-function image-dired-display-image "image-dired.el" (file &optional original-size))
  674. (declare-function image-dired-update-property "image-dired.el" (prop value))
  675. (declare-function woman-file-name-all-completions "woman.el" (topic))
  676. (declare-function Man-getpage-in-background "man.el" (topic))
  677. (declare-function simple-call-tree-analyze "ext:simple-call-tree.el" (&optional test))
  678. (declare-function yaoddmuse-update-pagename "ext:yaoddmuse.el" (&optional unforced))
  679. (declare-function yaoddmuse-get-library-list "ext:yaoddmuse.el" (&optional dirs string))
  680. (declare-function org-get-current-options "ext:org-exp.el")
  681. (declare-function emms-streams "ext:emms-streams")
  682. (declare-function emms-stream-delete-bookmark "ext:emms-streams")
  683. (declare-function emms-stream-add-bookmark "ext:emms-streams" (name url fd type))
  684. (declare-function emms-stream-save-bookmarks-file "ext:emms-streams")
  685. (declare-function emms-stream-quit "ext:emms-streams")
  686. (declare-function with-current-emms-playlist "ext:emms" (&rest body))
  687. (declare-function emms-playlist-tracks-in-region "ext:emms" (beg end))
  688. (declare-function emms-playlist-first "ext:emms")
  689. (declare-function emms-playlist-mode-play-smart "ext:emms-playlist-mode")
  690. (declare-function term-line-mode "term")
  691. (declare-function term-char-mode "term")
  692. (declare-function term-send-input "term")
  693. (declare-function term-send-eof "term")
  694. (declare-function Info-index-nodes "info" (&optional file))
  695. (declare-function Info-goto-node "info" (&optional fork))
  696. (declare-function Info-find-node "info.el" (filename nodename &optional no-going-back))
  697. (declare-function elscreen-find-screen-by-buffer "ext:elscreen.el" (buffer &optional create))
  698. (declare-function elscreen-find-file "ext:elscreen.el" (filename))
  699. (declare-function elscreen-goto "ext:elscreen.el" (screen))
  700. (declare-function semantic-format-tag-summarize "ext:format.el" (tag &optional parent color) t)
  701. (declare-function semantic-tag-components "ext:tag.el" (tag) t)
  702. (declare-function semantic-go-to-tag "ext:tag-file.el" (tag) t)
  703. (declare-function semantic-tag-type "ext:tag-file.el" (tag) t)
  704. (declare-function semantic-tag-class "ext:tag-file.el" (tag) t)
  705. (declare-function bbdb "ext:bbdb-com")
  706. (declare-function bbdb-current-record "ext:bbdb-com")
  707. (declare-function bbdb-redisplay-one-record "ext:bbdb-com")
  708. (declare-function bbdb-record-net "ext:bbdb-com" (string) t)
  709. (declare-function bbdb-current-record "ext:bbdb-com")
  710. (declare-function bbdb-dwim-net-address "ext:bbdb-com")
  711. (declare-function bbdb-records "ext:bbdb-com"
  712. (&optional dont-check-disk already-in-db-buffer))
  713. (declare-function eshell-read-aliases-list "em-alias")
  714. (declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
  715. (declare-function eshell-bol "esh-mode")
  716. (declare-function eldoc-current-symbol "eldoc")
  717. (declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index))
  718. (declare-function eldoc-get-var-docstring "eldoc" (sym))
  719. (declare-function eldoc-fnsym-in-current-sexp "eldoc")
  720. (declare-function find-library-name "find-func.el" (library))
  721. (declare-function adoc-construct "ext:auto-document.el" (buf))
  722. (declare-function adoc-first-line "ext:auto-document.el" (str))
  723. (declare-function adoc-prin1-to-string "ext:auto-document.el" (object))
  724. (declare-function secure-hash "ext:fns.c" (algorithm object &optional start end binary))
  725. (declare-function w32-shell-execute "ext:w32fns.c" (operation document &optional parameters show-flag))
  726. (declare-function undo-tree-restore-state-from-register "ext:undo-tree.el" (register))
  727. ;;; compatibility
  728. ;;
  729. ;;
  730. (unless (fboundp 'window-system)
  731. (defun window-system (&optional arg)
  732. window-system))
  733. (unless (fboundp 'make-composed-keymap)
  734. (defun make-composed-keymap (maps &optional parent)
  735. "Construct a new keymap composed of MAPS and inheriting from PARENT.
  736. When looking up a key in the returned map, the key is looked in each
  737. keymap of MAPS in turn until a binding is found.
  738. If no binding is found in MAPS, the lookup continues in PARENT, if non-nil.
  739. As always with keymap inheritance, a nil binding in MAPS overrides
  740. any corresponding binding in PARENT, but it does not override corresponding
  741. bindings in other keymaps of MAPS.
  742. MAPS can be a list of keymaps or a single keymap.
  743. PARENT if non-nil should be a keymap."
  744. `(keymap
  745. ,@(if (keymapp maps) (list maps) maps)
  746. ,@parent)))
  747. (unless (fboundp 'apply-partially)
  748. (defun apply-partially (fun &rest args)
  749. "Return a function that is a partial application of FUN to ARGS.
  750. ARGS is a list of the first N arguments to pass to FUN.
  751. The result is a new function which does the same as FUN, except that
  752. the first N arguments are fixed at the values with which this function
  753. was called."
  754. (lexical-let ((fun fun) (args1 args))
  755. (lambda (&rest args2) (apply fun (append args1 args2))))))
  756. ;;; Customize
  757. ;;
  758. ;;
  759. (defgroup anything-config nil
  760. "Predefined configurations for `anything.el'."
  761. :group 'anything)
  762. (defcustom anything-c-adaptive-history-file
  763. "~/.emacs.d/anything-c-adaptive-history"
  764. "Path of file where history information is stored."
  765. :type 'string
  766. :group 'anything-config)
  767. (defcustom anything-c-adaptive-history-length 50
  768. "Maximum number of candidates stored for a source."
  769. :type 'number
  770. :group 'anything-config)
  771. (defcustom anything-c-google-suggest-url
  772. "http://google.com/complete/search?output=toolbar&q="
  773. "URL used for looking up Google suggestions."
  774. :type 'string
  775. :group 'anything-config)
  776. (defcustom anything-c-google-suggest-search-url
  777. "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
  778. "URL used for Google searching."
  779. :type 'string
  780. :group 'anything-config)
  781. (defcustom anything-google-suggest-use-curl-p nil
  782. "When non--nil use CURL to get info from `anything-c-google-suggest-url'.
  783. Otherwise `url-retrieve-synchronously' is used."
  784. :type 'boolean
  785. :group 'anything-config)
  786. (defcustom anything-c-yahoo-suggest-url
  787. "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query="
  788. "Url used for looking up Yahoo suggestions."
  789. :type 'string
  790. :group 'anything-config)
  791. (defcustom anything-c-yahoo-suggest-search-url
  792. "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
  793. "Url used for Yahoo searching."
  794. :type 'string
  795. :group 'anything-config)
  796. (defcustom anything-c-boring-buffer-regexp
  797. (rx (or
  798. (group bos " ")
  799. ;; anything-buffers
  800. "*anything" "*ac-mode"
  801. ;; echo area
  802. " *Echo Area" " *Minibuf"))
  803. "The regexp that match boring buffers.
  804. Buffer candidates matching this regular expression will be
  805. filtered from the list of candidates if the
  806. `anything-c-skip-boring-buffers' candidate transformer is used, or
  807. they will be displayed with face `file-name-shadow' if
  808. `anything-c-shadow-boring-buffers' is used."
  809. :type 'string
  810. :group 'anything-config)
  811. ;; (string-match anything-c-boring-buffer-regexp "buf")
  812. ;; (string-match anything-c-boring-buffer-regexp " hidden")
  813. ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*")
  814. (defcustom anything-c-boring-file-regexp
  815. (rx (or
  816. ;; Boring directories
  817. (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol))
  818. ;; Boring files
  819. (and line-start ".#")
  820. (and (or ".class" ".la" ".o" "~") eol)))
  821. "The regexp that match boring files.
  822. File candidates matching this regular expression will be
  823. filtered from the list of candidates if the
  824. `anything-c-skip-boring-files' candidate transformer is used, or
  825. they will be displayed with face `file-name-shadow' if
  826. `anything-c-shadow-boring-files' is used."
  827. :type 'string
  828. :group 'anything-config)
  829. (defcustom anything-kill-ring-threshold 10
  830. "Minimum length to be listed by `anything-c-source-kill-ring'."
  831. :type 'integer
  832. :group 'anything-config)
  833. (defcustom anything-c-kill-ring-max-lines-number nil
  834. "Max number of lines displayed per candidate in kill-ring browser.
  835. If nil or zero, don't truncate candidate, show all."
  836. :type 'integer
  837. :group 'anything-config)
  838. (defcustom anything-su-or-sudo "su"
  839. "What command to use for root access."
  840. :type 'string
  841. :group 'anything-config)
  842. (defcustom anything-for-files-prefered-list
  843. '(anything-c-source-ffap-line
  844. anything-c-source-ffap-guesser
  845. anything-c-source-buffers-list
  846. anything-c-source-recentf
  847. anything-c-source-bookmarks
  848. anything-c-source-file-cache
  849. anything-c-source-files-in-current-dir+
  850. anything-c-source-locate)
  851. "Your prefered sources to find files."
  852. :type 'list
  853. :group 'anything-config)
  854. (defcustom anything-create--actions-private nil
  855. "User defined actions for `anything-create' / `anything-c-source-create'.
  856. It is a list of (DISPLAY . FUNCTION) pairs like `action'
  857. attribute of `anything-sources'.
  858. It is prepended to predefined pairs."
  859. :type 'list
  860. :group 'anything-config)
  861. (defcustom anything-allow-skipping-current-buffer nil
  862. "Show current buffer or not in anything buffer"
  863. :type 'boolean
  864. :group 'anything-config)
  865. (defcustom anything-c-enable-eval-defun-hack t
  866. "If non-nil, execute `anything' using the source at point when C-M-x is pressed.
  867. This hack is invoked when pressing C-M-x in the form \
  868. (defvar anything-c-source-XXX ...) or (setq anything-c-source-XXX ...)."
  869. :type 'boolean
  870. :group 'anything-config)
  871. (defcustom anything-tramp-verbose 0
  872. "Just like `tramp-verbose' but specific to anything.
  873. When set to 0 don't show tramp messages in anything.
  874. If you want to have the default tramp messages set it to 3."
  875. :type 'integer
  876. :group 'anything-config)
  877. (defcustom anything-raise-command nil
  878. "A shell command to jump to a window running specific program.
  879. Need external program wmctrl.
  880. This will be use with `format', so use something like \"wmctrl -xa %s\"."
  881. :type 'string
  882. :group 'anything-config)
  883. (defun anything-set-anything-command-map-prefix-key (var key)
  884. "The customize set function for `anything-command-map-prefix-key'."
  885. (when (boundp var)
  886. (define-key global-map (read-kbd-macro (symbol-value var)) nil))
  887. (set var key)
  888. (define-key global-map
  889. (read-kbd-macro (symbol-value var)) 'anything-command-map))
  890. (defcustom anything-command-map-prefix-key "C-x c"
  891. "The prefix key for all `anything-command-map' commands."
  892. :type 'string
  893. :set 'anything-set-anything-command-map-prefix-key
  894. :group 'anything-config)
  895. (defcustom anything-c-browse-code-regexp-lisp
  896. "^ *\(def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|\
  897. type\\|theme\\|var\\|group\\|custom\\|const\\|method\\|class\\)"
  898. "Regexp used to parse lisp buffer when browsing code."
  899. :type 'string
  900. :group 'anything-config)
  901. (defcustom anything-c-browse-code-regexp-python
  902. "\\<def\\>\\|\\<class\\>"
  903. "Regexp used to parse python buffer when browsing code."
  904. :type 'string
  905. :group 'anything-config)
  906. (defcustom anything-c-browse-code-regexp-alist
  907. `((lisp-interaction-mode . ,anything-c-browse-code-regexp-lisp)
  908. (emacs-lisp-mode . ,anything-c-browse-code-regexp-lisp)
  909. (lisp-mode . ,anything-c-browse-code-regexp-lisp)
  910. (python-mode . ,anything-c-browse-code-regexp-python))
  911. "Alist to store regexps for browsing code corresponding \
  912. to a specific `major-mode'."
  913. :type 'list
  914. :group 'anything-config)
  915. (defcustom anything-c-external-programs-associations nil
  916. "Alist to store externals programs associated with file extension.
  917. This variable overhide setting in .mailcap file.
  918. e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) "
  919. :type 'list
  920. :group 'anything-config)
  921. (defcustom anything-ff-auto-update-initial-value t
  922. "Auto update when only one candidate directory is matched.
  923. This is the default value when starting `anything-find-files'."
  924. :group 'anything-config
  925. :type 'boolean)
  926. (defcustom anything-c-copy-async-prefered-emacs "emacs"
  927. "Path to the emacs you want to use for copying async.
  928. Emacs versions < 24 fail to copy directory due to a bug not fixed
  929. in `copy-directory'."
  930. :group 'anything-config
  931. :type 'string)
  932. (defcustom anything-ff-lynx-style-map t
  933. "Use arrow keys to navigate with `anything-find-files'.
  934. You will have to restart Emacs or reeval `anything-find-files-map'
  935. and `anything-c-read-file-map' for this take effect."
  936. :group 'anything-config
  937. :type 'boolean)
  938. (defcustom anything-ff-history-max-length 100
  939. "Number of elements shown in `anything-find-files' history."
  940. :group 'anything-config
  941. :type 'integer)
  942. (defcustom anything-ff-smart-completion t
  943. "Try to complete filenames smarter when non--nil.
  944. See `anything-ff-transform-fname-for-completion' for more info."
  945. :group 'anything-config
  946. :type 'boolean)
  947. (defcustom anything-ff-default-kbsize 1024.0
  948. "Default Kbsize to use for showing files size.
  949. It is a float, usually 1024.0 but could be 1000.0 on some systems."
  950. :group 'anything-config
  951. :type 'float)
  952. (defcustom anything-ff-tramp-not-fancy t
  953. "No colors when listing remote files when set to non--nil.
  954. This make listing much faster, specially on slow machines."
  955. :group 'anything-config
  956. :type 'boolean)
  957. (defcustom anything-ff-exif-data-program "exiftran"
  958. "Program used to extract exif data of an image file."
  959. :group 'anything-config
  960. :type 'string)
  961. (defcustom anything-ff-exif-data-program-args "-d"
  962. "*Arguments used for `anything-ff-exif-data-program'."
  963. :group 'anything-config
  964. :type 'string)
  965. (defcustom anything-c-grep-use-ioccur-style-keys t
  966. "Use Arrow keys to jump to occurences."
  967. :group 'anything-config
  968. :type 'boolean)
  969. (defcustom anything-c-pdfgrep-default-read-command "xpdf '%f' %p"
  970. "Default command to read pdf files from pdfgrep.
  971. Where '%f' format spec is filename and '%p' is page number"
  972. :group 'anything-config
  973. :type 'string)
  974. (defcustom anything-c-etags-tag-file-name "TAGS"
  975. "Etags tag file name."
  976. :type 'string
  977. :group 'anything-config)
  978. (defcustom anything-c-etags-tag-file-search-limit 10
  979. "The limit level of directory to search tag file.
  980. Don't search tag file deeply if outside this value."
  981. :type 'number
  982. :group 'anything-config)
  983. (defcustom anything-c-etags-use-regexp-search nil
  984. "When non--nil search etags candidates by regexp.
  985. This disable anything-match-plugin when enabled.
  986. When nil search is performed directly on patter and *match-plugin is used
  987. if available. You can customize `anything-c-etags-search-regexp'."
  988. :group 'anything-config
  989. :type 'boolean)
  990. (defcustom anything-c-etags-search-regexp "^.+: .+ \\<%s"
  991. "Regexp that match tags in an anything etags buffer.
  992. The format spec is replaced by pattern.
  993. This regexp have no effect when `anything-c-etags-use-regexp-search'
  994. is nil."
  995. :group 'anything-config
  996. :type 'regexp)
  997. (defcustom anything-c-filelist-file-name nil
  998. "Filename of file list.
  999. Accept a list of string for multiple files.
  1000. This file tend to be very large \(> 100MB\) and recommend to be in ramdisk for speed.
  1001. File list is created by make-filelist.rb script.
  1002. Usage:
  1003. ruby make-filelist.rb > /tmp/all.filelist
  1004. Then
  1005. ;; Assume that /tmp is ramdisk or tmpfs
  1006. \(setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\"\)
  1007. \(setq anything-c-filelist-file-name \"/tmp/all.filelist\"\)
  1008. "
  1009. :type 'string
  1010. :group 'anything-config)
  1011. (defcustom anything-c-eldoc-in-minibuffer-show-fn
  1012. 'anything-c-show-info-in-mode-line
  1013. "A function to display eldoc info.
  1014. Should take one arg: the string to display."
  1015. :group 'anything-config
  1016. :type 'symbol)
  1017. (defcustom anything-c-turn-on-show-completion t
  1018. "Display candidate in buffer while moving selection when non--nil."
  1019. :group 'anything-config
  1020. :type 'boolean)
  1021. (defcustom anything-c-show-completion-use-special-display t
  1022. "A special display will be used in lisp completion if non--nil.
  1023. All functions that are wrapped in macro `with-anything-show-completion'
  1024. will be affected."
  1025. :group 'anything-config
  1026. :type 'boolean)
  1027. (defcustom anything-c-show-completion-min-window-height 7
  1028. "Minimum completion window height used in show completion.
  1029. This is used in macro `with-anything-show-completion'."
  1030. :group 'anything-config
  1031. :type 'integer)
  1032. (defcustom anything-lisp-completion-or-indent-delay 0.6
  1033. "After this delay `anything-lisp-completion-counter' is reset to 0.
  1034. This allow to indent again without completing lisp symbol after this delay.
  1035. Default is 0.6 seconds."
  1036. :group 'anything-config
  1037. :type 'number)
  1038. (defcustom anything-c-default-external-file-browser "nautilus"
  1039. "Default external file browser for your system.
  1040. Directories will be opened externally with it when
  1041. opening file externally in `anything-find-files'.
  1042. Set to nil if you do not have external file browser
  1043. or do not want to use it.
  1044. Windows users should set that to \"explorer.exe\"."
  1045. :group 'anything-config
  1046. :type 'string)
  1047. (defcustom anything-c-use-adaptative-sorting nil
  1048. "Wheter to use or not adaptative sorting.
  1049. Even if a source use it, it will have no effect when set to nil."
  1050. :type 'boolean
  1051. :group 'anything-config)
  1052. (defcustom anything-ff-newfile-prompt-p t
  1053. "Whether Prompt or not when creating new file.
  1054. This set `ffap-newfile-prompt'."
  1055. :type 'boolean
  1056. :group 'anything-config)
  1057. (defcustom anything-ff-avfs-directory nil
  1058. "The default avfs directory, usually '.avfs'.
  1059. When this is set you will be able to expand archive filenames with `C-z'
  1060. inside an avfs directory mounted with mountavfs.
  1061. See <http://sourceforge.net/projects/avf/>."
  1062. :type 'boolean
  1063. :group 'anything-config)
  1064. (defcustom anything-ff-file-compressed-list '("gz" "bz2" "zip" "7z")
  1065. "Minimal list of compressed files extension."
  1066. :type 'list
  1067. :group 'anything-config)
  1068. (defcustom anything-locate-db-file-regexp "m?locate\.db$"
  1069. "Default regexp to match locate database.
  1070. If nil Search in all files."
  1071. :type 'string
  1072. :group 'anything-config)
  1073. (defcustom anything-ff-locate-db-filename "locate.db"
  1074. "The basename of the locatedb file you use locally in your directories.
  1075. When this is set and `anything' find such a file in the directory from
  1076. where you launch locate, it will use this file and will not prompt you
  1077. for a db file.
  1078. Note that this happen only when locate is launched with a prefix arg."
  1079. :group 'anything-config
  1080. :type 'string)
  1081. (defcustom anything-c-locate-command nil
  1082. "A list of arguments for locate program.
  1083. If nil it will be calculated when `anything-locate' startup
  1084. with these default values for different systems:
  1085. Gnu/linux: \"locate -i -r %s\"
  1086. berkeley-unix: \"locate -i %s\"
  1087. windows-nt: \"es -i -r %s\"
  1088. Others: \"locate %s\"
  1089. This string will be passed to format so it should end with `%s'.
  1090. The \"-r\" option must be the last option."
  1091. :type 'string
  1092. :group 'anything-config)
  1093. (defcustom anything-c-show-info-in-mode-line-delay 12
  1094. "Eldoc will show info in mode-line during this delay if user is idle."
  1095. :type 'integer
  1096. :group 'anything-config)
  1097. (defcustom anything-c-copy-files-async-log-file "/tmp/dired.log"
  1098. "The file used to communicate with two emacs when copying files async."
  1099. :type 'string
  1100. :group 'anything-config)
  1101. (defcustom anything-ff-printer-list nil
  1102. "A list of available printers on your system.
  1103. When non--nil let you choose a printer to print file.
  1104. Otherwise when nil the variable `printer-name' will be used.
  1105. On Unix based systems (lpstat command needed) you don't need to set this,
  1106. `anything-ff-find-printers' will find a list of available printers for you."
  1107. :type 'list
  1108. :group 'anything-config)
  1109. (defcustom anything-ff-transformer-show-only-basename nil
  1110. "Show only basename of candidates in `anything-find-files'.
  1111. This can be toggled at anytime from `anything-find-files' with \
  1112. \\<anything-find-files-map>0\\[anything-ff-run-toggle-basename]."
  1113. :type 'boolean
  1114. :group 'anything-config)
  1115. (defcustom anything-ff-quick-delete-dont-prompt-for-deletion nil
  1116. "Don't ask in persistent deletion of files when non--nil."
  1117. :group 'anything-config
  1118. :type 'boolean)
  1119. (defcustom anything-ff-signal-error-on-dot-files t
  1120. "Signal error when file is `.' or `..' on file deletion when non--nil.
  1121. Default is non--nil.
  1122. WARNING: Setting this to nil is unsafe and can cause deletion of a whole tree."
  1123. :group 'anything-config
  1124. :type 'boolean)
  1125. (defcustom anything-completing-read-handlers-alist
  1126. '((describe-function . anything-completing-read-symbols)
  1127. (describe-variable . anything-completing-read-symbols)
  1128. (debug-on-entry . anything-completing-read-symbols)
  1129. (find-function . anything-completing-read-symbols)
  1130. (trace-function . anything-completing-read-symbols)
  1131. (trace-function-background . anything-completing-read-symbols)
  1132. (find-tag . anything-completing-read-with-cands-in-buffer)
  1133. (ffap-alternate-file . nil))
  1134. "Alist of handlers to replace `completing-read', `read-file-name' in `ac-mode'.
  1135. Each entry is a cons cell like \(emacs_command . completing-read_handler\)
  1136. where key and value are symbols.
  1137. Each key is an Emacs command that use originaly `completing-read'.
  1138. Each value maybe an anything function that take same arguments as
  1139. `completing-read' plus NAME and BUFFER, where NAME is the name of the new
  1140. anything source and BUFFER the name of the buffer we will use.
  1141. This function prefix name must start by \"anything\".
  1142. See `anything-completing-read-symbols' for example.
  1143. If the value of an entry is nil completion will fall back to
  1144. emacs vanilla behavior.
  1145. e.g If you want to disable anything completion for `describe-function':
  1146. \(describe-function . nil\).
  1147. Ido is also supported, you can use `ido-completing-read' and
  1148. `ido-read-file-name' as value of an entry or just 'ido.
  1149. e.g ido completion for `find-file':
  1150. \(find-file . ido\)
  1151. same as
  1152. \(find-file . ido-read-file-name\)
  1153. Note that you don't need to enable `ido-mode' for this to work."
  1154. :group 'anything-config
  1155. :type '(alist :key-type symbol :value-type symbol))
  1156. (defcustom anything-M-x-requires-pattern 2
  1157. "Value of requires-pattern for `anything-M-x'.
  1158. Set it to 0 to disable requires-pattern in `anything-M-x'."
  1159. :group 'anything-config
  1160. :type 'boolean)
  1161. ;;; Build info-index sources with info-index plug-in.
  1162. ;;
  1163. ;;
  1164. (defun anything-c-build-info-index-command (name doc source buffer)
  1165. "Define an anything command NAME with documentation DOC.
  1166. Arg SOURCE will be an existing anything source named
  1167. `anything-c-source-info-<NAME>' and BUFFER a string buffer name."
  1168. (eval (list 'defun name nil doc
  1169. (list 'interactive)
  1170. (list 'anything
  1171. :sources source
  1172. :buffer buffer
  1173. :candidate-number-limit 1000))))
  1174. (defun anything-c-define-info-index-sources (var-value &optional commands)
  1175. "Define anything sources named anything-c-source-info-<NAME>.
  1176. Sources are generated for all entries of `anything-c-default-info-index-list'.
  1177. If COMMANDS arg is non--nil build also commands named `anything-info<NAME>'.
  1178. Where NAME is one of `anything-c-default-info-index-list'."
  1179. (loop with symbols = (loop for str in var-value
  1180. collect
  1181. (intern (concat "anything-c-source-info-" str)))
  1182. for sym in symbols
  1183. for str in var-value
  1184. do (set sym (list (cons 'name (format "Info index: %s" str))
  1185. (cons 'info-index str)))
  1186. when commands
  1187. do (let ((com (intern (concat "anything-info-" str))))
  1188. (anything-c-build-info-index-command com
  1189. (format "Predefined anything for %s info." str) sym
  1190. (format "*anything info %s*" str)))))
  1191. (defun anything-info-index-set (var value)
  1192. (set var value)
  1193. (anything-c-define-info-index-sources value t))
  1194. (defcustom anything-c-default-info-index-list
  1195. '("elisp" "cl" "org" "gnus" "tramp" "ratpoison"
  1196. "zsh" "bash" "coreutils" "fileutils"
  1197. "find" "sh-utils" "textutils" "libc"
  1198. "make" "automake" "autoconf" "emacs-lisp-intro"
  1199. "emacs" "elib" "eieio" "gauche-refe" "guile"
  1200. "guile-tut" "goops" "screen" "latex" "gawk"
  1201. "sed" "m4" "wget" "binutils" "as" "bfd" "gprof"
  1202. "ld" "diff" "flex" "grep" "gzip" "libtool"
  1203. "texinfo" "info" "gdb" "stabs" "cvsbook" "cvs"
  1204. "bison" "id-utils" "global")
  1205. "Info Manual entries to use for building anything info index commands."
  1206. :group 'anything-config
  1207. :type 'list
  1208. :set 'anything-info-index-set)
  1209. (defcustom anything-c-register-max-offset 160
  1210. "Max size of string register entries before truncating."
  1211. :group 'anything-config
  1212. :type 'integer)
  1213. ;;; General internal variables
  1214. ;;
  1215. ;; Some internals variable that need to be loaded
  1216. ;; here to avoid compiler warnings.
  1217. (defvar anything-c-external-commands-list nil
  1218. "A list of all external commands the user can execute. If this
  1219. variable is not set by the user, it will be calculated
  1220. automatically.")
  1221. (defvar anything-c-show-completion-overlay nil)
  1222. ;;; Faces
  1223. ;;
  1224. ;;
  1225. (defface anything-buffer-saved-out
  1226. '((t (:foreground "red")))
  1227. "*Face used for buffer files modified outside of emacs."
  1228. :group 'anything-config)
  1229. (defface anything-buffer-not-saved
  1230. '((t (:foreground "Indianred2")))
  1231. "*Face used for buffer files not already saved on disk."
  1232. :group 'anything-config)
  1233. (defface anything-ff-prefix
  1234. '((t (:background "yellow" :foreground "black")))
  1235. "*Face used to prefix new file or url paths in `anything-find-files'."
  1236. :group 'anything-config)
  1237. (defface anything-ff-executable
  1238. '((t (:foreground "green")))
  1239. "*Face used for executable files in `anything-find-files'."
  1240. :group 'anything-config)
  1241. (defface anything-ff-directory
  1242. '((t (:foreground "DarkRed" :background "LightGray")))
  1243. "*Face used for directories in `anything-find-files'."
  1244. :group 'anything-config)
  1245. (defface anything-ff-symlink
  1246. '((t (:foreground "DarkOrange")))
  1247. "*Face used for symlinks in `anything-find-files'."
  1248. :group 'anything-config)
  1249. (defface anything-ff-invalid-symlink
  1250. '((t (:foreground "black" :background "red")))
  1251. "*Face used for invalid symlinks in `anything-find-files'."
  1252. :group 'anything-config)
  1253. (defface anything-ff-file
  1254. '((t (:foreground "CadetBlue" :underline t)))
  1255. "*Face used for file names in `anything-find-files'."
  1256. :group 'anything-config)
  1257. (defface anything-grep-match
  1258. '((t (:inherit match)))
  1259. "Face used to highlight grep matches."
  1260. :group 'anything-config)
  1261. (defface anything-grep-file
  1262. '((t (:foreground "BlueViolet" :underline t)))
  1263. "Face used to highlight grep results filenames."
  1264. :group 'anything-config)
  1265. (defface anything-grep-lineno
  1266. '((t (:foreground "Darkorange1")))
  1267. "Face used to highlight grep number lines."
  1268. :group 'anything-config)
  1269. (defface anything-grep-running
  1270. '((t (:foreground "Red")))
  1271. "Face used in mode line when grep is running."
  1272. :group 'anything-config)
  1273. (defface anything-grep-finish
  1274. '((t (:foreground "Green")))
  1275. "Face used in mode line when grep is finish."
  1276. :group 'anything-config)
  1277. (defface anything-M-x-key-face '((t (:foreground "orange" :underline t)))
  1278. "*Face used in anything-M-x to show keybinding."
  1279. :group 'anything)
  1280. (defface anything-bmkext-info
  1281. '((t (:foreground "green")))
  1282. "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
  1283. :group 'anything)
  1284. (defface anything-bmkext-w3m
  1285. '((t (:foreground "yellow")))
  1286. "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
  1287. :group 'anything)
  1288. (defface anything-bmkext-gnus
  1289. '((t (:foreground "magenta")))
  1290. "*Face used for Gnus bookmarks."
  1291. :group 'anything)
  1292. (defface anything-bmkext-man
  1293. '((t (:foreground "Orange4")))
  1294. "*Face used for Woman/man bookmarks."
  1295. :group 'anything)
  1296. (defface anything-bmkext-no--file
  1297. '((t (:foreground "grey")))
  1298. "*Face used for non--file bookmarks."
  1299. :group 'anything)
  1300. (defface anything-bmkext-file
  1301. '((t (:foreground "Deepskyblue2")))
  1302. "*Face used for non--file bookmarks."
  1303. :group 'anything)
  1304. (defface anything-bookmarks-su-face '((t (:foreground "red")))
  1305. "Face for su/sudo bookmarks."
  1306. :group 'anything)
  1307. (defface anything-w3m-bookmarks-face '((t (:foreground "cyan1" :underline t)))
  1308. "Face for w3m bookmarks" :group 'anything)
  1309. (defface anything-emms-playlist
  1310. '((t (:foreground "Springgreen4" :underline t)))
  1311. "*Face used for tracks in current emms playlist."
  1312. :group 'anything)
  1313. (defface anything-apt-installed
  1314. '((t (:foreground "green")))
  1315. "*Face used for apt installed candidates."
  1316. :group 'anything)
  1317. (defface anything-apt-deinstalled
  1318. '((t (:foreground "DimGray")))
  1319. "*Face used for apt deinstalled candidates."
  1320. :group 'anything)
  1321. (defface anything-gentoo-match-face '((t (:foreground "red")))
  1322. "Face for anything-gentoo installed packages."
  1323. :group 'traverse-faces)
  1324. (defface anything-lisp-show-completion
  1325. '((t (:background "DarkSlateGray")))
  1326. "*Face used for showing candidates in `anything-lisp-completion'."
  1327. :group 'anything-config)
  1328. (defface anything-lisp-completion-info
  1329. '((t (:foreground "red")))
  1330. "*Face used for showing info in `anything-lisp-completion'."
  1331. :group 'anything-config)
  1332. (defface anything-overlay-line-face '((t (:background "IndianRed4" :underline t)))
  1333. "Face for source header in the anything buffer." :group 'anything)
  1334. ;;;###autoload
  1335. (defun anything-configuration ()
  1336. "Customize `anything'."
  1337. (interactive)
  1338. (customize-group "anything-config"))
  1339. ;;; Anything-command-map
  1340. ;;
  1341. ;;
  1342. ;;;###autoload
  1343. (defvar anything-command-map)
  1344. (define-prefix-command 'anything-command-map)
  1345. (define-key anything-command-map (kbd "<SPC>") 'anything-execute-anything-command)
  1346. (define-key anything-command-map (kbd "a") 'anything-c-apropos)
  1347. (define-key anything-command-map (kbd "e") 'anything-c-etags-select)
  1348. (define-key anything-command-map (kbd "l") 'anything-locate)
  1349. (define-key anything-command-map (kbd "s") 'anything-surfraw)
  1350. (define-key anything-command-map (kbd "r") 'anything-regexp)
  1351. (define-key anything-command-map (kbd "w") 'anything-w3m-bookmarks)
  1352. (define-key anything-command-map (kbd "x") 'anything-firefox-bookmarks)
  1353. (define-key anything-command-map (kbd "#") 'anything-emms)
  1354. (define-key anything-command-map (kbd "m") 'anything-man-woman)
  1355. (define-key anything-command-map (kbd "t") 'anything-top)
  1356. (define-key anything-command-map (kbd "i") 'anything-imenu)
  1357. (define-key anything-command-map (kbd "<tab>") 'anything-lisp-completion-at-point)
  1358. (define-key anything-command-map (kbd "p") 'anything-list-emacs-process)
  1359. (define-key anything-command-map (kbd "C-x r b") 'anything-c-pp-bookmarks)
  1360. (define-key anything-command-map (kbd "M-y") 'anything-show-kill-ring)
  1361. (define-key anything-command-map (kbd "C-c <SPC>") 'anything-all-mark-rings)
  1362. (define-key anything-command-map (kbd "C-x C-f") 'anything-find-files)
  1363. (define-key anything-command-map (kbd "f") 'anything-for-files)
  1364. (define-key anything-command-map (kbd "C-:") 'anything-eval-expression-with-eldoc)
  1365. (define-key anything-command-map (kbd "C-,") 'anything-calcul-expression)
  1366. (define-key anything-command-map (kbd "M-x") 'anything-M-x)
  1367. (define-key anything-command-map (kbd "C-x C-w") 'anything-write-file)
  1368. (define-key anything-command-map (kbd "C-x i") 'anything-insert-file)
  1369. (define-key anything-command-map (kbd "M-s o") 'anything-occur)
  1370. (define-key anything-command-map (kbd "M-g s") 'anything-do-grep)
  1371. (define-key anything-command-map (kbd "c") 'anything-colors)
  1372. (define-key anything-command-map (kbd "F") 'anything-select-xfont)
  1373. (define-key anything-command-map (kbd "C-c f") 'anything-recentf)
  1374. (define-key anything-command-map (kbd "C-c g") 'anything-google-suggest)
  1375. (define-key anything-command-map (kbd "h i") 'anything-info-at-point)
  1376. (define-key anything-command-map (kbd "h r") 'anything-info-emacs)
  1377. (define-key anything-command-map (kbd "h g") 'anything-info-gnus)
  1378. (define-key anything-command-map (kbd "C-x C-b") 'anything-buffers-list)
  1379. (define-key anything-command-map (kbd "C-c C-b") 'anything-browse-code)
  1380. (define-key anything-command-map (kbd "C-x r i") 'anything-register)
  1381. (define-key anything-command-map (kbd "C-c C-x") 'anything-c-run-external-command)
  1382. ;; In Emacs 23.1.50, minibuffer-local-must-match-filename-map was renamed to
  1383. ;; minibuffer-local-filename-must-match-map.
  1384. (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) ;; Emacs 23.1.+
  1385. (defvar minibuffer-local-must-match-filename-map (make-sparse-keymap)) ;; Older Emacsen
  1386. (dolist (map (list minibuffer-local-filename-completion-map
  1387. minibuffer-local-completion-map
  1388. minibuffer-local-must-match-filename-map
  1389. minibuffer-local-filename-must-match-map
  1390. minibuffer-local-map
  1391. minibuffer-local-isearch-map
  1392. minibuffer-local-must-match-map
  1393. minibuffer-local-ns-map))
  1394. (define-key map "\C-r" 'anything-minibuffer-history))
  1395. ;;; Menu
  1396. ;;
  1397. ;;
  1398. (easy-menu-define nil global-map
  1399. "`anything' menu"
  1400. '("Anything"
  1401. ["All anything commands" anything-execute-anything-command t]
  1402. ["Find any Files/Buffers" anything-for-files t]
  1403. ["Anything Everywhere (Toggle)" ac-mode t]
  1404. "----"
  1405. ("Files:"
  1406. ["Find files" anything-find-files t]
  1407. ["Recent Files" anything-recentf t]
  1408. ["Locate" anything-locate t]
  1409. ["Bookmarks" anything-c-pp-bookmarks t])
  1410. ("Buffers:"
  1411. ["Find buffers" anything-buffers-list t])
  1412. ("Commands:"
  1413. ["Emacs Commands" anything-M-x t]
  1414. ["Externals Commands" anything-c-run-external-command t])
  1415. ("Help:"
  1416. ["Anything Apropos" anything-c-apropos t])
  1417. ("Info:"
  1418. ["Info at point" anything-info-at-point t]
  1419. ["Emacs Manual index" anything-info-emacs t]
  1420. ["Gnus Manual index" anything-info-gnus t])
  1421. ("Org:"
  1422. ["Org keywords" anything-org-keywords t]
  1423. ["Org headlines" anything-org-headlines t])
  1424. ("Tools:"
  1425. ["Occur" anything-occur t]
  1426. ["Grep" anything-do-grep t]
  1427. ["Etags" anything-c-etags-select t]
  1428. ["Lisp complete at point" anything-lisp-completion-at-point t]
  1429. ["Browse Kill ring" anything-show-kill-ring t]
  1430. ["Browse register" anything-register t]
  1431. ["Browse code" anything-browse-code t]
  1432. ["Mark Ring" anything-all-mark-rings t]
  1433. ["Regexp handler" anything-regexp t]
  1434. ["Colors & Faces" anything-colors t]
  1435. ["Show xfonts" anything-select-xfont t]
  1436. ["Ucs Symbols" anything-ucs t]
  1437. ["Imenu" anything-imenu t]
  1438. ["Google Suggest" anything-google-suggest t]
  1439. ["Eval expression" anything-eval-expression-with-eldoc t]
  1440. ["Calcul expression" anything-calcul-expression t]
  1441. ["Man pages" anything-man-woman t]
  1442. ["Top externals process" anything-top t]
  1443. ["Emacs internals process" anything-list-emacs-process t])
  1444. "----"
  1445. ["Prefered Options" anything-configuration t]))
  1446. ;;; Anything map add ons
  1447. ;;
  1448. ;;
  1449. (define-key anything-map (kbd "C-x C-f") 'anything-quit-and-find-file)
  1450. (define-key anything-map (kbd "M-m") 'anything-toggle-all-marks)
  1451. (define-key anything-map (kbd "C-w") 'anything-yank-text-at-point)
  1452. ;;; Specialized keymaps
  1453. ;;
  1454. ;;
  1455. (defvar anything-c-buffer-map
  1456. (let ((map (copy-keymap anything-map)))
  1457. (define-key map (kbd "C-c ?") 'anything-c-buffer-help)
  1458. ;; No need to have separate command for grep and zgrep
  1459. ;; as we don't use recursivity for buffers.
  1460. ;; So use zgrep for both as it is capable to handle non--compressed files.
  1461. (define-key map (kbd "M-g s") 'anything-buffer-run-zgrep)
  1462. (define-key map (kbd "C-c o") 'anything-buffer-switch-other-window)
  1463. (define-key map (kbd "C-c C-o") 'anything-buffer-switch-other-frame)
  1464. (define-key map (kbd "C-c =") 'anything-buffer-run-ediff)
  1465. (define-key map (kbd "M-=") 'anything-buffer-run-ediff-merge)
  1466. (define-key map (kbd "C-=") 'anything-buffer-diff-persistent)
  1467. (define-key map (kbd "M-U") 'anything-buffer-revert-persistent)
  1468. (define-key map (kbd "M-D") 'anything-buffer-run-kill-buffers)
  1469. (define-key map (kbd "C-x C-s") 'anything-buffer-save-persistent)
  1470. (define-key map (kbd "C-M-%") 'anything-buffer-run-query-replace-regexp)
  1471. (define-key map (kbd "M-%") 'anything-buffer-run-query-replace)
  1472. (define-key map (kbd "M-m") 'anything-toggle-all-marks)
  1473. (define-key map (kbd "M-a") 'anything-mark-all)
  1474. (when (locate-library "elscreen")
  1475. (define-key map (kbd "<C-tab>") 'anything-buffer-switch-to-elscreen))
  1476. (delq nil map))
  1477. "Keymap for buffer sources in anything.")
  1478. (defvar anything-find-files-map
  1479. (let ((map (copy-keymap anything-map)))
  1480. (define-key map (kbd "C-]") 'anything-ff-run-toggle-basename)
  1481. (define-key map (kbd "C-x C-f") 'anything-ff-run-locate)
  1482. (define-key map (kbd "M-g s") 'anything-ff-run-grep)
  1483. (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
  1484. (define-key map (kbd "M-g z") 'anything-ff-run-zgrep)
  1485. (define-key map (kbd "M-.") 'anything-ff-run-etags)
  1486. (define-key map (kbd "M-R") 'anything-ff-run-rename-file)
  1487. (define-key map (kbd "M-C") 'anything-ff-run-copy-file)
  1488. (define-key map (kbd "M-B") 'anything-ff-run-byte-compile-file)
  1489. (define-key map (kbd "M-L") 'anything-ff-run-load-file)
  1490. (define-key map (kbd "M-S") 'anything-ff-run-symlink-file)
  1491. (define-key map (kbd "M-H") 'anything-ff-run-hardlink-file)
  1492. (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
  1493. (define-key map (kbd "M-K") 'anything-ff-run-kill-buffer-persistent)
  1494. (define-key map (kbd "C-d") 'anything-ff-persistent-delete)
  1495. (define-key map (kbd "M-e") 'anything-ff-run-switch-to-eshell)
  1496. (define-key map (kbd "<M-tab>") 'anything-ff-run-complete-fn-at-point)
  1497. (define-key map (kbd "C-c o") 'anything-ff-run-switch-other-window)
  1498. (define-key map (kbd "C-c C-o") 'anything-ff-run-switch-other-frame)
  1499. (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
  1500. (define-key map (kbd "M-!") 'anything-ff-run-eshell-command-on-file)
  1501. (define-key map (kbd "C-=") 'anything-ff-run-ediff-file)
  1502. (define-key map (kbd "C-c =") 'anything-ff-run-ediff-merge-file)
  1503. (define-key map (kbd "M-p") 'anything-ff-run-switch-to-history)
  1504. (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
  1505. (define-key map (kbd "C-c ?") 'anything-ff-help)
  1506. (define-key map (kbd "C-}") 'anything-narrow-window)
  1507. (define-key map (kbd "C-{") 'anything-enlarge-window)
  1508. (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
  1509. (define-key map (kbd "M-a") 'anything-mark-all)
  1510. (define-key map (kbd "M-m") 'anything-toggle-all-marks)
  1511. (define-key map (kbd "M-u") 'anything-unmark-all)
  1512. (define-key map (kbd "C-c C-a") 'anything-ff-run-gnus-attach-files)
  1513. (define-key map (kbd "C-c p") 'anything-ff-run-print-file)
  1514. ;; Next 2 have no effect if candidate is not an image file.
  1515. (define-key map (kbd "M-l") 'anything-ff-rotate-left-persistent)
  1516. (define-key map (kbd "M-r") 'anything-ff-rotate-right-persistent)
  1517. (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
  1518. (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
  1519. (define-key map (kbd "C-h C-b") 'anything-send-bug-report-from-anything)
  1520. (define-key map (kbd "C-h C-d") 'anything-debug-output)
  1521. (when anything-ff-lynx-style-map
  1522. (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
  1523. (define-key map (kbd "<right>") 'anything-execute-persistent-action))
  1524. (delq nil map))
  1525. "Keymap for `anything-find-files'.")
  1526. (defvar anything-c-read-file-map
  1527. (let ((map (copy-keymap anything-map)))
  1528. (define-key map (kbd "C-]") 'anything-ff-run-toggle-basename)
  1529. (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
  1530. (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
  1531. (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
  1532. (define-key map (kbd "C-c ?") 'anything-read-file-name-help)
  1533. (when anything-ff-lynx-style-map
  1534. (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
  1535. (define-key map (kbd "<right>") 'anything-execute-persistent-action)
  1536. (define-key map (kbd "C-o") nil)
  1537. (define-key map (kbd "<M-left>") 'anything-previous-source)
  1538. (define-key map (kbd "<M-right>") 'anything-next-source))
  1539. (delq nil map))
  1540. "Keymap for `anything-c-read-file-name'.")
  1541. (defvar anything-generic-files-map
  1542. (let ((map (copy-keymap anything-map)))
  1543. (define-key map (kbd "M-g s") 'anything-ff-run-grep)
  1544. (define-key map (kbd "M-g z") 'anything-ff-run-zgrep)
  1545. (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
  1546. (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
  1547. (define-key map (kbd "C-=") 'anything-ff-run-ediff-file)
  1548. (define-key map (kbd "C-c =") 'anything-ff-run-ediff-merge-file)
  1549. (define-key map (kbd "C-c o") 'anything-ff-run-switch-other-window)
  1550. (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
  1551. (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
  1552. (define-key map (kbd "C-w") 'anything-yank-text-at-point)
  1553. (define-key map (kbd "C-c ?") 'anything-generic-file-help)
  1554. map)
  1555. "Generic Keymap for files.")
  1556. (defvar anything-c-grep-map
  1557. (let ((map (copy-keymap anything-map)))
  1558. (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
  1559. (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
  1560. (define-key map (kbd "C-c o") 'anything-c-grep-run-other-window-action)
  1561. (define-key map (kbd "C-w") 'anything-yank-text-at-point)
  1562. (define-key map (kbd "C-x C-s") 'anything-c-grep-run-save-buffer)
  1563. (when anything-c-grep-use-ioccur-style-keys
  1564. (define-key map (kbd "<right>") 'anything-c-grep-run-persistent-action)
  1565. (define-key map (kbd "<left>") 'anything-c-grep-run-default-action))
  1566. (define-key map (kbd "C-c ?") 'anything-grep-help)
  1567. (delq nil map))
  1568. "Keymap used in Grep sources.")
  1569. (defvar anything-c-pdfgrep-map
  1570. (let ((map (copy-keymap anything-map)))
  1571. (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
  1572. (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
  1573. (define-key map (kbd "C-w") 'anything-yank-text-at-point)
  1574. (define-key map (kbd "C-c ?") 'anything-pdfgrep-help)
  1575. map)
  1576. "Keymap used in pdfgrep.")
  1577. (defvar anything-c-etags-map
  1578. (let ((map (copy-keymap anything-map)))
  1579. (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
  1580. (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
  1581. (define-key map (kbd "C-w") 'anything-yank-text-at-point)
  1582. (define-key map (kbd "C-c ?") 'anything-etags-help)
  1583. map)
  1584. "Keymap used in Etags.")
  1585. (defvar anything-eval-expression-map
  1586. (let ((map (copy-keymap anything-map)))
  1587. (define-key map (kbd "<C-return>") 'anything-eval-new-line-and-indent)
  1588. (define-key map (kbd "<tab>") 'lisp-indent-line)
  1589. (define-key map (kbd "<C-tab>") 'lisp-complete-symbol)
  1590. (define-key map (kbd "C-p") 'previous-line)
  1591. (define-key map (kbd "C-n") 'next-line)
  1592. (define-key map (kbd "<up>") 'previous-line)
  1593. (define-key map (kbd "<down>") 'next-line)
  1594. (define-key map (kbd "<right>") 'forward-char)
  1595. (define-key map (kbd "<left>") 'backward-char)
  1596. map))
  1597. (defvar anything-c-ucs-map
  1598. (let ((map (copy-keymap anything-map)))
  1599. (define-key map (kbd "<C-backspace>") 'anything-c-ucs-persistent-delete)
  1600. (define-key map (kbd "<C-left>") 'anything-c-ucs-persistent-backward)
  1601. (define-key map (kbd "<C-right>") 'anything-c-ucs-persistent-forward)
  1602. (define-key map (kbd "<C-return>") 'anything-c-ucs-persistent-insert)
  1603. (define-key map (kbd "C-c ?") 'anything-c-ucs-help)
  1604. map)
  1605. "Keymap for `anything-ucs'.")
  1606. (defvar anything-c-bookmark-map
  1607. (let ((map (copy-keymap anything-map)))
  1608. (define-key map (kbd "C-c o") 'anything-c-bookmark-run-jump-other-window)
  1609. (define-key map (kbd "C-d") 'anything-c-bookmark-run-delete)
  1610. (when (locate-library "bookmark-extensions")
  1611. (define-key map (kbd "M-e") 'anything-c-bmkext-run-edit))
  1612. (define-key map (kbd "C-c ?") 'anything-c-bookmark-help)
  1613. (delq nil map))
  1614. "Generic Keymap for emacs bookmark sources.")
  1615. (defvar anything-esh-on-file-map
  1616. (let ((map (copy-keymap anything-map)))
  1617. (define-key map (kbd "C-c ?") 'anything-esh-help)
  1618. map)
  1619. "Keymap for `anything-find-files-eshell-command-on-file'.")
  1620. (defvar anything-eshell-history-map
  1621. (let ((map (copy-keymap anything-map)))
  1622. (define-key map (kbd "M-p") 'anything-next-line)
  1623. map)
  1624. "Keymap for `anything-eshell-history'.")
  1625. (defvar anything-kill-ring-map
  1626. (let ((map (copy-keymap anything-map)))
  1627. (define-key map (kbd "M-y") 'anything-next-line)
  1628. (define-key map (kbd "M-u") 'anything-previous-line)
  1629. map)
  1630. "Keymap for `anything-show-kill-ring'.")
  1631. (defvar anything-occur-map
  1632. (let ((map (copy-keymap anything-map)))
  1633. (define-key map (kbd "C-M-%") 'anything-occur-run-query-replace-regexp)
  1634. map)
  1635. "Keymap for `anything-occur'.")
  1636. ;;; Embeded documentation.
  1637. ;;
  1638. ;;
  1639. (defun anything-c-list-preconfigured-anything ()
  1640. "Collect preconfigured anything functions in this file."
  1641. (loop with doc
  1642. with sym
  1643. for entry in (cdr (assoc
  1644. (file-truename (locate-library "anything-config"))
  1645. load-history))
  1646. if (and (consp entry)
  1647. (eq (car entry) 'defun)
  1648. (string-match "^Preconfigured.+$"
  1649. (setq doc (or (documentation (setq sym (cdr entry)))
  1650. ""))))
  1651. collect (cons sym (match-string 0 doc))))
  1652. (defun anything-c-format-preconfigured-anything ()
  1653. (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x)))
  1654. (anything-c-list-preconfigured-anything)))
  1655. ;;; Global help message - Used by `anything-help'
  1656. ;;
  1657. ;;
  1658. (setq anything-help-message
  1659. (lambda ()
  1660. (concat
  1661. "\\<anything-map>"
  1662. "`anything' is QuickSilver-like candidate-selection framework.
  1663. Narrow the list by typing some pattern,
  1664. Multiple patterns are allowed by splitting by space.
  1665. Select with natural Emacs operations, choose with RET.
  1666. If you have any problems, press C-c C-x C-b!!
  1667. Feel free to send bug reports. I'll fix them.
  1668. The steps are described in the beginning of anything.el file.
  1669. == Basic Operations ==
  1670. C-p, Up: Previous Line
  1671. C-n, Down : Next Line
  1672. M-v, PageUp : Previous Page
  1673. C-v, PageDown : Next Page
  1674. Enter : Execute first (default) action / Select
  1675. M-< : First Line
  1676. M-> : Last Line
  1677. M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window)
  1678. M-PageDown, C-M-v : Next Page (other-window)
  1679. Tab, C-i : Show action list
  1680. Left : Previous Source
  1681. Right, C-o : Next Source
  1682. C-k : Delete pattern
  1683. C-z : Persistent Action (Execute action with anything session kept)
  1684. C-c C-x C-b: Send a bug report
  1685. == Shortcuts For 2nd/3rd Action ==
  1686. \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line)
  1687. \\[anything-select-3rd-action] : Execute 3rd Action
  1688. == Visible Marks ==
  1689. Visible marks store candidate. Some actions uses marked candidates.
  1690. \\[anything-toggle-visible-mark] : Toggle Visible Mark
  1691. \\[anything-prev-visible-mark] : Previous Mark
  1692. \\[anything-next-visible-mark] : Next Mark
  1693. == Miscellaneous Commands ==
  1694. \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window
  1695. \\[anything-quit-and-find-file] : Drop into `find-file'
  1696. \\[anything-delete-current-selection] : Delete Selected Item (visually)
  1697. \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit
  1698. \\[anything-yank-selection] : Yank Selected Item Into Pattern
  1699. \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action
  1700. \\[anything-force-update] : Recalculate And Redisplay Candidates
  1701. == Global Commands ==
  1702. \\<global-map>\\[anything-resume] revives last `anything' session.
  1703. It is very useful, so you should bind any key.
  1704. Single source is executed by \\[anything-call-source].
  1705. == Preconfigured `anything' ==
  1706. Preconfigured `anything' is commands that uses `anything' interface.
  1707. You can use them without configuration.
  1708. "
  1709. (apply 'concat (anything-c-format-preconfigured-anything))
  1710. "
  1711. Enjoy!")))
  1712. ;;; `anything-buffer-list' help
  1713. ;;
  1714. ;;
  1715. (defvar anything-c-buffer-help-message
  1716. "== Anything Buffer ==
  1717. \nTips:
  1718. You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers.
  1719. Enter then a space and a pattern to narrow down to buffers matching this pattern.
  1720. \nSpecific commands for `anything-buffers-list':
  1721. \\<anything-c-buffer-map>
  1722. \\[anything-buffer-run-zgrep]\t\t->Grep Buffer(s) works as zgrep too. (C-u grep all buffers but non--file buffers).
  1723. \\[anything-buffer-switch-other-window]\t\t->Switch other window.
  1724. \\[anything-buffer-switch-other-frame]\t\t->Switch other frame.
  1725. \\[anything-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers.
  1726. \\[anything-buffer-run-query-replace]\t\t->Query replace in marked buffers.
  1727. \\[anything-buffer-switch-to-elscreen]\t\t->Find buffer in Elscreen.
  1728. \\[anything-buffer-run-ediff]\t\t->Ediff current buffer with candidate. If two marked buffers ediff those buffers.
  1729. \\[anything-buffer-run-ediff-merge]\t\t->Ediff merge current buffer with candidate. If two marked buffers ediff merge those buffers.
  1730. \\[anything-buffer-diff-persistent]\t\t->Toggle Diff buffer with saved file without quitting.
  1731. \\[anything-buffer-revert-persistent]\t\t->Revert buffer without quitting.
  1732. \\[anything-buffer-save-persistent]\t\t->Save buffer without quitting.
  1733. \\[anything-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit.
  1734. \\[anything-toggle-all-marks]\t\t->Toggle all marks.
  1735. \\[anything-mark-all]\t\t->Mark all.
  1736. \\[anything-c-buffer-help]\t\t->Display this help.
  1737. \n== Anything Map ==
  1738. \\{anything-map}")
  1739. ;;;###autoload
  1740. (defun anything-c-buffer-help ()
  1741. "Help command for anything buffers."
  1742. (interactive)
  1743. (let ((anything-help-message anything-c-buffer-help-message))
  1744. (anything-help)))
  1745. ;;; Find files help (`anything-find-files')
  1746. ;;
  1747. ;;
  1748. (defvar anything-ff-help-message
  1749. "== Anything Find Files ==
  1750. \nTips:
  1751. \n- Enter `~/' at end of pattern to quickly reach home directory.
  1752. - Enter `/' at end of pattern to quickly reach root of your file system.
  1753. - Enter `./' at end of pattern to quickly reach `default-directory' (initial start of session).
  1754. - You can complete with partial basename \(e.g \"fb\" will complete \"foobar\"\).
  1755. - Use `C-u C-z' to watch an image.
  1756. - To browse images directories turn on `anything-follow-mode' and navigate with arrow keys.
  1757. - When entered ediff, hitting `C-g' will ask you to use locate to find the file to ediff with.
  1758. \nSpecific commands for `anything-find-files':
  1759. \\<anything-find-files-map>
  1760. \\[anything-ff-run-locate]\t\t->Run Locate on basename of candidate (C-u to specify locate db).
  1761. \\[anything-ff-run-grep]\t\t->Run Grep (C-u Recursive).
  1762. \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
  1763. \\[anything-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive).
  1764. \\[anything-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache)
  1765. \\[anything-ff-run-rename-file]\t\t->Rename File (C-u Follow).
  1766. \\[anything-ff-run-copy-file]\t\t->Copy File (C-u Follow).
  1767. \\[anything-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load).
  1768. \\[anything-ff-run-load-file]\t\t->Load File.
  1769. \\[anything-ff-run-symlink-file]\t\t->Symlink File.
  1770. \\[anything-ff-run-hardlink-file]\t\t->Hardlink file.
  1771. \\[anything-ff-run-delete-file]\t\t->Delete File.
  1772. \\[anything-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting.
  1773. \\[anything-ff-persistent-delete]\t\t->Delete file without quitting.
  1774. \\[anything-ff-run-switch-to-eshell]\t\t->Switch to Eshell.
  1775. \\[anything-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Run on all marked files at once).
  1776. \\[anything-ff-run-ediff-file]\t\t->Ediff file.
  1777. \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
  1778. \\[anything-ff-run-complete-fn-at-point]\t\t->Complete file name at point.
  1779. \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
  1780. \\[anything-ff-run-switch-other-frame]\t\t->Switch other frame.
  1781. \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
  1782. \\[anything-ff-rotate-left-persistent]\t\t->Rotate Image Left.
  1783. \\[anything-ff-rotate-right-persistent]\t\t->Rotate Image Right.
  1784. \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
  1785. \\[anything-ff-run-switch-to-history]\t\t->Switch to anything find-files history.
  1786. \\[anything-ff-properties-persistent]\t\t->Show file properties in a tooltip.
  1787. \\[anything-mark-all]\t\t->Mark all visibles candidates.
  1788. \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
  1789. \\[anything-unmark-all]\t\t->Unmark all candidates, visibles and invisibles.
  1790. \\[anything-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer.
  1791. \\[anything-ff-run-print-file]\t\t->Print file, (C-u to refresh printers list).
  1792. \\[anything-enlarge-window]\t\t->Enlarge anything window.
  1793. \\[anything-narrow-window]\t\t->Narrow anything window.
  1794. \\[anything-ff-run-toggle-basename]\t\t->Toggle basename/fullpath.
  1795. \\[anything-send-bug-report-from-anything]\t\t->Send Bug report.
  1796. \\[anything-ff-help]\t\t->Display this help info.
  1797. \n== Anything Map ==
  1798. \\{anything-map}")
  1799. ;;;###autoload
  1800. (defun anything-ff-help ()
  1801. "Help command for `anything-find-files'."
  1802. (interactive)
  1803. (let ((anything-help-message anything-ff-help-message))
  1804. (anything-help)))
  1805. ;;; Help for `anything-c-read-file-name'
  1806. ;;
  1807. ;;
  1808. (defvar anything-read-file-name-help-message
  1809. "== Anything read file name Map ==\
  1810. \nSpecific commands for anything-c-read-file-name:
  1811. \\<anything-c-read-file-map>
  1812. \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
  1813. \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
  1814. \\[anything-next-source]\t->Goto next source.
  1815. \\[anything-previous-source]\t->Goto previous source.
  1816. \\[anything-read-file-name-help]\t\t->Display this help info.
  1817. \n== Anything Map ==
  1818. \\{anything-map}")
  1819. ;;;###autoload
  1820. (defun anything-read-file-name-help ()
  1821. (interactive)
  1822. (let ((anything-help-message anything-read-file-name-help-message))
  1823. (anything-help)))
  1824. ;;; Generic file help - Used by locate.
  1825. ;;
  1826. ;;
  1827. (defvar anything-generic-file-help-message
  1828. "== Anything Generic files Map ==\
  1829. \nSpecific commands for anything locate and others files sources:
  1830. \\<anything-generic-files-map>
  1831. \\[anything-ff-run-grep]\t\t->Run grep (C-u recurse).
  1832. \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
  1833. \\[anything-ff-run-delete-file]\t\t->Delete file.
  1834. \\[anything-ff-run-ediff-file]\t\t->Ediff file.
  1835. \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
  1836. \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
  1837. \\[anything-ff-properties-persistent]\t\t->Show file properties.
  1838. \\[anything-yank-text-at-point]\t\t->Yank text at point.
  1839. \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
  1840. \nLocate tips:
  1841. You can add after writing search pattern any of the locate command line options.
  1842. e.g -b, -e, -n <number>...etc.
  1843. See Man locate for more infos.
  1844. \n== Anything Map ==
  1845. \\{anything-map}")
  1846. ;;;###autoload
  1847. (defun anything-generic-file-help ()
  1848. (interactive)
  1849. (let ((anything-help-message anything-generic-file-help-message))
  1850. (anything-help)))
  1851. ;;; Grep help
  1852. ;;
  1853. ;;
  1854. (defvar anything-grep-help-message
  1855. "== Anything Grep Map ==\
  1856. \nAnything Grep tips:
  1857. You can start grep with a prefix arg to recurse in subdirectories.
  1858. You can use wild card when selecting files (e.g *.el)
  1859. You can grep in many differents directories by marking files or wild cards.
  1860. You can save your results in a grep-mode buffer, see below.
  1861. \nSpecific commands for Anything Grep:
  1862. \\<anything-c-grep-map>
  1863. \\[anything-c-goto-next-file]\t->Next File.
  1864. \\[anything-c-goto-precedent-file]\t\t->Precedent File.
  1865. \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
  1866. \\[anything-c-grep-run-other-window-action]\t\t->Jump other window.
  1867. \\[anything-c-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-z').
  1868. \\[anything-c-grep-run-default-action]\t\t->Run default action (Same as RET).
  1869. \\[anything-c-grep-run-save-buffer]\t\t->Save to a `grep-mode' enabled buffer.
  1870. \\[anything-grep-help]\t\t->Show this help.
  1871. \n== Anything Map ==
  1872. \\{anything-map}")
  1873. ;;;###autoload
  1874. (defun anything-grep-help ()
  1875. (interactive)
  1876. (let ((anything-help-message anything-grep-help-message))
  1877. (anything-help)))
  1878. ;;; Pdf grep help
  1879. ;;
  1880. ;;
  1881. (defvar anything-pdfgrep-help-message
  1882. "== Anything PdfGrep Map ==\
  1883. \nSpecific commands for Pdf Grep:
  1884. \\<anything-c-pdfgrep-map>
  1885. \\[anything-c-goto-next-file]\t->Next File.
  1886. \\[anything-c-goto-precedent-file]\t\t->Precedent File.
  1887. \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
  1888. \\[anything-pdfgrep-help]\t\t->Show this help.
  1889. \n== Anything Map ==
  1890. \\{anything-map}")
  1891. ;;;###autoload
  1892. (defun anything-pdfgrep-help ()
  1893. (interactive)
  1894. (let ((anything-help-message anything-pdfgrep-help-message))
  1895. (anything-help)))
  1896. ;;; Etags help
  1897. ;;
  1898. ;;
  1899. (defvar anything-etags-help-message
  1900. "== Anything Etags Map ==\
  1901. \nSpecific commands for Etags:
  1902. \\<anything-c-etags-map>
  1903. \\[anything-c-goto-next-file]\t->Next File.
  1904. \\[anything-c-goto-precedent-file]\t\t->Precedent File.
  1905. \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
  1906. \\[anything-etags-help]\t\t->Show this help.
  1907. \n== Anything Map ==
  1908. \\{anything-map}")
  1909. ;;;###autoload
  1910. (defun anything-etags-help ()
  1911. "The help function for etags."
  1912. (interactive)
  1913. (let ((anything-help-message anything-etags-help-message))
  1914. (anything-help)))
  1915. ;;; Ucs help
  1916. ;;
  1917. ;;
  1918. (defvar anything-c-ucs-help-message
  1919. "== Anything Ucs ==
  1920. \nSpecific commands for `anything-ucs':
  1921. \\<anything-c-ucs-map>
  1922. \\[anything-c-ucs-persistent-insert]\t->Insert char.
  1923. \\[anything-c-ucs-persistent-forward]\t->Forward char.
  1924. \\[anything-c-ucs-persistent-backward]\t->Backward char.
  1925. \\[anything-c-ucs-persistent-delete]\t->Delete char backward.
  1926. \\[anything-c-ucs-help]\t\t->Show this help.
  1927. \n== Anything Map ==
  1928. \\{anything-map}")
  1929. (defun anything-c-ucs-help ()
  1930. "Help command for `anything-ucs'."
  1931. (interactive)
  1932. (let ((anything-help-message anything-c-ucs-help-message))
  1933. (anything-help)))
  1934. ;;; Bookmark help
  1935. ;;
  1936. ;;
  1937. (defvar anything-bookmark-help-message
  1938. "== Anything bookmark name Map ==\
  1939. \nSpecific commands for bookmarks:
  1940. \\<anything-c-bookmark-map>
  1941. \\[anything-c-bookmark-run-jump-other-window]\t\t->Jump other window.
  1942. \\[anything-c-bookmark-run-delete]\t\t->Delete bookmark.
  1943. \\[anything-c-bmkext-run-edit]\t\t->Edit bookmark (only for bmkext).
  1944. \\[anything-c-bookmark-help]\t\t->Run this help.
  1945. \n== Anything Map ==
  1946. \\{anything-map}")
  1947. (defun anything-c-bookmark-help ()
  1948. "Help command for bookmarks."
  1949. (interactive)
  1950. (let ((anything-help-message anything-bookmark-help-message))
  1951. (anything-help)))
  1952. ;;; Eshell command on file help
  1953. ;;
  1954. ;;
  1955. (defvar anything-c-esh-help-message
  1956. "== Anything eshell on file ==
  1957. \nTips:
  1958. - Passing extra args after filename:
  1959. Normally your command or alias will be called with file as argument.
  1960. e.g <command> 'candidate_file'
  1961. But you can also pass an argument or more after 'candidate_file' like this:
  1962. <command> %s [extra_args]\n
  1963. 'candidate_file' will be inserted at '%s' and your command will look at this:
  1964. <command> 'candidate_file' [args]
  1965. - Specify many files as args (marked files):
  1966. e.g <command> file1 file2 ...
  1967. Please restart and use a prefix arg to call `anything-find-files-eshell-command-on-file'.
  1968. Otherwise your command will be called many times like this:
  1969. <command> file1 <command> file2 etc...
  1970. \nSpecific commands for `anything-find-files-eshell-command-on-file':
  1971. \\<anything-esh-on-file-map>
  1972. \\[anything-esh-help]\t\t->Display this help.
  1973. \n== Anything Map ==
  1974. \\{anything-map}")
  1975. (defun anything-esh-help ()
  1976. "Help command for `anything-find-files-eshell-command-on-file'."
  1977. (interactive)
  1978. (let ((anything-help-message anything-c-esh-help-message))
  1979. (anything-help)))
  1980. ;;; Mode line strings
  1981. ;;
  1982. ;;
  1983. (defvar anything-buffer-mode-line-string
  1984. '("Buffer(s)"
  1985. "\\<anything-c-buffer-map>\
  1986. \\[anything-c-buffer-help]:Help, \
  1987. \\<anything-map>\
  1988. \\[anything-select-action]:Acts,\
  1989. \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
  1990. \\[anything-select-3rd-action]:NthAct,\
  1991. \\[anything-send-bug-report-from-anything]:BugReport."
  1992. "String displayed in mode-line in `anything-c-source-buffers-list'"))
  1993. (defvar anything-ff-mode-line-string
  1994. "\\<anything-find-files-map>\
  1995. \\[anything-ff-help]:Help, \
  1996. \\[anything-send-bug-report-from-anything]:BugReport, \
  1997. \\<anything-map>\
  1998. \\[anything-select-action]:Acts, \
  1999. \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
  2000. \\[anything-select-3rd-action]:NthAct"
  2001. "String displayed in mode-line in `anything-c-source-find-files'")
  2002. (defvar anything-read-file-name-mode-line-string
  2003. "\\<anything-c-read-file-map>\
  2004. \\[anything-read-file-name-help]:Help, \
  2005. \\<anything-map>\
  2006. \\[anything-select-action]:Acts,\
  2007. \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
  2008. \\[anything-select-3rd-action]:NthAct"
  2009. "String displayed in mode-line in `anything-c-source-find-files'")
  2010. (defvar anything-generic-file-mode-line-string
  2011. "\\<anything-generic-files-map>\
  2012. \\[anything-generic-file-help]:Help, \
  2013. \\<anything-map>\
  2014. \\[anything-select-action]:Acts,\
  2015. \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
  2016. \\[anything-select-3rd-action]:NthAct,\
  2017. \\[anything-send-bug-report-from-anything]:BugReport."
  2018. "String displayed in mode-line in Locate.")
  2019. (defvar anything-grep-mode-line-string
  2020. "\\<anything-c-grep-map>\
  2021. \\[anything-grep-help]:Help,\
  2022. \\<anything-map>\
  2023. \\[anything-select-action]:Acts,\
  2024. \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
  2025. \\[anything-select-3rd-action]:NthAct,\
  2026. \\[anything-send-bug-report-from-anything]:BugReport."
  2027. "String displayed in mode-line in `anything-do-grep'.")
  2028. (defvar anything-pdfgrep-mode-line-string
  2029. "\\<anything-c-pdfgrep-map>\
  2030. \\[anything-pdfgrep-help]:Help,\
  2031. \\<anything-map>\
  2032. \\[anything-select-action]:Acts,\
  2033. \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
  2034. \\[anything-select-3rd-action]:NthAct,\
  2035. \\[anything-send-bug-report-from-anything]:BugReport."
  2036. "String displayed in mode-line in `anything-do-pdfgrep'.")
  2037. (defvar anything-etags-mode-line-string
  2038. "\\<anything-c-etags-map>\
  2039. \\[anything-etags-help]:Help,\
  2040. \\<anything-map>\
  2041. \\[anything-select-action]:Acts,\
  2042. \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
  2043. \\[anything-select-3rd-action]:NthAct,\
  2044. \\[anything-send-bug-report-from-anything]:BugReport."
  2045. "String displayed in mode-line in `anything-c-etags-select'.")
  2046. (defvar anything-c-ucs-mode-line-string
  2047. "\\<anything-c-ucs-map>\
  2048. \\[anything-c-ucs-help]:Help, \
  2049. \\<anything-map>\
  2050. \\[anything-select-action]:Acts,\
  2051. \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
  2052. \\[anything-select-3rd-action]:NthAct."
  2053. "String displayed in mode-line in `anything-ucs'.")
  2054. (defvar anything-bookmark-mode-line-string
  2055. '("Bookmark(s)"
  2056. "\\<anything-c-bookmark-map>\
  2057. \\[anything-c-bookmark-help]:Help, \
  2058. \\<anything-map>\
  2059. \\[anything-select-action]:Acts,\
  2060. \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
  2061. \\[anything-select-3rd-action]:NthAct,\
  2062. \\[anything-send-bug-report-from-anything]:BugReport."
  2063. "String displayed in mode-line in `anything-c-source-buffers-list'"))
  2064. (defvar anything-occur-mode-line
  2065. "\\<anything-map>\
  2066. \\[anything-help]:Help,\
  2067. \\<anything-occur-map>\
  2068. \\[anything-occur-run-query-replace-regexp]:Query replace regexp,\
  2069. \\<anything-map>\
  2070. \\[anything-select-action]:Acts,\
  2071. \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
  2072. \\[anything-select-3rd-action]:NthAct,\
  2073. \\[anything-send-bug-report-from-anything]:BugReport.")
  2074. ;;; Utilities Functions
  2075. ;;
  2076. ;;
  2077. (defun anything-ff-find-printers ()
  2078. "Return a list of available printers on Unix systems."
  2079. (when (executable-find "lpstat")
  2080. (let ((printer-list (with-temp-buffer
  2081. (call-process "lpstat" nil t nil "-a")
  2082. (split-string (buffer-string) "\n"))))
  2083. (loop for p in printer-list
  2084. for printer = (car (split-string p))
  2085. when printer
  2086. collect printer))))
  2087. ;; Shut up byte compiler in emacs24*.
  2088. (defun anything-c-switch-to-buffer (buffer-or-name)
  2089. "Same as `switch-to-buffer' whithout warnings at compile time."
  2090. (with-no-warnings
  2091. (switch-to-buffer buffer-or-name)))
  2092. (defun* anything-c-position (item seq &key (test 'eq) all)
  2093. "A simple and faster replacement of CL `position'.
  2094. Return position of first occurence of ITEM found in SEQ.
  2095. Argument SEQ can be a string, in this case ITEM have to be a char.
  2096. Argument ALL, if non--nil specify to return a list of positions of
  2097. all ITEM found in SEQ."
  2098. (let ((key (if (stringp seq) 'across 'in)))
  2099. (eval
  2100. `(loop for c ,key seq
  2101. for index from 0
  2102. when (funcall test c item)
  2103. if all collect index into ls
  2104. else return index
  2105. finally return ls))))
  2106. (defun anything-c-get-pid-from-process-name (process-name)
  2107. "Get pid from running process PROCESS-NAME."
  2108. (loop with process-list = (list-system-processes)
  2109. for pid in process-list
  2110. for process = (assoc-default 'comm (process-attributes pid))
  2111. when (and process (string-match process-name process))
  2112. return pid))
  2113. (defun* anything-current-buffer-narrowed-p (&optional
  2114. (buffer anything-current-buffer))
  2115. "Check if BUFFER is narrowed.
  2116. Default is `anything-current-buffer'."
  2117. (with-current-buffer buffer
  2118. (let ((beg (point-min))
  2119. (end (point-max))
  2120. (total (buffer-size)))
  2121. (or (/= beg 1) (/= end (1+ total))))))
  2122. (defun anything-region-active-p ()
  2123. (and transient-mark-mode mark-active (/= (mark) (point))))
  2124. (defun anything-goto-char (loc)
  2125. "Go to char, revealing if necessary."
  2126. (goto-char loc)
  2127. (when (or (eq major-mode 'org-mode)
  2128. (and (boundp 'outline-minor-mode)
  2129. outline-minor-mode))
  2130. (require 'org) ; On some old Emacs versions org may not be loaded.
  2131. (org-reveal)))
  2132. (defun anything-goto-line (lineno &optional noanim)
  2133. "Goto LINENO opening only outline headline if needed.
  2134. Animation is used unless NOANIM is non--nil."
  2135. (goto-char (point-min))
  2136. (anything-goto-char (point-at-bol lineno))
  2137. (unless noanim
  2138. (anything-match-line-color-current-line)
  2139. (sit-for 0.3)
  2140. (anything-match-line-cleanup)))
  2141. (defun anything-show-this-source-only ()
  2142. "Show all candidates of this source."
  2143. (interactive)
  2144. (let (anything-candidate-number-limit)
  2145. (anything-set-source-filter
  2146. (list (assoc-default 'name (anything-get-current-source))))))
  2147. ;;;###autoload
  2148. (defun anything-test-sources ()
  2149. "List all anything sources for test.
  2150. The output is sexps which are evaluated by \\[eval-last-sexp]."
  2151. (interactive)
  2152. (with-output-to-temp-buffer "*Anything Test Sources*"
  2153. (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s)))
  2154. (apropos-internal "^anything-c-source" #'boundp))
  2155. (pop-to-buffer standard-output)))
  2156. (defun anything-displaying-source-names ()
  2157. "Display sources name."
  2158. (with-current-buffer anything-buffer
  2159. (goto-char (point-min))
  2160. (loop with pos
  2161. while (setq pos (next-single-property-change (point) 'anything-header))
  2162. do (goto-char pos)
  2163. collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
  2164. do (forward-line 1))))
  2165. ;; [Obsolete]
  2166. (defun anything-select-source ()
  2167. "[OBSOLETE] Select source."
  2168. (interactive)
  2169. (let ((default (assoc-default 'name (anything-get-current-source)))
  2170. (source-names (anything-displaying-source-names))
  2171. (all-source-names (mapcar (lambda (s) (assoc-default 'name s))
  2172. (anything-get-sources))))
  2173. (setq anything-candidate-number-limit 9999)
  2174. (anything-aif
  2175. (let (anything-source-filter)
  2176. (anything-nest '(((name . "Anything Source")
  2177. (candidates . source-names)
  2178. (action . identity))
  2179. ((name . "Anything Source (ALL)")
  2180. (candidates . all-source-names)
  2181. (action . identity)))
  2182. nil "Source: " nil
  2183. default "*anything select source*"))
  2184. (anything-set-source-filter (list it))
  2185. (anything-set-source-filter nil))))
  2186. (defun anything-insert-string (str)
  2187. "Insert STR."
  2188. (anything-set-pattern str 'noupdate))
  2189. ;;;###autoload
  2190. (defun anything-insert-buffer-name ()
  2191. "Insert buffer name."
  2192. (interactive)
  2193. (anything-set-pattern
  2194. (with-anything-current-buffer
  2195. (if buffer-file-name (file-name-nondirectory buffer-file-name)
  2196. (buffer-name)))))
  2197. (defalias 'anything-insert-symbol 'next-history-element)
  2198. (defalias 'anything-insert-selection 'anything-yank-selection)
  2199. (defun anything-c-match-on-file-name (candidate)
  2200. "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
  2201. (string-match anything-pattern (file-name-nondirectory candidate)))
  2202. (defun anything-c-match-on-directory-name (candidate)
  2203. "Return non-nil if `anything-pattern' match directory part of CANDIDATE."
  2204. (anything-aif (file-name-directory candidate)
  2205. (string-match anything-pattern it)))
  2206. (defun anything-c-match-on-basename (candidate)
  2207. "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
  2208. (string-match anything-pattern (anything-c-basename candidate)))
  2209. (defun anything-c-string-match (candidate)
  2210. "Return non-nil if `anything-pattern' match CANDIDATE.
  2211. The match is done with `string-match'."
  2212. (string-match anything-pattern candidate))
  2213. (defun anything-c-skip-entries (list regexp)
  2214. "Remove entries which matches REGEXP from LIST."
  2215. (remove-if (lambda (x) (and (stringp x) (string-match regexp x)))
  2216. list))
  2217. (defun anything-c-shadow-entries (list regexp)
  2218. "Display elements of LIST matching REGEXP with the `file-name-shadow' face."
  2219. (mapcar (lambda (file)
  2220. ;; Add shadow face property to boring files.
  2221. (let ((face (if (facep 'file-name-shadow)
  2222. 'file-name-shadow
  2223. ;; fall back to default on XEmacs
  2224. 'default)))
  2225. (if (string-match regexp file)
  2226. (setq file (propertize file 'face face))))
  2227. file)
  2228. list))
  2229. (defsubst anything-c-stringify (str-or-sym)
  2230. "Get string of STR-OR-SYM."
  2231. (if (stringp str-or-sym)
  2232. str-or-sym
  2233. (symbol-name str-or-sym)))
  2234. (defsubst anything-c-symbolify (str-or-sym)
  2235. "Get symbol of STR-OR-SYM."
  2236. (if (symbolp str-or-sym)
  2237. str-or-sym
  2238. (intern str-or-sym)))
  2239. (defun anything-c-describe-function (func)
  2240. "FUNC is symbol or string."
  2241. (describe-function (anything-c-symbolify func)))
  2242. (defun anything-c-describe-variable (var)
  2243. "VAR is symbol or string."
  2244. (describe-variable (anything-c-symbolify var)))
  2245. (defun anything-c-find-function (func)
  2246. "FUNC is symbol or string."
  2247. (find-function (anything-c-symbolify func)))
  2248. (defun anything-c-find-variable (var)
  2249. "VAR is symbol or string."
  2250. (find-variable (anything-c-symbolify var)))
  2251. (defun anything-c-kill-new (candidate &optional replace)
  2252. "CANDIDATE is symbol or string.
  2253. See `kill-new' for argument REPLACE."
  2254. (kill-new (anything-c-stringify candidate) replace))
  2255. (defun* anything-fast-remove-dups (seq &key (test 'eq))
  2256. "Remove duplicates elements in list SEQ.
  2257. This is same as `remove-duplicates' but with memoisation.
  2258. It is much faster, especially in large lists.
  2259. A test function can be provided with TEST argument key.
  2260. Default is `eq'."
  2261. (loop with cont = (make-hash-table :test test)
  2262. for elm in seq
  2263. unless (gethash elm cont)
  2264. do (puthash elm elm cont)
  2265. finally return
  2266. (loop for i being the hash-values in cont collect i)))
  2267. (defadvice eval-defun (after anything-source-hack activate)
  2268. "Allow immediate execution of anything source when evaling it.
  2269. See `anything-c-enable-eval-defun-hack'."
  2270. (when anything-c-enable-eval-defun-hack
  2271. (let ((varsym (save-excursion
  2272. (beginning-of-defun)
  2273. (forward-char 1)
  2274. (when (memq (read (current-buffer)) '(defvar setq))
  2275. (read (current-buffer))))))
  2276. (when (string-match "^anything-c-source-" (symbol-name varsym))
  2277. (anything varsym)))))
  2278. ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun))
  2279. ;; Move this function from anything.el and redefine here
  2280. ;; to avoid an unneeded defadvice.
  2281. (defun anything-quit-and-find-file ()
  2282. "Drop into `anything-find-files' from `anything'.
  2283. If current selection is a buffer or a file, `anything-find-files'
  2284. from its directory."
  2285. (interactive)
  2286. (anything-run-after-quit
  2287. (lambda (f)
  2288. (if (file-exists-p f)
  2289. (anything-find-files-1 (file-name-directory f)
  2290. (if anything-ff-transformer-show-only-basename
  2291. (anything-c-basename f) f))
  2292. (anything-find-files-1 f)))
  2293. (anything-aif (get-buffer (anything-get-selection))
  2294. (or (buffer-file-name it)
  2295. (car (rassoc it dired-buffers))
  2296. (and (with-current-buffer it
  2297. (eq major-mode 'org-agenda-mode))
  2298. org-directory
  2299. (expand-file-name org-directory))
  2300. default-directory)
  2301. (let ((sel (anything-get-selection)))
  2302. (cond ((or (file-remote-p sel)
  2303. (file-exists-p sel))
  2304. (expand-file-name sel))
  2305. ((string-match ffap-url-regexp sel)
  2306. sel)
  2307. (t default-directory))))))
  2308. (defmacro* anything-c-walk-directory (directory &key path (directories t) match)
  2309. "Walk through DIRECTORY tree.
  2310. PATH can be one of basename, relative, or full.
  2311. DIRECTORIES when non--nil (default) return also directories names, otherwise
  2312. skip directories names.
  2313. MATCH match only filenames matching regexp MATCH."
  2314. `(let (result
  2315. (fn (case ,path
  2316. (basename 'file-name-nondirectory)
  2317. (relative 'file-relative-name)
  2318. (full 'identity)
  2319. (t 'file-name-nondirectory))))
  2320. (labels ((ls-R (dir)
  2321. (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
  2322. for f in ls
  2323. if (file-directory-p f)
  2324. do (progn (when ,directories
  2325. (push (funcall fn f) result))
  2326. ;; Don't recurse in directory symlink.
  2327. (unless (file-symlink-p f)
  2328. (ls-R f)))
  2329. else do
  2330. (unless (and ,match (not (string-match ,match (file-name-nondirectory f))))
  2331. (push (funcall fn f) result)))))
  2332. (ls-R ,directory)
  2333. (nreverse result))))
  2334. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2335. ;;; Anything regexp.
  2336. ;;
  2337. ;;
  2338. (defvar anything-build-regexp-history nil)
  2339. (defun anything-c-query-replace-regexp (candidate)
  2340. "Query replace regexp from `anything-regexp'.
  2341. With a prefix arg replace only matches surrounded by word boundaries,
  2342. i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
  2343. (let ((regexp (funcall (anything-attr 'regexp))))
  2344. (apply 'query-replace-regexp
  2345. (anything-c-query-replace-args regexp))))
  2346. (defun anything-c-kill-regexp-as-sexp (candidate)
  2347. "Kill regexp in a format usable in lisp code."
  2348. (anything-c-regexp-kill-new
  2349. (prin1-to-string (funcall (anything-attr 'regexp)))))
  2350. (defun anything-c-kill-regexp (candidate)
  2351. "Kill regexp as it is in `anything-pattern'."
  2352. (anything-c-regexp-kill-new (funcall (anything-attr 'regexp))))
  2353. (defun anything-c-query-replace-args (regexp)
  2354. "create arguments of `query-replace-regexp' action in `anything-regexp'."
  2355. (let ((region-only (anything-region-active-p)))
  2356. (list
  2357. regexp
  2358. (query-replace-read-to regexp
  2359. (format "Query replace %sregexp %s"
  2360. (if anything-current-prefix-arg "word " "")
  2361. (if region-only "in region " ""))
  2362. t)
  2363. anything-current-prefix-arg
  2364. (when region-only (region-beginning))
  2365. (when region-only (region-end)))))
  2366. (defvar anything-c-source-regexp
  2367. '((name . "Regexp Builder")
  2368. (init . (lambda ()
  2369. (anything-candidate-buffer anything-current-buffer)))
  2370. (candidates-in-buffer)
  2371. (get-line . anything-c-regexp-get-line)
  2372. (persistent-action . anything-c-regexp-persistent-action)
  2373. (persistent-help . "Show this line")
  2374. (multiline)
  2375. (delayed)
  2376. (requires-pattern . 2)
  2377. (mode-line . "Press TAB to select action.")
  2378. (regexp . (lambda () anything-input))
  2379. (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp)
  2380. ("Query Replace Regexp (C-u Not inside word.)"
  2381. . anything-c-query-replace-regexp)
  2382. ("Kill Regexp" . anything-c-kill-regexp)))))
  2383. (defun anything-c-regexp-get-line (s e)
  2384. (propertize
  2385. (apply 'concat
  2386. ;; Line contents
  2387. (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e))
  2388. ;; subexps
  2389. (loop for i from 0 to (1- (/ (length (match-data)) 2))
  2390. collect (format "\n %s'%s'"
  2391. (if (zerop i) "Group 0: " (format "Group %d: " i))
  2392. (match-string i))))
  2393. ;; match beginning
  2394. ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer.
  2395. ;; It is implementation problem of candidates-in-buffer.
  2396. 'anything-realvalue
  2397. (1- s)))
  2398. (defun anything-c-regexp-persistent-action (pt)
  2399. (anything-goto-char pt)
  2400. (anything-persistent-highlight-point))
  2401. (defun anything-c-regexp-kill-new (input)
  2402. (kill-new input)
  2403. (message "Killed: %s" input))
  2404. (defun anything-quote-whitespace (candidate)
  2405. "Quote whitespace, if some, in string CANDIDATE."
  2406. (replace-regexp-in-string " " "\\\\ " candidate))
  2407. ;;; Toggle all marks.
  2408. ;;
  2409. ;;
  2410. ;;;###autoload
  2411. (defun anything-mark-all ()
  2412. "Mark all visible unmarked candidates in current source."
  2413. (interactive)
  2414. (with-anything-window
  2415. (save-excursion
  2416. (goto-char (anything-get-previous-header-pos))
  2417. (anything-next-line)
  2418. (let* ((next-head (anything-get-next-header-pos))
  2419. (end (and next-head
  2420. (save-excursion
  2421. (goto-char next-head)
  2422. (forward-line -1)
  2423. (point))))
  2424. (maxpoint (or end (point-max))))
  2425. (while (< (point) maxpoint)
  2426. (anything-mark-current-line)
  2427. (let* ((prefix (get-text-property (point-at-bol) 'display))
  2428. (cand (anything-get-selection))
  2429. (bn (and (anything-file-completion-source-p)
  2430. (anything-c-basename cand)))
  2431. (src (assoc-default 'name (anything-get-current-source))))
  2432. (when (and (not (anything-this-visible-mark))
  2433. (not (or (string= prefix "[?]")
  2434. (string= prefix "[@]"))))
  2435. ;; Don't mark possibles directories ending with . or ..
  2436. ;; autosave files/links and non--existent file.
  2437. (unless
  2438. (and (or (anything-file-completion-source-p)
  2439. (equal src "Files from Current Directory"))
  2440. (or (string-match "^\\.#.*\\|^#.*#$\\|\\.$" bn)
  2441. ;; We need to test here when not using a transformer
  2442. ;; that tag prefix (i.e on tramp)
  2443. (not (file-exists-p cand))))
  2444. (anything-make-visible-mark))))
  2445. (forward-line 1) (end-of-line))))
  2446. (anything-mark-current-line)
  2447. (message "%s candidates marked" (length anything-marked-candidates))))
  2448. ;;;###autoload
  2449. (defun anything-unmark-all ()
  2450. "Unmark all candidates in all sources of current anything session."
  2451. (interactive)
  2452. (with-anything-window
  2453. (let ((len (length anything-marked-candidates)))
  2454. (save-excursion
  2455. (anything-clear-visible-mark))
  2456. (setq anything-marked-candidates nil)
  2457. (anything-mark-current-line)
  2458. (message "%s candidates unmarked" len))))
  2459. ;;;###autoload
  2460. (defun anything-toggle-all-marks ()
  2461. "Toggle all marks.
  2462. Mark all visible candidates of current source or unmark all candidates
  2463. visible or invisible in all sources of current anything session"
  2464. (interactive)
  2465. (let ((marked (anything-marked-candidates)))
  2466. (if (and (>= (length marked) 1)
  2467. (with-anything-window anything-visible-mark-overlays))
  2468. (anything-unmark-all)
  2469. (anything-mark-all))))
  2470. ;;; Buffers
  2471. ;;
  2472. ;;
  2473. (defun anything-c-buffer-list ()
  2474. "Return a list of buffer names.
  2475. The first buffer in the list will be the last recently used
  2476. buffer that is not the current buffer unless
  2477. `anything-allow-skipping-current-buffer' is nil."
  2478. (let ((buffers (mapcar 'buffer-name (buffer-list))))
  2479. (if anything-allow-skipping-current-buffer
  2480. (progn
  2481. (setq buffers (remove (buffer-name anything-current-buffer) buffers))
  2482. (append (cdr buffers) (list (car buffers))))
  2483. buffers)))
  2484. (defvar anything-c-source-buffers
  2485. '((name . "Buffers")
  2486. (candidates . anything-c-buffer-list)
  2487. (type . buffer)))
  2488. (defvar anything-c-source-buffer-not-found
  2489. `((name . "Create buffer")
  2490. (dummy)
  2491. (filtered-candidate-transformer (lambda (cands source)
  2492. (list anything-pattern)))
  2493. (keymap . ,anything-map)
  2494. (action . (lambda (candidate)
  2495. (anything-c-switch-to-buffer (get-buffer-create candidate))))))
  2496. ;;; Buffers-list (was buffers+)
  2497. ;;
  2498. ;;
  2499. (defun anything-c-highlight-buffers (buffers)
  2500. "Transformer function to highlight BUFFERS list.
  2501. Should be called after others transformers i.e (boring buffers)."
  2502. (loop with buflist = (if anything-allow-skipping-current-buffer
  2503. buffers
  2504. (cons (pop (cdr buffers)) buffers))
  2505. for i in buflist
  2506. for buf = (get-buffer i)
  2507. for bfname = (buffer-file-name buf)
  2508. collect
  2509. (cond (;; A dired buffer.
  2510. (rassoc buf dired-buffers)
  2511. (propertize i 'face 'anything-ff-directory
  2512. 'help-echo (car (rassoc buf dired-buffers))))
  2513. ;; A buffer file modified somewhere outside of emacs.
  2514. ((and bfname (not (file-remote-p bfname))
  2515. (file-exists-p bfname)
  2516. (not (verify-visited-file-modtime buf)))
  2517. (propertize i 'face 'anything-buffer-saved-out
  2518. 'help-echo bfname))
  2519. ;; A new buffer file not already saved on disk.
  2520. ((and bfname (not (file-remote-p bfname))
  2521. (not (verify-visited-file-modtime buf)))
  2522. (propertize i 'face 'anything-buffer-not-saved
  2523. 'help-echo bfname))
  2524. ;; A Remote buffer file modified and not saved on disk.
  2525. ((and bfname (file-remote-p bfname) (buffer-modified-p buf))
  2526. (let ((prefix (propertize
  2527. " " 'display
  2528. (propertize "@ " 'face 'anything-ff-prefix))))
  2529. (cons (concat prefix (propertize i 'face 'anything-ff-symlink
  2530. 'help-echo bfname)) i)))
  2531. ;; A buffer file modified and not saved on disk.
  2532. ((and bfname (buffer-modified-p buf))
  2533. (propertize i 'face 'anything-ff-symlink
  2534. 'help-echo bfname))
  2535. ;; A remote buffer file not modified and saved on disk.
  2536. ((and bfname (file-remote-p bfname))
  2537. (let ((prefix (propertize
  2538. " " 'display
  2539. (propertize "@ " 'face 'anything-ff-prefix))))
  2540. (cons (concat prefix (propertize i 'face 'font-lock-type-face
  2541. 'help-echo bfname)) i)))
  2542. ;; A buffer file not modified and saved on disk.
  2543. (bfname
  2544. (propertize i 'face 'font-lock-type-face
  2545. 'help-echo bfname))
  2546. ;; Any non--file buffer.
  2547. (t (propertize i 'face 'italic)))))
  2548. (defvar anything-c-source-buffers-list
  2549. `((name . "Buffers")
  2550. (candidates . anything-c-buffer-list)
  2551. (type . buffer)
  2552. (match anything-c-buffer-match-major-mode)
  2553. (candidate-transformer anything-c-skip-boring-buffers
  2554. anything-c-highlight-buffers)
  2555. (persistent-action . anything-c-buffers-list-persistent-action)
  2556. (keymap . ,anything-c-buffer-map)
  2557. (volatile)
  2558. (mode-line . anything-buffer-mode-line-string)
  2559. (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
  2560. (defvaralias 'anything-c-source-buffers+ 'anything-c-source-buffers-list)
  2561. (defun anything-c-buffer-match-major-mode (candidate)
  2562. "Match maybe buffer by major-mode.
  2563. If you give a major-mode or partial major-mode,
  2564. it will list all buffers of this major-mode and/or buffers with name
  2565. matching this major-mode.
  2566. If you add a space after major-mode and then a space,
  2567. it will match all buffers of the major-mode
  2568. before space matching pattern after space.
  2569. If you give a pattern which doesn't match a major-mode, it will search buffer
  2570. with name matching pattern."
  2571. (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
  2572. (buf (get-buffer cand)))
  2573. (when buf
  2574. (with-current-buffer buf
  2575. (let ((mjm (symbol-name major-mode))
  2576. (split (split-string anything-pattern)))
  2577. (cond ((string-match "\\s-$" anything-pattern)
  2578. (string-match (car split) mjm))
  2579. ((string-match "\\s-" anything-pattern)
  2580. (and (string-match (car split) mjm)
  2581. (string-match (cadr split) cand)))
  2582. (t (or (string-match anything-pattern mjm)
  2583. (string-match anything-pattern cand)))))))))
  2584. (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
  2585. "Query replace in marked buffers.
  2586. If REGEXP-FLAG is given use `query-replace-regexp'."
  2587. (let ((fn (if regexp-flag 'query-replace-regexp 'query-replace))
  2588. (prompt (if regexp-flag "Query replace regexp" "Query replace"))
  2589. (bufs (anything-marked-candidates)))
  2590. (loop
  2591. with replace = (query-replace-read-from prompt regexp-flag)
  2592. with tostring = (unless (consp replace)
  2593. (query-replace-read-to
  2594. replace prompt regexp-flag))
  2595. for buf in bufs
  2596. do
  2597. (save-window-excursion
  2598. (anything-c-switch-to-buffer buf)
  2599. (save-excursion
  2600. (let ((case-fold-search t))
  2601. (goto-char (point-min))
  2602. (if (consp replace)
  2603. (apply fn (list (car replace) (cdr replace)))
  2604. (apply fn (list replace tostring)))))))))
  2605. (defun anything-c-buffer-query-replace-regexp (candidate)
  2606. (anything-c-buffer-query-replace-1 'regexp))
  2607. (defun anything-c-buffer-query-replace (candidate)
  2608. (anything-c-buffer-query-replace-1))
  2609. (defun anything-buffer-toggle-diff (candidate)
  2610. "Toggle diff buffer CANDIDATE with it's file."
  2611. (if (get-buffer-window "*Diff*")
  2612. (kill-buffer "*Diff*")
  2613. (diff-buffer-with-file (get-buffer candidate))))
  2614. ;;;###autoload
  2615. (defun anything-buffer-diff-persistent ()
  2616. "Toggle diff buffer without quitting anything."
  2617. (interactive)
  2618. (anything-attrset 'diff-action 'anything-buffer-toggle-diff)
  2619. (anything-execute-persistent-action 'diff-action))
  2620. (defun anything-buffer-revert-and-update (candidate)
  2621. (let ((marked (anything-marked-candidates)))
  2622. (loop for buf in marked do (anything-revert-buffer buf))
  2623. (anything-force-update candidate)))
  2624. ;;;###autoload
  2625. (defun anything-buffer-revert-persistent ()
  2626. "Revert buffer without quitting anything."
  2627. (interactive)
  2628. (anything-attrset 'revert-action 'anything-buffer-revert-and-update)
  2629. (anything-execute-persistent-action 'revert-action 'onewindow))
  2630. (defun anything-buffer-save-and-update (candidate)
  2631. (let ((marked (anything-marked-candidates))
  2632. (enable-recursive-minibuffers t))
  2633. (loop for buf in marked do
  2634. (with-current-buffer (get-buffer buf)
  2635. (save-buffer)))
  2636. (anything-force-update candidate)))
  2637. ;;;###autoload
  2638. (defun anything-buffer-save-persistent ()
  2639. "Save buffer without quitting anything."
  2640. (interactive)
  2641. (anything-attrset 'save-action 'anything-buffer-save-and-update)
  2642. (anything-execute-persistent-action 'save-action 'onewindow))
  2643. ;;;###autoload
  2644. (defun anything-buffer-run-kill-buffers ()
  2645. "Run kill buffer action from `anything-c-source-buffers-list'."
  2646. (interactive)
  2647. (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
  2648. ;;;###autoload
  2649. (defun anything-buffer-run-grep ()
  2650. "Run Grep action from `anything-c-source-buffers-list'."
  2651. (interactive)
  2652. (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
  2653. ;;;###autoload
  2654. (defun anything-buffer-run-zgrep ()
  2655. "Run Grep action from `anything-c-source-buffers-list'."
  2656. (interactive)
  2657. (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
  2658. ;;;###autoload
  2659. (defun anything-buffer-run-query-replace-regexp ()
  2660. "Run Query replace regexp action from `anything-c-source-buffers-list'."
  2661. (interactive)
  2662. (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
  2663. ;;;###autoload
  2664. (defun anything-buffer-run-query-replace ()
  2665. "Run Query replace action from `anything-c-source-buffers-list'."
  2666. (interactive)
  2667. (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
  2668. ;;;###autoload
  2669. (defun anything-buffer-switch-other-window ()
  2670. "Run switch to other window action from `anything-c-source-buffers-list'."
  2671. (interactive)
  2672. (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
  2673. ;;;###autoload
  2674. (defun anything-buffer-switch-other-frame ()
  2675. "Run switch to other frame action from `anything-c-source-buffers-list'."
  2676. (interactive)
  2677. (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
  2678. ;;;###autoload
  2679. (defun anything-buffer-switch-to-elscreen ()
  2680. "Run switch to elscreen action from `anything-c-source-buffers-list'."
  2681. (interactive)
  2682. (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
  2683. ;;;###autoload
  2684. (defun anything-buffer-run-ediff ()
  2685. "Run ediff action from `anything-c-source-buffers-list'."
  2686. (interactive)
  2687. (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers))
  2688. (defun anything-buffer-run-ediff-merge ()
  2689. "Run ediff action from `anything-c-source-buffers-list'."
  2690. (interactive)
  2691. (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers-merge))
  2692. (defun anything-c-buffers-persistent-kill (buffer)
  2693. "Persistent action to kill buffer."
  2694. (with-current-buffer (get-buffer buffer)
  2695. (if (and (buffer-modified-p)
  2696. (buffer-file-name (current-buffer)))
  2697. (progn
  2698. (save-buffer)
  2699. (kill-buffer buffer))
  2700. (kill-buffer buffer)))
  2701. (anything-delete-current-selection))
  2702. (defun anything-c-buffers-list-persistent-action (candidate)
  2703. (if current-prefix-arg
  2704. (anything-c-buffers-persistent-kill candidate)
  2705. (anything-c-switch-to-buffer candidate)))
  2706. ;;;; <File>
  2707. ;;
  2708. ;;
  2709. ;;; File name history
  2710. (defvar anything-c-source-file-name-history
  2711. '((name . "File Name History")
  2712. (candidates . file-name-history)
  2713. (match anything-c-match-on-basename)
  2714. (type . file)))
  2715. ;;; Files in current dir
  2716. ;;
  2717. ;;
  2718. (defvar anything-c-source-files-in-current-dir
  2719. '((name . "Files from Current Directory")
  2720. (candidates . (lambda ()
  2721. (with-anything-current-buffer
  2722. (directory-files (anything-c-current-directory)))))
  2723. ;; volatile is not needed, I think.
  2724. (type . file)))
  2725. (defun anything-c-highlight-files (files)
  2726. (loop for i in files
  2727. if (file-directory-p i)
  2728. collect (propertize (file-name-nondirectory i)
  2729. 'face 'anything-ff-directory
  2730. 'help-echo (expand-file-name i))
  2731. else
  2732. collect (propertize (file-name-nondirectory i)
  2733. 'face 'anything-ff-file
  2734. 'help-echo (expand-file-name i))))
  2735. (defvar anything-c-source-files-in-current-dir+
  2736. `((name . "Files from Current Directory")
  2737. (candidates . (lambda ()
  2738. (with-anything-current-buffer
  2739. (directory-files (anything-c-current-directory) t))))
  2740. (keymap . ,anything-generic-files-map)
  2741. (help-message . anything-generic-file-help-message)
  2742. (mode-line . anything-generic-file-mode-line-string)
  2743. (candidate-transformer anything-c-highlight-files)
  2744. ;; volatile is not needed, I think.
  2745. (type . file)))
  2746. ;;; Anything-find-files - The anything files browser.
  2747. ;;
  2748. ;;
  2749. ;; Internal.
  2750. (defvar anything-c-find-files-doc-header " (`C-l': Go to precedent level)"
  2751. "*The doc that is inserted in the Name header of a find-files or dired source.")
  2752. (defvar anything-ff-auto-update-flag nil
  2753. "Internal, flag to turn on/off auto-update in `anything-find-files'.
  2754. Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
  2755. (defvar anything-ff-last-expanded nil
  2756. "Store last expanded directory or file.")
  2757. (defvar anything-ff-default-directory nil)
  2758. (defvar anything-ff-history nil)
  2759. (defvar anything-ff-cand-to-mark nil)
  2760. (defvar anything-ff-url-regexp
  2761. "\\`\\(news\\(post\\)?:\\|nntp:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\):/?/?\\).*"
  2762. "Same as `ffap-url-regexp' but match earlier possible url.")
  2763. (defvar anything-c-source-find-files
  2764. `((name . "Find Files")
  2765. (header-name . (lambda (name)
  2766. (concat name anything-c-find-files-doc-header)))
  2767. ;; It is needed for filenames with capital letters
  2768. (disable-shortcuts)
  2769. (init . (lambda ()
  2770. (setq anything-ff-auto-update-flag
  2771. anything-ff-auto-update-initial-value)))
  2772. (candidates . anything-find-files-get-candidates)
  2773. (filtered-candidate-transformer anything-c-find-files-transformer)
  2774. (persistent-action . anything-find-files-persistent-action)
  2775. (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
  2776. (mode-line . anything-ff-mode-line-string)
  2777. (volatile)
  2778. (candidate-number-limit . 9999)
  2779. (action-transformer . anything-find-files-action-transformer)
  2780. (action
  2781. . ,(delq
  2782. nil
  2783. `(("Find File" . anything-c-find-file-or-marked)
  2784. ("Find file in Dired" . anything-c-point-file-in-dired)
  2785. ,(and (locate-library "elscreen")
  2786. '("Find file in Elscreen" . anything-elscreen-find-file))
  2787. ,(and (locate-library "popwin")
  2788. '("Find file in popup window" . popwin:find-file))
  2789. ("Checksum File" . anything-ff-checksum)
  2790. ("Complete at point `M-tab'"
  2791. . anything-c-insert-file-name-completion-at-point)
  2792. ("Open file externally `C-c C-x, C-u to choose'"
  2793. . anything-c-open-file-externally)
  2794. ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
  2795. ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
  2796. ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
  2797. ("Etags `M-., C-u tap, C-u C-u reload tag file'" . anything-ff-etags-select)
  2798. ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
  2799. . anything-find-files-eshell-command-on-file)
  2800. ("Find file as root" . anything-find-file-as-root)
  2801. ("Find file in hex dump" . hexl-find-file)
  2802. ("Ediff File `C-='" . anything-find-files-ediff-files)
  2803. ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
  2804. ("Delete File(s) `M-D'" . anything-delete-marked-files)
  2805. ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
  2806. ("Copy file(s) Async" . anything-ff-copy-async)
  2807. ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
  2808. ("Serial rename files" . anything-ff-serial-rename)
  2809. ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
  2810. ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
  2811. ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
  2812. ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
  2813. ("Hardlink file(s) `M-H, C-u to follow'" . anything-find-files-hardlink)
  2814. ("Find file other window `C-o'" . find-file-other-window)
  2815. ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
  2816. ("Find file other frame `C-c C-o'" . find-file-other-frame)
  2817. ("Print File `C-c p, C-u to refresh'" . anything-ff-print)
  2818. ("Locate `C-x C-f, C-u to specify locate db'" . anything-ff-locate))))))
  2819. (defun anything-find-files-set-prompt-for-action (action files)
  2820. "Set prompt for action ACTION for FILES."
  2821. (let ((len (length files)))
  2822. (format "%s *%s File(s)\n%s to: "
  2823. action len
  2824. (mapconcat (lambda (f)
  2825. (format "- %s\n" f)) files ""))))
  2826. (defun anything-dwim-target-directory ()
  2827. "Return value of `default-directory' of buffer in other window.
  2828. If there is only one window return the value ot `default-directory'
  2829. for current buffer."
  2830. (with-anything-current-buffer
  2831. (let ((num-windows (length (window-list))))
  2832. (if (> num-windows 1)
  2833. (save-selected-window
  2834. (other-window 1)
  2835. default-directory)
  2836. (car anything-ff-history)))))
  2837. (defun anything-find-files-do-action (action)
  2838. "Generic function for creating action from `anything-c-source-find-files'.
  2839. ACTION must be an action supported by `anything-dired-action'."
  2840. (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo'
  2841. (anything-marked-candidates)))
  2842. (cand (anything-get-selection)) ; Target
  2843. (prompt (anything-find-files-set-prompt-for-action
  2844. (capitalize (symbol-name action)) ifiles))
  2845. (parg anything-current-prefix-arg)
  2846. (dest (anything-c-read-file-name
  2847. prompt
  2848. :preselect (if anything-ff-transformer-show-only-basename
  2849. (anything-c-basename cand) cand)
  2850. :initial-input (anything-dwim-target-directory)
  2851. :history (anything-find-files-history :comp-read nil))))
  2852. (anything-dired-action
  2853. dest :files ifiles :action action :follow parg)))
  2854. (defun anything-find-files-copy (candidate)
  2855. "Copy files from `anything-find-files'."
  2856. (anything-find-files-do-action 'copy))
  2857. (defun anything-find-files-rename (candidate)
  2858. "Rename files from `anything-find-files'."
  2859. (anything-find-files-do-action 'rename))
  2860. (defun anything-find-files-symlink (candidate)
  2861. "Symlink files from `anything-find-files'."
  2862. (anything-find-files-do-action 'symlink))
  2863. (defun anything-find-files-relsymlink (candidate)
  2864. "Relsymlink files from `anything-find-files'."
  2865. (anything-find-files-do-action 'relsymlink))
  2866. (defun anything-find-files-hardlink (candidate)
  2867. "Hardlink files from `anything-find-files'."
  2868. (anything-find-files-do-action 'hardlink))
  2869. (defun anything-find-files-byte-compile (candidate)
  2870. "Byte compile elisp files from `anything-find-files'."
  2871. (let ((files (anything-marked-candidates))
  2872. (parg anything-current-prefix-arg))
  2873. (loop for fname in files
  2874. do (byte-compile-file fname parg))))
  2875. (defun anything-find-files-load-files (candidate)
  2876. "Load elisp files from `anything-find-files'."
  2877. (let ((files (anything-marked-candidates)))
  2878. (loop for fname in files
  2879. do (load fname))))
  2880. (defun anything-find-files-ediff-files-1 (candidate &optional merge)
  2881. "Generic function to ediff/merge files in `anything-find-files'."
  2882. (let ((bname (anything-c-basename candidate))
  2883. (prompt (if merge "Ediff Merge `%s' With File: "
  2884. "Ediff `%s' With File: "))
  2885. (fun (if merge 'ediff-merge-files 'ediff-files)))
  2886. (funcall fun
  2887. candidate
  2888. (condition-case quit
  2889. (anything-c-read-file-name
  2890. (format prompt bname))
  2891. (quit ;; Hit C-g ask user to fallback to locate.
  2892. (if (y-or-n-p "Search file for ediff with locate? ")
  2893. (anything-c-locate-read-file-name
  2894. (format prompt bname)
  2895. ;; Check if -b option is available.
  2896. (if (and (eq system-type 'windows-nt)
  2897. (string-match "^es" anything-c-locate-command))
  2898. bname
  2899. (concat bname " -b")))
  2900. (error "Error: Ediff Operation aborted")))))))
  2901. (defun anything-find-files-ediff-files (candidate)
  2902. (anything-find-files-ediff-files-1 candidate))
  2903. (defun anything-find-files-ediff-merge-files (candidate)
  2904. (anything-find-files-ediff-files-1 candidate 'merge))
  2905. (defun anything-find-files-grep (candidate)
  2906. "Default action to grep files from `anything-find-files'."
  2907. (anything-do-grep-1 (anything-marked-candidates)
  2908. anything-current-prefix-arg))
  2909. (defun anything-ff-zgrep (candidate)
  2910. "Default action to zgrep files from `anything-find-files'."
  2911. (let ((prefarg anything-current-prefix-arg)
  2912. (ls (anything-marked-candidates)))
  2913. (anything-ff-zgrep-1 ls prefarg)))
  2914. (defun anything-ff-pdfgrep (candidate)
  2915. "Default action to pdfgrep files from `anything-find-files'."
  2916. (let ((cands (loop for file in (anything-marked-candidates)
  2917. if (or (string= (file-name-extension file) "pdf")
  2918. (string= (file-name-extension file) "PDF"))
  2919. collect file))
  2920. (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
  2921. (when cands
  2922. (anything-do-pdfgrep-1 cands))))
  2923. (defun anything-ff-etags-select (candidate)
  2924. "Default action to jump to etags from `anything-find-files'."
  2925. (when (get-buffer anything-action-buffer)
  2926. (kill-buffer anything-action-buffer))
  2927. (let ((default-directory anything-ff-default-directory))
  2928. (anything-c-etags-select anything-current-prefix-arg)))
  2929. (defun anything-find-files-switch-to-hist (candidate)
  2930. "Switch to anything-find-files history."
  2931. (anything-find-files t))
  2932. ;;; Asynchronous copy of files.
  2933. ;;
  2934. ;;
  2935. (defun anything-c-copy-files-async-1 (flist dest)
  2936. "Copy a list of Files FLIST to DEST asynchronously.
  2937. It use another emacs process to do the job.
  2938. Communication with background emacs is done with temp file
  2939. `anything-c-copy-files-async-log-file'."
  2940. (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
  2941. "-Q" "--batch" "--eval"
  2942. (format "(progn
  2943. (require 'dired) (require 'cl)
  2944. (let ((dired-recursive-copies 'always)
  2945. failures success
  2946. (ovw-count 0)
  2947. (cpf-count 0))
  2948. (dolist (f '%S)
  2949. (condition-case err
  2950. (let ((file-exists (file-exists-p
  2951. (expand-file-name
  2952. (file-name-nondirectory (directory-file-name f))
  2953. (file-name-directory
  2954. (file-name-as-directory \"%s\"))))))
  2955. (dired-copy-file f \"%s\" t)
  2956. (if file-exists
  2957. (progn (push (cons \"Overwriting\" f) success)
  2958. (incf ovw-count))
  2959. (push (cons \"Copying\" f) success)
  2960. (incf cpf-count)))
  2961. (file-error
  2962. (push (dired-make-relative
  2963. (expand-file-name
  2964. (file-name-nondirectory (directory-file-name f))
  2965. (file-name-directory \"%s\")))
  2966. failures))))
  2967. (with-current-buffer (find-file-noselect \"%s\")
  2968. (erase-buffer)
  2969. (when failures
  2970. (dolist (fail (reverse failures))
  2971. (insert (concat \"Failed to copy \" fail \"\n\"))))
  2972. (when success
  2973. (loop for (a . s) in (reverse success) do
  2974. (insert (concat a \" \" s \" to %s done\n\"))))
  2975. (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
  2976. (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
  2977. (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
  2978. (save-buffer))))"
  2979. flist dest dest dest anything-c-copy-files-async-log-file dest)))
  2980. (defun anything-c-copy-async-with-log (flist dest)
  2981. "Copy file list FLIST to DEST showing log.
  2982. Log is send to `anything-c-copy-files-async-log-file'.
  2983. Copying is done asynchronously with `anything-c-copy-files-async-1'."
  2984. (declare (special auto-revert-interval))
  2985. (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
  2986. (set (make-local-variable 'auto-revert-interval) 1)
  2987. (erase-buffer)
  2988. (insert "Wait copying files...\n")
  2989. (sit-for 0.5) (save-buffer)
  2990. (goto-char (point-max))
  2991. (auto-revert-mode 1)
  2992. (anything-c-copy-files-async-1 flist dest))
  2993. (defun anything-ff-copy-async (candidate)
  2994. "Anything find files action to copy files async.
  2995. Copying is done asynchronously with `anything-c-copy-files-async-1'."
  2996. (let* ((flist (anything-marked-candidates))
  2997. (dest (anything-c-read-file-name
  2998. (anything-find-files-set-prompt-for-action
  2999. "Copy Async" flist)
  3000. :preselect candidate
  3001. :initial-input (car anything-ff-history)
  3002. :history (anything-find-files-history :comp-read nil))))
  3003. (anything-c-copy-async-with-log flist dest)))
  3004. (defvar eshell-command-aliases-list nil)
  3005. (defvar anything-eshell-command-on-file-input-history nil)
  3006. (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
  3007. "Run `eshell-command' on CANDIDATE or marked candidates.
  3008. This is done possibly with an eshell alias, if no alias found, you can type in
  3009. an eshell command.
  3010. Basename of CANDIDATE can be a wild-card.
  3011. e.g you can do \"eshell-command command *.el\"
  3012. Where \"*.el\" is the CANDIDATE.
  3013. It is possible to do eshell-command command <CANDIDATE> <some more args>
  3014. like this: \"command %s some more args\".
  3015. If MAP is given run `eshell-command' on all marked files at once,
  3016. Otherwise, run `eshell-command' on each marked files.
  3017. In other terms, with a prefix arg do on the three marked files
  3018. \"foo\" \"bar\" \"baz\":
  3019. \"eshell-command command foo bar baz\"
  3020. otherwise do
  3021. \"eshell-command command foo\"
  3022. \"eshell-command command bar\"
  3023. \"eshell-command command baz\"
  3024. Note:
  3025. If `eshell' or `eshell-command' have not been run once,
  3026. or if you have no eshell aliases `eshell-command-aliases-list'
  3027. will not be loaded first time you use this."
  3028. (when (or eshell-command-aliases-list
  3029. (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
  3030. (and eshell-command-aliases-list (eshell-read-aliases-list))
  3031. (let* ((cand-list (anything-marked-candidates))
  3032. (default-directory (or anything-ff-default-directory
  3033. ;; If candidate is an url *-ff-default-directory is nil
  3034. ;; so keep value of default-directory.
  3035. default-directory))
  3036. (command (anything-comp-read
  3037. "Command: "
  3038. (loop for (a . c) in eshell-command-aliases-list
  3039. when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
  3040. collect (propertize a 'help-echo (car c)) into ls
  3041. finally return (sort ls 'string<))
  3042. :buffer "*esh command on file*"
  3043. :name "Eshell command"
  3044. :keymap anything-esh-on-file-map
  3045. :mode-line
  3046. '("Eshell alias"
  3047. "C-c ?: Help, \\[universal-argument]: Insert output at point")
  3048. :input-history
  3049. 'anything-eshell-command-on-file-input-history))
  3050. (alias-value (car (assoc-default command eshell-command-aliases-list))))
  3051. (when (and (= (length cand-list) 1)
  3052. (string-match "[*]" (anything-c-basename (car cand-list))))
  3053. (setq cand-list (file-expand-wildcards (car cand-list) t)))
  3054. ;; Be sure output don't go in current buffer
  3055. ;; but allow sending output to current buffer
  3056. ;; if a prefix arg have been passed during the
  3057. ;; `anything-comp-read' call.
  3058. (setq current-prefix-arg anything-current-prefix-arg)
  3059. ;; MAP have been set before calling `anything-comp-read'
  3060. ;; by `anything-current-prefix-arg'.
  3061. (if (and (or map ; prefix-arg
  3062. (and alias-value
  3063. ;; If command is an alias be sure it accept
  3064. ;; more than one arg i.e $*.
  3065. (string-match "\\$\\*$" alias-value)))
  3066. (> (length cand-list) 1))
  3067. ;; Run eshell-command with ALL marked files as arguments.
  3068. (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
  3069. (if (string-match "'%s'\\|\"%s\"\\|%s" command)
  3070. (eshell-command (format command mapfiles)) ; See [1]
  3071. (eshell-command (format "%s %s" command mapfiles))))
  3072. ;; Run eshell-command on EACH marked files.
  3073. (loop for i in cand-list
  3074. for bn = (anything-c-basename i)
  3075. for files = (format "'%s'" i)
  3076. for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
  3077. ;; [1] This allow to enter other args AFTER filename
  3078. ;; i.e <command %s some_more_args>
  3079. (format command files)
  3080. (format "%s %s" command files))
  3081. do (eshell-command com))))))
  3082. (defun anything-find-files-eshell-command-on-file (candidate)
  3083. "Run `eshell-command' on CANDIDATE or marked candidates.
  3084. See `anything-find-files-eshell-command-on-file-1' for more info."
  3085. (anything-find-files-eshell-command-on-file-1
  3086. candidate anything-current-prefix-arg))
  3087. (defun anything-ff-switch-to-eshell (candidate)
  3088. "Switch to eshell and cd to `anything-ff-default-directory'."
  3089. (flet ((cd-eshell ()
  3090. (goto-char (point-max))
  3091. (insert
  3092. (format "cd '%s'" anything-ff-default-directory))
  3093. (eshell-send-input)))
  3094. (if (get-buffer "*eshell*")
  3095. (progn
  3096. (anything-c-switch-to-buffer "*eshell*")
  3097. (cd-eshell))
  3098. (call-interactively 'eshell)
  3099. (cd-eshell))))
  3100. (defun anything-ff-serial-rename-action (method)
  3101. "Rename all marked files to `anything-ff-default-directory' with METHOD.
  3102. See `anything-ff-serial-rename-1'."
  3103. (let* ((cands (anything-marked-candidates))
  3104. (def-name (car cands))
  3105. (name (read-string "NewName: "
  3106. (replace-regexp-in-string
  3107. "[0-9]+$" ""
  3108. (anything-c-basename
  3109. def-name
  3110. (file-name-extension def-name)))))
  3111. (start (read-number "StartAtNumber: "))
  3112. (extension (read-string "Extension: "
  3113. (file-name-extension (car cands))))
  3114. (dir (expand-file-name
  3115. (anything-c-read-file-name
  3116. "Serial Rename to directory: "
  3117. :initial-input
  3118. (expand-file-name anything-ff-default-directory)
  3119. :test 'file-directory-p
  3120. :must-match t)))
  3121. (res (loop for f in cands
  3122. for bn = (anything-c-basename f)
  3123. for count from start
  3124. concat (format "%s <-> %s%s.%s\n"
  3125. bn name count extension))))
  3126. (if (y-or-n-p
  3127. (format "Result:\n %sRename like this to <%s> ? " res dir))
  3128. (progn
  3129. (anything-ff-serial-rename-1
  3130. dir cands name start extension :method method)
  3131. (message nil)
  3132. (anything-find-files-1 dir))
  3133. (message "Operation aborted"))))
  3134. (defun anything-ff-member-directory-p (file directory)
  3135. (let ((dir-file (expand-file-name
  3136. (file-name-as-directory (file-name-directory file))))
  3137. (cur-dir (expand-file-name (file-name-as-directory directory))))
  3138. (string= dir-file cur-dir)))
  3139. (defun* anything-ff-serial-rename-1
  3140. (directory collection new-name start-at-num extension &key (method 'rename))
  3141. "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
  3142. Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
  3143. EXTENSION is the file extension to use, in empty prompt,
  3144. reuse the original extension of file.
  3145. METHOD can be one of rename, copy or symlink.
  3146. Files will be renamed if they are files of current directory, otherwise they
  3147. will be treated with METHOD.
  3148. Default METHOD is rename."
  3149. ;; Maybe remove directories selected by error in collection.
  3150. (setq collection (remove-if 'file-directory-p collection))
  3151. (flet ((symlink-file (file dest)
  3152. (let ((flist (list file)))
  3153. (anything-dired-action
  3154. dest :action 'symlink :files flist))))
  3155. (let* ((tmp-dir (file-name-as-directory
  3156. (concat (file-name-as-directory directory)
  3157. (symbol-name (gensym "tmp")))))
  3158. (fn (case method
  3159. (copy 'copy-file)
  3160. (symlink 'symlink-file)
  3161. (rename 'rename-file)
  3162. (t (error "Error: Unknow method %s" method)))))
  3163. (make-directory tmp-dir)
  3164. (unwind-protect
  3165. (progn
  3166. ;; Rename all files to tmp-dir with new-name.
  3167. ;; If files are not from start directory, use method
  3168. ;; to move files to tmp-dir.
  3169. (loop for i in collection
  3170. for count from start-at-num
  3171. for fnum = (if (< count 10) "0%s" "%s")
  3172. for nname = (concat tmp-dir new-name (format fnum count)
  3173. (if (not (string= extension ""))
  3174. (format ".%s" (replace-regexp-in-string
  3175. "[.]" "" extension))
  3176. (file-name-extension i 'dot)))
  3177. do (if (anything-ff-member-directory-p i directory)
  3178. (rename-file i nname)
  3179. (funcall fn i nname)))
  3180. ;; Now move all from tmp-dir to destination.
  3181. (loop with dirlist = (directory-files
  3182. tmp-dir t directory-files-no-dot-files-regexp)
  3183. for f in dirlist do
  3184. (if (file-symlink-p f)
  3185. (symlink-file (file-truename f)
  3186. (concat (file-name-as-directory directory)
  3187. (anything-c-basename f)))
  3188. (rename-file f directory))))
  3189. (delete-directory tmp-dir t)))))
  3190. (defun anything-ff-serial-rename (candidate)
  3191. "Serial rename all marked files to `anything-ff-default-directory'.
  3192. Rename only file of current directory, and symlink files coming from
  3193. other directories.
  3194. See `anything-ff-serial-rename-1'."
  3195. (anything-ff-serial-rename-action 'rename))
  3196. (defun anything-ff-serial-rename-by-symlink (candidate)
  3197. "Serial rename all marked files to `anything-ff-default-directory'.
  3198. Rename only file of current directory, and symlink files coming from
  3199. other directories.
  3200. See `anything-ff-serial-rename-1'."
  3201. (anything-ff-serial-rename-action 'symlink))
  3202. (defun anything-ff-serial-rename-by-copying (candidate)
  3203. "Serial rename all marked files to `anything-ff-default-directory'.
  3204. Rename only file of current directory, and copy files coming from
  3205. other directories.
  3206. See `anything-ff-serial-rename-1'."
  3207. (anything-ff-serial-rename-action 'copy))
  3208. (defun anything-c-quit-and-execute-action (action)
  3209. "Quit current anything session and execute ACTION."
  3210. (setq anything-saved-action action)
  3211. (anything-exit-minibuffer))
  3212. (defun anything-ff-toggle-auto-update (candidate)
  3213. (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
  3214. (message "[Auto expansion %s]"
  3215. (if anything-ff-auto-update-flag "enabled" "disabled")))
  3216. ;;;###autoload
  3217. (defun anything-ff-run-toggle-auto-update ()
  3218. (interactive)
  3219. (when (anything-file-completion-source-p)
  3220. (anything-attrset 'toggle-auto-update 'anything-ff-toggle-auto-update)
  3221. (anything-execute-persistent-action 'toggle-auto-update)))
  3222. ;;;###autoload
  3223. (defun anything-ff-run-switch-to-history ()
  3224. "Run Switch to history action from `anything-c-source-find-files'."
  3225. (interactive)
  3226. (when (anything-file-completion-source-p)
  3227. (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist)))
  3228. ;;;###autoload
  3229. (defun anything-ff-run-grep ()
  3230. "Run Grep action from `anything-c-source-find-files'."
  3231. (interactive)
  3232. (when (anything-file-completion-source-p)
  3233. (anything-c-quit-and-execute-action 'anything-find-files-grep)))
  3234. ;;;###autoload
  3235. (defun anything-ff-run-pdfgrep ()
  3236. "Run Pdfgrep action from `anything-c-source-find-files'."
  3237. (interactive)
  3238. (when (anything-file-completion-source-p)
  3239. (anything-c-quit-and-execute-action 'anything-ff-pdfgrep)))
  3240. ;;;###autoload
  3241. (defun anything-ff-run-zgrep ()
  3242. "Run Grep action from `anything-c-source-find-files'."
  3243. (interactive)
  3244. (when (anything-file-completion-source-p)
  3245. (anything-c-quit-and-execute-action 'anything-ff-zgrep)))
  3246. ;;;###autoload
  3247. (defun anything-ff-run-copy-file ()
  3248. "Run Copy file action from `anything-c-source-find-files'."
  3249. (interactive)
  3250. (when (anything-file-completion-source-p)
  3251. (anything-c-quit-and-execute-action 'anything-find-files-copy)))
  3252. ;;;###autoload
  3253. (defun anything-ff-run-rename-file ()
  3254. "Run Rename file action from `anything-c-source-find-files'."
  3255. (interactive)
  3256. (when (anything-file-completion-source-p)
  3257. (anything-c-quit-and-execute-action 'anything-find-files-rename)))
  3258. ;;;###autoload
  3259. (defun anything-ff-run-byte-compile-file ()
  3260. "Run Byte compile file action from `anything-c-source-find-files'."
  3261. (interactive)
  3262. (when (anything-file-completion-source-p)
  3263. (anything-c-quit-and-execute-action 'anything-find-files-byte-compile)))
  3264. ;;;###autoload
  3265. (defun anything-ff-run-load-file ()
  3266. "Run Load file action from `anything-c-source-find-files'."
  3267. (interactive)
  3268. (when (anything-file-completion-source-p)
  3269. (anything-c-quit-and-execute-action 'anything-find-files-load-files)))
  3270. ;;;###autoload
  3271. (defun anything-ff-run-eshell-command-on-file ()
  3272. "Run eshell command on file action from `anything-c-source-find-files'."
  3273. (interactive)
  3274. (when (anything-file-completion-source-p)
  3275. (anything-c-quit-and-execute-action
  3276. 'anything-find-files-eshell-command-on-file)))
  3277. ;;;###autoload
  3278. (defun anything-ff-run-ediff-file ()
  3279. "Run Ediff file action from `anything-c-source-find-files'."
  3280. (interactive)
  3281. (when (anything-file-completion-source-p)
  3282. (anything-c-quit-and-execute-action 'anything-find-files-ediff-files)))
  3283. ;;;###autoload
  3284. (defun anything-ff-run-ediff-merge-file ()
  3285. "Run Ediff merge file action from `anything-c-source-find-files'."
  3286. (interactive)
  3287. (when (anything-file-completion-source-p)
  3288. (anything-c-quit-and-execute-action
  3289. 'anything-find-files-ediff-merge-files)))
  3290. ;;;###autoload
  3291. (defun anything-ff-run-symlink-file ()
  3292. "Run Symlink file action from `anything-c-source-find-files'."
  3293. (interactive)
  3294. (when (anything-file-completion-source-p)
  3295. (anything-c-quit-and-execute-action 'anything-find-files-symlink)))
  3296. ;;;###autoload
  3297. (defun anything-ff-run-hardlink-file ()
  3298. "Run Hardlink file action from `anything-c-source-find-files'."
  3299. (interactive)
  3300. (when (anything-file-completion-source-p)
  3301. (anything-c-quit-and-execute-action 'anything-find-files-hardlink)))
  3302. ;;;###autoload
  3303. (defun anything-ff-run-delete-file ()
  3304. "Run Delete file action from `anything-c-source-find-files'."
  3305. (interactive)
  3306. (when (anything-file-completion-source-p)
  3307. (anything-c-quit-and-execute-action 'anything-delete-marked-files)))
  3308. ;;;###autoload
  3309. (defun anything-ff-run-complete-fn-at-point ()
  3310. "Run complete file name action from `anything-c-source-find-files'."
  3311. (interactive)
  3312. (when (anything-file-completion-source-p)
  3313. (anything-c-quit-and-execute-action
  3314. 'anything-c-insert-file-name-completion-at-point)))
  3315. ;;;###autoload
  3316. (defun anything-ff-run-switch-to-eshell ()
  3317. "Run switch to eshell action from `anything-c-source-find-files'."
  3318. (interactive)
  3319. (when (anything-file-completion-source-p)
  3320. (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell)))
  3321. ;;;###autoload
  3322. (defun anything-ff-run-switch-other-window ()
  3323. "Run switch to other window action from `anything-c-source-find-files'."
  3324. (interactive)
  3325. (when (anything-file-completion-source-p)
  3326. (anything-c-quit-and-execute-action 'find-file-other-window)))
  3327. ;;;###autoload
  3328. (defun anything-ff-run-switch-other-frame ()
  3329. "Run switch to other frame action from `anything-c-source-find-files'."
  3330. (interactive)
  3331. (when (anything-file-completion-source-p)
  3332. (anything-c-quit-and-execute-action 'find-file-other-frame)))
  3333. ;;;###autoload
  3334. (defun anything-ff-run-open-file-externally ()
  3335. "Run open file externally command action from `anything-c-source-find-files'."
  3336. (interactive)
  3337. (when (anything-file-completion-source-p)
  3338. (anything-c-quit-and-execute-action 'anything-c-open-file-externally)))
  3339. (defun anything-ff-locate (candidate)
  3340. "Locate action function for `anything-find-files'."
  3341. (let ((input (concat (anything-c-basename
  3342. (expand-file-name
  3343. candidate
  3344. anything-ff-default-directory))
  3345. ;; The locate '-b' option doesn't exists
  3346. ;; in everything.
  3347. (unless (and (eq system-type 'windows-nt)
  3348. (string-match "^es" anything-c-locate-command))
  3349. " -b")))
  3350. (anything-mp-highlight-delay 0.7))
  3351. (anything-locate-1 anything-current-prefix-arg input 'from-ff)))
  3352. ;;;###autoload
  3353. (defun anything-ff-run-locate ()
  3354. "Run locate action from `anything-c-source-find-files'."
  3355. (interactive)
  3356. (when (anything-file-completion-source-p)
  3357. (anything-c-quit-and-execute-action 'anything-ff-locate)))
  3358. ;;;###autoload
  3359. (defun anything-ff-run-gnus-attach-files ()
  3360. "Run gnus attach files command action from `anything-c-source-find-files'."
  3361. (interactive)
  3362. (when (anything-file-completion-source-p)
  3363. (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files)))
  3364. ;;;###autoload
  3365. (defun anything-ff-run-etags ()
  3366. "Run Etags command action from `anything-c-source-find-files'."
  3367. (interactive)
  3368. (when (anything-file-completion-source-p)
  3369. (anything-c-quit-and-execute-action 'anything-ff-etags-select)))
  3370. (defun anything-ff-print (candidate)
  3371. "Print marked files.
  3372. You have to set in order
  3373. variables `lpr-command',`lpr-switches' and/or `printer-name'.
  3374. e.g:
  3375. \(setq lpr-command \"gtklp\"\)
  3376. \(setq lpr-switches '(\"-P\")\)
  3377. \(setq printer-name \"Epson-Stylus-Photo-R265\"\)
  3378. Same as `dired-do-print' but for anything."
  3379. (when (or anything-current-prefix-arg
  3380. (not anything-ff-printer-list))
  3381. (setq anything-ff-printer-list
  3382. (anything-ff-find-printers)))
  3383. (let* ((file-list (anything-marked-candidates))
  3384. (len (length file-list))
  3385. (printer-name (if anything-ff-printer-list
  3386. (anything-comp-read
  3387. "Printer: " anything-ff-printer-list)
  3388. printer-name))
  3389. (command (read-string
  3390. (format "Print *%s File(s):\n%s with: "
  3391. len
  3392. (mapconcat
  3393. (lambda (f) (format "- %s\n" f))
  3394. file-list ""))
  3395. (when (and lpr-command
  3396. (or lpr-switches
  3397. printer-name))
  3398. (mapconcat 'identity
  3399. (cons lpr-command
  3400. (append (if (stringp lpr-switches)
  3401. (list lpr-switches)
  3402. lpr-switches)
  3403. (list printer-name)))
  3404. " "))))
  3405. (file-args (mapconcat #'(lambda (x)
  3406. (format "'%s'" x))
  3407. file-list " "))
  3408. (cmd-line (concat command " " file-args)))
  3409. (if command
  3410. (start-process-shell-command "anything-print" nil cmd-line)
  3411. (error "Error: Please verify your printer settings in Emacs."))))
  3412. ;;;###autoload
  3413. (defun anything-ff-run-print-file ()
  3414. "Run Print file action from `anything-c-source-find-files'."
  3415. (interactive)
  3416. (when (anything-file-completion-source-p)
  3417. (anything-c-quit-and-execute-action 'anything-ff-print)))
  3418. (defun anything-ff-checksum (file)
  3419. "Calculate the checksum of FILE.
  3420. Provide completion on different algorithms to use on Emacs24.
  3421. On Emacs23 only 'sha1' is available.
  3422. The checksum is copied to kill-ring."
  3423. (let ((algo-list (and (fboundp 'secure-hash)
  3424. '(md5 sha1 sha224 sha256 sha384 sha512))))
  3425. (kill-new
  3426. (if algo-list
  3427. (secure-hash (intern
  3428. (anything-comp-read
  3429. "Algorithm: " algo-list))
  3430. file)
  3431. (sha1 (with-temp-buffer
  3432. (insert-file-contents file)
  3433. (buffer-string)))))
  3434. (message "Checksum copied to kill-ring.")))
  3435. (defun anything-ff-toggle-basename (candidate)
  3436. (setq anything-ff-transformer-show-only-basename
  3437. (not anything-ff-transformer-show-only-basename))
  3438. (let ((target (if anything-ff-transformer-show-only-basename
  3439. (anything-c-basename candidate) candidate)))
  3440. (anything-force-update target)))
  3441. (defun anything-ff-run-toggle-basename ()
  3442. (interactive)
  3443. (when (anything-file-completion-source-p)
  3444. (anything-attrset 'toggle-basename 'anything-ff-toggle-basename)
  3445. (anything-execute-persistent-action 'toggle-basename)))
  3446. (defun* anything-reduce-file-name (fname level &key unix-close expand)
  3447. "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
  3448. If LEVEL is positive reduce from end else from beginning.
  3449. If UNIX-CLOSE is non--nil close filename with /.
  3450. If EXPAND is non--nil expand-file-name."
  3451. (let* ((exp-fname (expand-file-name fname))
  3452. (fname-list (split-string (if (or (string= fname "~/") expand)
  3453. exp-fname fname) "/" t))
  3454. (len (length fname-list))
  3455. (pop-list (if (< level 0)
  3456. (subseq fname-list (* level -1))
  3457. (subseq fname-list 0 (- len level))))
  3458. (result (mapconcat 'identity pop-list "/"))
  3459. (empty (string= result "")))
  3460. (when unix-close (setq result (concat result "/")))
  3461. (if (string-match "^~" result)
  3462. (if (string= result "~/") "~/" result)
  3463. (if (< level 0)
  3464. (if empty "../" (concat "../" result))
  3465. (cond ((eq system-type 'windows-nt)
  3466. (if empty (expand-file-name "/") ; Expand to "/" or "c:/".
  3467. result))
  3468. (empty "/")
  3469. (t
  3470. (concat "/" result)))))))
  3471. ;; Internal
  3472. (defvar anything-file-completion-sources
  3473. '("Find Files" "Read File Name"
  3474. "Read File Name History" "Copy Files"
  3475. "Rename Files" "Symlink Files"
  3476. "Hardlink Files" "Write File" "Insert File")
  3477. "Sources that use the *find-files mechanism can be added here.
  3478. Sources generated by `ac-mode' don't need to be added here, it will
  3479. be done automatically.
  3480. You should not modify this yourself unless you know what you do.")
  3481. (defun anything-file-completion-source-p ()
  3482. "Return non--nil if current source is a file completion source.
  3483. A source is a file completion source if it is
  3484. one of `anything-file-completion-sources'.
  3485. Return nil if anything is not running."
  3486. (let ((cur-source (cdr (assoc 'name (anything-get-current-source)))))
  3487. (loop for i in anything-file-completion-sources
  3488. thereis (string= cur-source i))))
  3489. (defun anything-find-files-down-one-level (arg)
  3490. "Go down one level like unix command `cd ..'.
  3491. If prefix numeric arg is given go ARG level down."
  3492. (interactive "p")
  3493. (when (and (anything-file-completion-source-p)
  3494. (not (anything-ff-invalid-tramp-name-p)))
  3495. (with-anything-window
  3496. (setq anything-follow-mode nil))
  3497. ;; When going to precedent level we want to be at the line
  3498. ;; corresponding to actual directory, so store this info
  3499. ;; in `anything-ff-last-expanded'.
  3500. (if (and (not (file-directory-p anything-pattern))
  3501. (file-exists-p anything-pattern))
  3502. (setq anything-ff-last-expanded anything-pattern)
  3503. (setq anything-ff-last-expanded anything-ff-default-directory))
  3504. (let ((new-pattern (anything-reduce-file-name anything-pattern arg
  3505. :unix-close t :expand t)))
  3506. (anything-set-pattern new-pattern))))
  3507. (defun anything-ff-retrieve-last-expanded ()
  3508. "Move overlay to last visited directory `anything-ff-last-expanded'.
  3509. This happen after using `anything-find-files-down-one-level',
  3510. or hitting C-z on \"..\"."
  3511. (when (and anything-ff-last-expanded
  3512. (anything-file-completion-source-p))
  3513. (let ((presel (if anything-ff-transformer-show-only-basename
  3514. (anything-c-basename
  3515. (directory-file-name anything-ff-last-expanded))
  3516. (directory-file-name anything-ff-last-expanded))))
  3517. (with-anything-window
  3518. (when (re-search-forward
  3519. (concat "^" (regexp-quote presel) "$") nil t)
  3520. (forward-line 0)
  3521. (anything-mark-current-line)))
  3522. (setq anything-ff-last-expanded nil))))
  3523. (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
  3524. ;; Auto-update - anything-find-files auto expansion of directories.
  3525. ;;
  3526. (defun anything-ff-update-when-only-one-matched ()
  3527. "Expand to directory when sole completion.
  3528. When only one candidate is remaining and it is a directory,
  3529. expand to this directory."
  3530. (when (and anything-ff-auto-update-flag
  3531. (anything-file-completion-source-p)
  3532. (not (anything-ff-invalid-tramp-name-p)))
  3533. (let* ((history-p (string= (assoc-default
  3534. 'name (anything-get-current-source))
  3535. "Read File Name History"))
  3536. (pat (if (string-match tramp-file-name-regexp
  3537. anything-pattern)
  3538. (anything-create-tramp-name anything-pattern)
  3539. anything-pattern))
  3540. (completed-p (string= (file-name-as-directory pat)
  3541. anything-ff-default-directory)))
  3542. (when (and (or
  3543. ;; Only one candidate remaining
  3544. ;; and at least 2 char in basename.
  3545. (and (<= (anything-approximate-candidate-number) 2)
  3546. (>= (length (anything-c-basename anything-pattern)) 2))
  3547. ;; Already completed.
  3548. completed-p)
  3549. (not history-p)) ; Don't try to auto complete in history.
  3550. (with-anything-window
  3551. (let ((cur-cand (prog2
  3552. (unless completed-p
  3553. ;; Only one non--existing candidate
  3554. ;; and one directory candidate, move to it.
  3555. (anything-next-line))
  3556. (anything-get-selection))))
  3557. (when (and (stringp cur-cand) (file-directory-p cur-cand))
  3558. (if (and (not (string-match "^.*[.]\\{1,2\\}$" cur-cand)) ; [1]
  3559. ;; Maybe we are here because completed-p is true
  3560. ;; but check this again to be sure. (Windows fix)
  3561. (<= (anything-approximate-candidate-number) 2)) ; [2]
  3562. ;; If after going to next line the candidate
  3563. ;; is not one of "." or ".." [1]
  3564. ;; and only one candidate is remaining [2],
  3565. ;; assume candidate is a new directory to expand, and do it.
  3566. (anything-set-pattern (file-name-as-directory cur-cand))
  3567. ;; The candidate is one of "." or ".."
  3568. ;; that mean we have entered the last letter of the directory name
  3569. ;; in prompt, so expansion is already done, just add the "/" at end
  3570. ;; of name unless anything-pattern ends with "."
  3571. ;; (i.e we are writing something starting with ".")
  3572. (unless (string-match "^.*[.]\\{1\\}$" anything-pattern)
  3573. (anything-set-pattern
  3574. ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt.
  3575. (expand-file-name (file-name-as-directory anything-pattern)))))
  3576. (anything-check-minibuffer-input-1))))))))
  3577. (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
  3578. ;; Allow expanding to home directory or root
  3579. ;; when entering respectively "~/" or "//" at end of pattern.
  3580. ;; e.g /home/thierry/labo/anything-config-qp/~/
  3581. ;; will expand to "~/"
  3582. ;; and /home/thierry/labo/anything-config-qp//
  3583. ;; will expand to "/"
  3584. (defun anything-ff-auto-expand-to-home-or-root ()
  3585. "Goto home, root or default directory when pattern ends with ~/, /, or ./.
  3586. This happen only in function using sources that are
  3587. `anything-file-completion-source-p' compliant."
  3588. (when (and (anything-file-completion-source-p)
  3589. (string-match ".*\\(/~/\\|/\\{2\\}\\|/[.]\\{1\\}/\\)$"
  3590. anything-pattern)
  3591. (not (string-match anything-ff-url-regexp anything-pattern)))
  3592. (let ((match (match-string 1 anything-pattern)))
  3593. (cond ((string= match "//")
  3594. ;; Expand to "/" or "c:/"
  3595. (setq anything-pattern (expand-file-name "/")))
  3596. ((string= match "/~/")
  3597. (if (eq system-type 'windows-nt)
  3598. (setq anything-pattern (file-name-as-directory (getenv "HOME")))
  3599. (setq anything-pattern "~/")))
  3600. ((string= match "/./")
  3601. (setq anything-pattern
  3602. (with-anything-current-buffer
  3603. (expand-file-name default-directory))))))
  3604. (setq anything-ff-default-directory anything-pattern)
  3605. ;; For some reasons, i must use here with-current-buffer => mini buffer
  3606. ;; and not `anything-set-pattern' that use with-selected-window => mini win.
  3607. (with-current-buffer (window-buffer (minibuffer-window))
  3608. (delete-minibuffer-contents)
  3609. (insert anything-pattern))))
  3610. (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
  3611. (defun anything-c-point-file-in-dired (file)
  3612. "Put point on filename FILE in dired buffer."
  3613. (dired (file-name-directory file))
  3614. (dired-goto-file file))
  3615. (defun anything-create-tramp-name (fname)
  3616. "Build filename for `anything-pattern' like /su:: or /sudo::."
  3617. (apply #'tramp-make-tramp-file-name
  3618. (loop with v = (tramp-dissect-file-name fname)
  3619. for i across v collect i)))
  3620. (defun* anything-ff-tramp-hostnames (&optional (pattern anything-pattern))
  3621. "Get a list of hosts for tramp method found in `anything-pattern'.
  3622. Argument PATTERN default to `anything-pattern', it is here only for debugging
  3623. purpose."
  3624. (when (string-match tramp-file-name-regexp pattern)
  3625. (let ((method (match-string 1 pattern))
  3626. (tn (match-string 0 pattern))
  3627. (all-methods (mapcar 'car tramp-methods)))
  3628. (anything-fast-remove-dups
  3629. (loop for (f . h) in (tramp-get-completion-function method)
  3630. append (loop for e in (funcall f (car h))
  3631. for host = (and (consp e) (cadr e))
  3632. when (and host (not (member host all-methods)))
  3633. collect (concat tn host)))
  3634. :test 'equal))))
  3635. (defun anything-ff-before-action-hook-fn ()
  3636. "Exit anything when user try to execute action on an invalid tramp fname."
  3637. (let ((cand (anything-get-selection)))
  3638. (when (and (anything-file-completion-source-p)
  3639. (anything-ff-invalid-tramp-name-p cand) ; Check candidate.
  3640. (anything-ff-invalid-tramp-name-p)) ; check anything-pattern.
  3641. (error "Error: Unknow file or directory `%s'" cand))))
  3642. (add-hook 'anything-before-action-hook 'anything-ff-before-action-hook-fn)
  3643. (defun* anything-ff-invalid-tramp-name-p (&optional (pattern anything-pattern))
  3644. "Return non--nil when PATTERN is an invalid tramp filename."
  3645. (string= (anything-ff-set-pattern pattern)
  3646. "Invalid tramp file name"))
  3647. (defun anything-ff-set-pattern (pattern)
  3648. "Handle tramp filenames in `anything-pattern'."
  3649. (let ((methods (mapcar 'car tramp-methods))
  3650. (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
  3651. cur-method tramp-name)
  3652. (cond ((string= pattern "") "")
  3653. ((string-match ".*\\(~?/?[.]\\{1\\}/\\)$" pattern)
  3654. (with-anything-current-buffer
  3655. (expand-file-name default-directory)))
  3656. ((and (string-match ".*\\(~//\\|//\\)$" pattern)
  3657. (not (string-match anything-ff-url-regexp anything-pattern)))
  3658. (expand-file-name "/") ; Expand to "/" or "c:/"
  3659. )
  3660. ((string-match "^~\\|.*/~/$" pattern)
  3661. (let* ((home (expand-file-name (getenv "HOME"))))
  3662. (replace-match home nil t pattern)))
  3663. ;; Match "/method:maybe_hostname:"
  3664. ((and (string-match reg pattern)
  3665. (setq cur-method (match-string 1 pattern))
  3666. (member cur-method methods))
  3667. (setq tramp-name (anything-create-tramp-name
  3668. (match-string 0 pattern)))
  3669. (replace-match tramp-name nil t pattern))
  3670. ;; Match "/hostname:"
  3671. ((and (string-match tramp-file-name-regexp pattern)
  3672. (setq cur-method (match-string 1 pattern))
  3673. (and cur-method (not (member cur-method methods))))
  3674. (setq tramp-name (anything-create-tramp-name
  3675. (match-string 0 pattern)))
  3676. (replace-match tramp-name nil t pattern))
  3677. ;; Match "/method:" in this case don't try to connect.
  3678. ((and (not (string-match reg pattern))
  3679. (string-match tramp-file-name-regexp pattern)
  3680. (member (match-string 1 pattern) methods))
  3681. "Invalid tramp file name") ; Write in anything-buffer.
  3682. ;; PATTERN is a directory, end it with "/".
  3683. ;; This will make PATTERN not ending yet with "/"
  3684. ;; candidate for `anything-ff-default-directory',
  3685. ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
  3686. ;; when descending level.
  3687. ((file-directory-p pattern)
  3688. (file-name-as-directory pattern))
  3689. ;; Return PATTERN unchanged.
  3690. (t pattern))))
  3691. (defun anything-find-files-get-candidates (&optional require-match)
  3692. "Create candidate list for `anything-c-source-find-files'."
  3693. (let* ((path (anything-ff-set-pattern anything-pattern))
  3694. (path-name-dir (if (file-directory-p path)
  3695. (file-name-as-directory path)
  3696. (file-name-directory path)))
  3697. (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
  3698. (set-text-properties 0 (length path) nil path)
  3699. ;; Don't set now `anything-pattern' if `path' == "Invalid tramp file name"
  3700. ;; like that the actual value (e.g /ssh:) is passed to
  3701. ;; `anything-ff-tramp-hostnames'.
  3702. (unless (string= path "Invalid tramp file name")
  3703. (setq anything-pattern (anything-ff-transform-fname-for-completion path)))
  3704. (setq anything-ff-default-directory
  3705. (if (string= anything-pattern "")
  3706. (expand-file-name "/") ; Expand to "/" or "c:/"
  3707. ;; If path is an url *default-directory have to be nil.
  3708. (unless (or (string-match anything-ff-url-regexp path)
  3709. (string-match ffap-url-regexp path))
  3710. path-name-dir)))
  3711. (cond ((string= path "Invalid tramp file name")
  3712. (or (anything-ff-tramp-hostnames) ; Hostnames completion.
  3713. (prog2
  3714. ;; `anything-pattern' have not been modified yet.
  3715. ;; Set it here to the value of `path' that should be now
  3716. ;; "Invalid tramp file name" and set the candidates list
  3717. ;; to ("Invalid tramp file name") to make `anything-pattern'
  3718. ;; match single candidate "Invalid tramp file name".
  3719. (setq anything-pattern path)
  3720. ;; "Invalid tramp file name" is now printed
  3721. ;; in `anything-buffer'.
  3722. (list path))))
  3723. ((or (file-regular-p path)
  3724. ;; `ffap-url-regexp' don't match until url is complete.
  3725. (string-match anything-ff-url-regexp path)
  3726. (and (not (file-exists-p path)) (string-match "/$" path))
  3727. (and ffap-url-regexp (string-match ffap-url-regexp path)))
  3728. (list path))
  3729. ((string= path "") (anything-ff-directory-files "/" t))
  3730. ((and (file-directory-p path) (not (file-readable-p path)))
  3731. (list (format "Opening directory: access denied, `%s'" path)))
  3732. ((file-directory-p path) (anything-ff-directory-files path t))
  3733. (t
  3734. (append (unless require-match (list path))
  3735. (anything-ff-directory-files path-name-dir t))))))
  3736. (defun anything-ff-directory-files (directory &optional full)
  3737. "List contents of DIRECTORY.
  3738. Argument FULL mean absolute path.
  3739. It is same as `directory-files' but always returns the
  3740. dotted filename '.' and '..' on root directories on Windows
  3741. systems."
  3742. (setq directory (expand-file-name directory))
  3743. (let ((ls (directory-files directory full))
  3744. dot dot2 lsdir)
  3745. (if (or
  3746. ;; A windows volume.
  3747. (string-match "^[a-zA-Z]\\{1\\}:/$" directory)
  3748. ;; Empty directories on ftp hosts may have no dot dirs.
  3749. (and (file-remote-p directory)
  3750. (string-match "^/ftp:" directory)))
  3751. (progn (setq dot (concat directory "."))
  3752. (setq dot2 (concat directory ".."))
  3753. (setq lsdir (remove dot2 (remove dot ls)))
  3754. (append (list dot dot2) lsdir))
  3755. ls)))
  3756. (defun anything-ff-transform-fname-for-completion (fname)
  3757. "Return FNAME with it's basename modified as a regexp.
  3758. e.g foo => f.*o.*o .
  3759. If basename contain one or more space or FNAME is a valid directory name
  3760. return FNAME unchanged."
  3761. (let ((bn (anything-c-basename fname)))
  3762. (if (or (not anything-ff-smart-completion)
  3763. (string-match "\\s-" bn)
  3764. (string-match "/$" fname) ; Allow mkdir.
  3765. (file-directory-p fname)
  3766. (string-match anything-ff-url-regexp fname))
  3767. fname ; Fall back to match-plugin.
  3768. (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
  3769. (mapconcat 'identity (split-string bn "" t) ".*") bn))
  3770. (concat (file-name-directory fname) bn))))
  3771. (defun anything-ff-save-history ()
  3772. "Store the last value of `anything-ff-default-directory' \
  3773. in `anything-ff-history'."
  3774. (when (and anything-ff-default-directory
  3775. (anything-file-completion-source-p))
  3776. (push anything-ff-default-directory anything-ff-history)))
  3777. (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
  3778. (defun anything-ff-valid-symlink-p (file)
  3779. (file-exists-p (file-truename file)))
  3780. (defun anything-ff-properties (candidate)
  3781. "Show file properties of CANDIDATE in a tooltip or message."
  3782. (let ((type (anything-ff-attributes candidate :type t))
  3783. (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
  3784. (if (window-system)
  3785. (tooltip-show
  3786. (concat
  3787. (anything-c-basename candidate) "\n"
  3788. "Type: " type "\n"
  3789. (when (string= type "symlink")
  3790. (format "True name: '%s'\n"
  3791. (cond ((string-match "^\.#" (anything-c-basename candidate))
  3792. "Autosave symlink")
  3793. ((anything-ff-valid-symlink-p candidate)
  3794. (file-truename candidate))
  3795. (t "Invalid Symlink"))))
  3796. dired-line))
  3797. (message dired-line) (sit-for 5))))
  3798. ;;;###autoload
  3799. (defun anything-ff-properties-persistent ()
  3800. "Show properties without quitting anything."
  3801. (interactive)
  3802. (anything-attrset 'properties-action 'anything-ff-properties)
  3803. (anything-execute-persistent-action 'properties-action))
  3804. ;;;###autoload
  3805. (defun anything-ff-persistent-delete ()
  3806. "Delete current candidate without quitting."
  3807. (interactive)
  3808. (anything-attrset 'quick-delete 'anything-ff-quick-delete)
  3809. (anything-execute-persistent-action 'quick-delete))
  3810. (defun anything-ff-dot-file-p (file)
  3811. "Check if FILE is `.' or `..'."
  3812. (member (anything-c-basename file) '("." "..")))
  3813. (defun anything-ff-quick-delete (candidate)
  3814. "Delete file CANDIDATE without quitting."
  3815. (let ((presel (prog1 (save-excursion
  3816. (let (sel)
  3817. (anything-next-line)
  3818. (setq sel (anything-get-selection))
  3819. (if (string= sel candidate)
  3820. (progn (anything-previous-line)
  3821. (anything-get-selection))
  3822. sel)))
  3823. (anything-mark-current-line))))
  3824. (setq presel (if (and anything-ff-transformer-show-only-basename
  3825. (not (anything-ff-dot-file-p presel)))
  3826. (anything-c-basename presel) presel))
  3827. (if anything-ff-quick-delete-dont-prompt-for-deletion
  3828. (anything-c-delete-file candidate
  3829. anything-ff-signal-error-on-dot-files)
  3830. (save-selected-window
  3831. (when (y-or-n-p (format "Really Delete file `%s'? " candidate))
  3832. (anything-c-delete-file candidate
  3833. anything-ff-signal-error-on-dot-files)
  3834. (message nil))))
  3835. (anything-force-update presel)))
  3836. (defun anything-ff-kill-buffer-fname (candidate)
  3837. (let* ((buf (get-file-buffer candidate))
  3838. (buf-name (buffer-name buf)))
  3839. (if buf
  3840. (progn
  3841. (kill-buffer buf) (message "Buffer `%s' killed" buf))
  3842. (message "No buffer to kill"))))
  3843. (defun anything-ff-kill-or-find-buffer-fname (candidate)
  3844. "Find file CANDIDATE or kill it's buffer if it is visible.
  3845. Never kill `anything-current-buffer'.
  3846. Never kill buffer modified.
  3847. This is called normally on third hit of \
  3848. \\<anything-map>\\[anything-execute-persistent-action]
  3849. in `anything-find-files-persistent-action'."
  3850. (let* ((buf (get-file-buffer candidate))
  3851. (buf-name (buffer-name buf)))
  3852. (if (and buf (get-buffer-window buf)
  3853. (not (eq buf (get-buffer anything-current-buffer)))
  3854. (not (buffer-modified-p buf)))
  3855. (progn
  3856. (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
  3857. (find-file candidate))))
  3858. ;;;###autoload
  3859. (defun anything-ff-run-kill-buffer-persistent ()
  3860. "Execute `anything-ff-kill-buffer-fname' whitout quitting."
  3861. (interactive)
  3862. (when (anything-file-completion-source-p)
  3863. (anything-attrset 'kill-buffer-fname 'anything-ff-kill-buffer-fname)
  3864. (anything-execute-persistent-action 'kill-buffer-fname)))
  3865. (defun anything-ff-human-size (size)
  3866. "Return a string showing SIZE of a file in human readable form.
  3867. SIZE can be an integer or a float depending it's value.
  3868. `file-attributes' will take care of that to avoid overflow error.
  3869. KBSIZE if a floating point number, default value is 1024.0."
  3870. (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
  3871. (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
  3872. (K (cons "K" (/ size anything-ff-default-kbsize)))
  3873. (B (cons "B" size)))
  3874. (loop with result = B
  3875. for (a . b) in
  3876. (loop for (x . y) in (list M G K B)
  3877. unless (< y 1) collect (cons x y))
  3878. when (< b (cdr result)) do (setq result (cons a b))
  3879. finally return (if (string= (car result) "B")
  3880. (format "%s" size)
  3881. (format "%.1f%s" (cdr result) (car result))))))
  3882. (defun* anything-ff-attributes
  3883. (file &key type links uid gid access-time modif-time
  3884. status size mode gid-change inode device-num dired human-size)
  3885. "Easy interface for `file-attributes'."
  3886. (let ((all (destructuring-bind
  3887. (type links uid gid access-time modif-time
  3888. status size mode gid-change inode device-num)
  3889. (file-attributes file 'string)
  3890. (list :type type
  3891. :links links
  3892. :uid uid
  3893. :gid gid
  3894. :access-time access-time
  3895. :modif-time modif-time
  3896. :status status
  3897. :size size
  3898. :mode mode
  3899. :gid-change gid-change
  3900. :inode inode
  3901. :device-num device-num))))
  3902. (cond (type
  3903. (let ((result (getf all :type)))
  3904. (cond ((stringp result)
  3905. "symlink")
  3906. (result "directory")
  3907. (t "file"))))
  3908. (links (getf all :links))
  3909. (uid (getf all :uid))
  3910. (gid (getf all :gid))
  3911. (access-time
  3912. (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
  3913. (modif-time
  3914. (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
  3915. (status
  3916. (format-time-string "%Y-%m-%d %R" (getf all :status)))
  3917. (size (if human-size (anything-ff-human-size (getf all :size))
  3918. (getf all :size)))
  3919. (mode (getf all :mode))
  3920. (gid-change (getf all :gid-change))
  3921. (inode (getf all :inode))
  3922. (device-num (getf all :device-num))
  3923. (dired
  3924. (concat
  3925. (getf all :mode) " "
  3926. (number-to-string (getf all :links)) " "
  3927. (getf all :uid) ":"
  3928. (getf all :gid) " "
  3929. (if human-size (anything-ff-human-size (getf all :size))
  3930. (int-to-string (getf all :size))) " "
  3931. (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
  3932. (t all))))
  3933. (defun anything-ff-prefix-filename (fname &optional file-or-symlinkp new-file)
  3934. "Return filename FNAME maybe prefixed with [?] or [@].
  3935. If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an
  3936. existing filename or valid symlink and there is no need to test it.
  3937. NEW-FILE when non--nil mean FNAME is a non existing file and
  3938. return FNAME prefixed with [?]."
  3939. (let* ((prefix-new (propertize
  3940. " " 'display
  3941. (propertize "[?]" 'face 'anything-ff-prefix)))
  3942. (prefix-url (propertize
  3943. " " 'display
  3944. (propertize "[@]" 'face 'anything-ff-prefix))))
  3945. (cond ((or file-or-symlinkp (file-exists-p fname)) fname)
  3946. ((or (string-match anything-ff-url-regexp fname)
  3947. (string-match ffap-url-regexp fname))
  3948. (concat prefix-url " " fname))
  3949. ((or new-file (not (file-exists-p fname)))
  3950. (concat prefix-new " " fname)))))
  3951. (defun anything-c-find-files-transformer (files sources)
  3952. "Transformer for `anything-c-source-find-files'.
  3953. Tramp files are not highlighted unless `anything-ff-tramp-not-fancy'
  3954. is non--nil."
  3955. (if (and (string-match tramp-file-name-regexp anything-pattern)
  3956. anything-ff-tramp-not-fancy)
  3957. (if anything-ff-transformer-show-only-basename
  3958. (loop for i in files collect
  3959. (if (string-match "[.]\\{1,2\\}$" i)
  3960. i (cons (anything-c-basename i) i)))
  3961. files)
  3962. (anything-ff-highlight-files files sources)))
  3963. (defun anything-ff-highlight-files (files sources)
  3964. "Candidate transformer for `anything-c-source-find-files' without icons."
  3965. (loop for i in files
  3966. for disp = (if (and anything-ff-transformer-show-only-basename
  3967. (not (string-match "[.]\\{1,2\\}$" i))
  3968. (not (string-match ffap-url-regexp i))
  3969. (not (string-match anything-ff-url-regexp i)))
  3970. (anything-c-basename i) i)
  3971. collect
  3972. (cond ((and (stringp (car (file-attributes i)))
  3973. (not (anything-ff-valid-symlink-p i))
  3974. (not (string-match "^\.#" (anything-c-basename i))))
  3975. (cons (anything-ff-prefix-filename
  3976. (propertize disp 'face 'anything-ff-invalid-symlink) t)
  3977. i))
  3978. ((stringp (car (file-attributes i)))
  3979. (cons (anything-ff-prefix-filename
  3980. (propertize disp 'face 'anything-ff-symlink) t)
  3981. i))
  3982. ((eq t (car (file-attributes i)))
  3983. (cons (anything-ff-prefix-filename
  3984. (propertize disp 'face 'anything-ff-directory) t)
  3985. i))
  3986. ((file-executable-p i)
  3987. (cons (anything-ff-prefix-filename
  3988. (propertize disp 'face 'anything-ff-executable) t)
  3989. i))
  3990. ((file-exists-p i)
  3991. (cons (anything-ff-prefix-filename
  3992. (propertize disp 'face 'anything-ff-file) t)
  3993. i))
  3994. (t
  3995. (cons (anything-ff-prefix-filename
  3996. (propertize disp 'face 'anything-ff-file) nil 'new-file)
  3997. i)))))
  3998. (defun anything-find-files-action-transformer (actions candidate)
  3999. "Action transformer for `anything-c-source-find-files'."
  4000. (cond ((with-anything-current-buffer
  4001. (eq major-mode 'message-mode))
  4002. (append (subseq actions 0 4)
  4003. '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
  4004. (subseq actions 4)))
  4005. ((string-match (image-file-name-regexp) candidate)
  4006. (append (subseq actions 0 4)
  4007. '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
  4008. ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
  4009. (subseq actions 4)))
  4010. ((string-match "\.el$" (anything-aif (anything-marked-candidates)
  4011. (car it) candidate))
  4012. (append (subseq actions 0 4)
  4013. '(("Byte compile lisp file(s) `M-B, C-u to load'"
  4014. . anything-find-files-byte-compile)
  4015. ("Load File(s) `M-L'" . anything-find-files-load-files))
  4016. (subseq actions 4)))
  4017. ((and (string-match "\.html?$" candidate)
  4018. (file-exists-p candidate))
  4019. (append (subseq actions 0 4)
  4020. '(("Browse url file" . browse-url-of-file))
  4021. (subseq actions 5)))
  4022. ((or (string= (file-name-extension candidate) "pdf")
  4023. (string= (file-name-extension candidate) "PDF"))
  4024. (append (subseq actions 0 4)
  4025. '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
  4026. (subseq actions 5)))
  4027. (t actions)))
  4028. (defun anything-ff-gnus-attach-files (candidate)
  4029. "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
  4030. (let ((flist (anything-marked-candidates)))
  4031. (gnus-dired-attach flist)))
  4032. (defun anything-ff-rotate-current-image-1 (file &optional num-arg)
  4033. "Rotate current image at NUM-ARG degrees.
  4034. This is a destructive operation on FILE made by external tool mogrify."
  4035. (declare (special image-dired-display-image-buffer))
  4036. (setq file (file-truename file)) ; For symlinked images.
  4037. ;; When FILE is not an image-file, do nothing.
  4038. (when (string-match (image-file-name-regexp) file)
  4039. (if (executable-find "mogrify")
  4040. (progn
  4041. (shell-command (format "mogrify -rotate %s %s"
  4042. (or num-arg 90)
  4043. (shell-quote-argument file)))
  4044. (when (buffer-live-p image-dired-display-image-buffer)
  4045. (kill-buffer image-dired-display-image-buffer))
  4046. (image-dired-display-image file)
  4047. (message nil)
  4048. (display-buffer (get-buffer image-dired-display-image-buffer)))
  4049. (error "mogrify not found"))))
  4050. (defun anything-ff-rotate-image-left (candidate)
  4051. "Rotate image file CANDIDATE left.
  4052. This affect directly file CANDIDATE."
  4053. (anything-ff-rotate-current-image-1 candidate -90))
  4054. (defun anything-ff-rotate-image-right (candidate)
  4055. "Rotate image file CANDIDATE right.
  4056. This affect directly file CANDIDATE."
  4057. (anything-ff-rotate-current-image-1 candidate))
  4058. (defun anything-ff-rotate-left-persistent ()
  4059. "Rotate image left without quitting anything."
  4060. (interactive)
  4061. (anything-attrset 'image-action1 'anything-ff-rotate-image-left)
  4062. (anything-execute-persistent-action 'image-action1))
  4063. (defun anything-ff-rotate-right-persistent ()
  4064. "Rotate image right without quitting anything."
  4065. (interactive)
  4066. (anything-attrset 'image-action2 'anything-ff-rotate-image-right)
  4067. (anything-execute-persistent-action 'image-action2))
  4068. (defun anything-ff-exif-data (candidate)
  4069. "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
  4070. (if (and anything-ff-exif-data-program
  4071. (executable-find anything-ff-exif-data-program))
  4072. (shell-command-to-string (format "%s %s %s"
  4073. anything-ff-exif-data-program
  4074. anything-ff-exif-data-program-args
  4075. candidate))
  4076. (format "No program %s found to extract exif"
  4077. anything-ff-exif-data-program)))
  4078. (defun anything-find-files-persistent-action (candidate)
  4079. "Open subtree CANDIDATE without quitting anything.
  4080. If CANDIDATE is not a directory expand CANDIDATE filename.
  4081. If CANDIDATE is alone, open file CANDIDATE filename.
  4082. That's mean:
  4083. First hit on C-z expand CANDIDATE second hit open file.
  4084. If a prefix arg is given or `anything-follow-mode' is on open file."
  4085. (let ((follow (buffer-local-value
  4086. 'anything-follow-mode
  4087. (get-buffer-create anything-buffer)))
  4088. (new-pattern (anything-get-selection))
  4089. (num-lines-buf (with-current-buffer anything-buffer
  4090. (count-lines (point-min) (point-max)))))
  4091. (flet ((insert-in-minibuffer (fname)
  4092. (with-selected-window (minibuffer-window)
  4093. (unless follow
  4094. (delete-minibuffer-contents)
  4095. (set-text-properties 0 (length fname) nil fname)
  4096. (insert fname)))))
  4097. (cond ((and (string= (anything-ff-set-pattern anything-pattern)
  4098. "Invalid tramp file name")
  4099. (string-match tramp-file-name-regexp candidate))
  4100. ;; First hit insert hostname and
  4101. ;; second hit insert ":" and expand.
  4102. (if (string= candidate anything-pattern)
  4103. (insert-in-minibuffer (concat candidate ":"))
  4104. (insert-in-minibuffer candidate)))
  4105. (;; A symlink directory, expand it's truename.
  4106. (and (file-directory-p candidate) (file-symlink-p candidate))
  4107. (insert-in-minibuffer (file-name-as-directory
  4108. (file-truename
  4109. (expand-file-name candidate)))))
  4110. ;; A directory, open it.
  4111. ((file-directory-p candidate)
  4112. (when (string= (anything-c-basename candidate) "..")
  4113. (setq anything-ff-last-expanded anything-ff-default-directory))
  4114. (insert-in-minibuffer (file-name-as-directory
  4115. (expand-file-name candidate))))
  4116. ;; A symlink file, expand to it's true name. (first hit)
  4117. ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
  4118. (insert-in-minibuffer (file-truename candidate)))
  4119. ;; A regular file, expand it, (first hit)
  4120. ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
  4121. (insert-in-minibuffer new-pattern))
  4122. ;; An image file and it is the second hit on C-z,
  4123. ;; show the file in `image-dired'.
  4124. ((string-match (image-file-name-regexp) candidate)
  4125. (when (buffer-live-p image-dired-display-image-buffer)
  4126. (kill-buffer image-dired-display-image-buffer))
  4127. (image-dired-display-image candidate)
  4128. (message nil)
  4129. (anything-c-switch-to-buffer image-dired-display-image-buffer)
  4130. (with-current-buffer image-dired-display-image-buffer
  4131. (let ((exif-data (anything-ff-exif-data candidate)))
  4132. (image-dired-update-property 'help-echo exif-data))))
  4133. ;; Allow browsing archive on avfs fs.
  4134. ;; Assume volume is already mounted with mountavfs.
  4135. ((and anything-ff-avfs-directory
  4136. (string-match
  4137. (regexp-quote (expand-file-name anything-ff-avfs-directory))
  4138. (file-name-directory candidate))
  4139. (anything-ff-file-compressed-p candidate))
  4140. (insert-in-minibuffer (concat candidate "#")))
  4141. ;; On second hit we open file.
  4142. ;; On Third hit we kill it's buffer maybe.
  4143. (t
  4144. (anything-ff-kill-or-find-buffer-fname candidate))))))
  4145. (defun anything-ff-file-compressed-p (candidate)
  4146. "Whether CANDIDATE is a compressed file or not."
  4147. (member (file-name-extension candidate)
  4148. anything-ff-file-compressed-list))
  4149. (defun anything-c-insert-file-name-completion-at-point (candidate)
  4150. "Insert file name completion at point."
  4151. (with-anything-current-buffer
  4152. (if buffer-read-only
  4153. (error "Error: Buffer `%s' is read-only" (buffer-name))
  4154. (let* ((end (point))
  4155. (guess (substring-no-properties (thing-at-point 'filename)))
  4156. (beg (- (point) (length guess)))
  4157. (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
  4158. (string-match-p "^[^\~]" guess))))
  4159. (set-text-properties 0 (length candidate) nil candidate)
  4160. (if (and guess (not (string= guess ""))
  4161. (string-match-p "^~\\|/.*" guess))
  4162. (progn
  4163. (delete-region beg end)
  4164. (insert (if full-path-p
  4165. (expand-file-name candidate)
  4166. (abbreviate-file-name candidate))))
  4167. (error "Aborting completion: No valid file name at point"))))))
  4168. (defun* anything-find-files-history (&key (comp-read t))
  4169. "The `anything-find-files' history.
  4170. Show the first `anything-ff-history-max-length' elements of
  4171. `anything-ff-history' in an `anything-comp-read'."
  4172. (let ((history (when anything-ff-history
  4173. (anything-fast-remove-dups anything-ff-history
  4174. :test 'equal))))
  4175. (when history
  4176. (setq anything-ff-history
  4177. (if (>= (length history) anything-ff-history-max-length)
  4178. (subseq history 0 anything-ff-history-max-length)
  4179. history))
  4180. (if comp-read
  4181. (anything-comp-read
  4182. "Switch to Directory: "
  4183. anything-ff-history
  4184. :name "Anything Find Files History"
  4185. :must-match t)
  4186. anything-ff-history))))
  4187. (defun anything-find-files-1 (fname &optional preselect)
  4188. "Find FNAME with `anything' completion.
  4189. Like `find-file' but with `anything' support.
  4190. Use it for non--interactive calls of `anything-find-files'."
  4191. (when (get-buffer anything-action-buffer)
  4192. (kill-buffer anything-action-buffer))
  4193. (let ((anything-mp-highlight-delay nil)
  4194. ;; Be sure we don't erase the precedent minibuffer if some.
  4195. (anything-ff-auto-update-initial-value
  4196. (and anything-ff-auto-update-initial-value
  4197. (not (minibuffer-window-active-p (minibuffer-window)))))
  4198. anything-samewindow)
  4199. (anything :sources 'anything-c-source-find-files
  4200. :input fname
  4201. :preselect preselect
  4202. :keymap anything-find-files-map
  4203. :prompt "Find Files or Url: "
  4204. :buffer "*Anything Find Files*")))
  4205. (defun anything-find-files-initial-input (&optional input)
  4206. "Return INPUT if present, otherwise try to guess it."
  4207. (or (and input (or (and (file-remote-p input) input)
  4208. (expand-file-name input)))
  4209. (anything-find-files-input
  4210. (ffap-guesser)
  4211. (thing-at-point 'filename))))
  4212. (defun anything-find-files-input (fap tap)
  4213. "Default input of `anything-find-files'."
  4214. (let* ((def-dir (anything-c-current-directory))
  4215. (lib (anything-find-library-at-point))
  4216. (url (anything-ff-find-url-at-point))
  4217. (remp (and fap (file-remote-p fap)))
  4218. (file-p (and (not remp)
  4219. fap
  4220. (not (string= fap ""))
  4221. (file-exists-p fap)
  4222. tap (not (string= tap ""))
  4223. (file-exists-p
  4224. (file-name-directory (expand-file-name tap def-dir))))))
  4225. (cond (lib) ; e.g we are inside a require sexp.
  4226. (url) ; String at point is an hyperlink.
  4227. (remp fap)
  4228. (file-p (expand-file-name tap def-dir))
  4229. (t (and (not (string= fap "")) fap)))))
  4230. (defun anything-c-current-directory ()
  4231. "Return current-directory name at point.
  4232. Useful in dired buffers when there is inserted subdirs."
  4233. (if (eq major-mode 'dired-mode)
  4234. (dired-current-directory)
  4235. default-directory))
  4236. (defun anything-ff-find-url-at-point ()
  4237. "Try to find link to an url in text-property at point."
  4238. (let* ((he (get-text-property (point) 'help-echo))
  4239. (ov (overlays-at (point)))
  4240. (ov-he (and ov (overlay-get
  4241. (car (overlays-at (point))) 'help-echo)))
  4242. (w3m-l (get-text-property (point) 'w3m-href-anchor))
  4243. (nt-prop (get-text-property (point) 'nt-link)))
  4244. ;; Org link.
  4245. (when (and (stringp he) (string-match "^LINK: " he))
  4246. (setq he (replace-match "" t t he)))
  4247. (loop for i in (list he ov-he w3m-l nt-prop)
  4248. thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
  4249. (defun anything-find-library-at-point ()
  4250. "Try to find library path at point.
  4251. Find inside `require' and `declare-function' sexp."
  4252. (require 'find-func)
  4253. (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
  4254. (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
  4255. (sexp (and beg-sexp end-sexp
  4256. (buffer-substring-no-properties
  4257. (1+ beg-sexp) (1- end-sexp)))))
  4258. (ignore-errors
  4259. (cond ((and sexp (string-match "require \'.+[^)]" sexp))
  4260. (find-library-name
  4261. (replace-regexp-in-string
  4262. "'\\|\)\\|\(" ""
  4263. ;; If require use third arg, ignore it,
  4264. ;; always use library path found in `load-path'.
  4265. (second (split-string (match-string 0 sexp))))))
  4266. ((and sexp (string-match-p "^declare-function" sexp))
  4267. (find-library-name
  4268. (replace-regexp-in-string
  4269. "\"\\|ext:" ""
  4270. (third (split-string sexp)))))
  4271. (t nil)))))
  4272. ;;; Anything completion for `write-file'.==> C-x C-w
  4273. (defvar anything-c-source-write-file
  4274. `((name . "Write File")
  4275. (header-name . (lambda (name)
  4276. (concat name anything-c-find-files-doc-header)))
  4277. ;; It is needed for filenames with capital letters
  4278. (disable-shortcuts)
  4279. (candidates . anything-find-files-get-candidates)
  4280. (filtered-candidate-transformer anything-c-find-files-transformer)
  4281. (persistent-action . anything-find-files-persistent-action)
  4282. (persistent-help . "Expand Candidate")
  4283. (volatile)
  4284. (action .
  4285. (("Write File" . (lambda (candidate)
  4286. (write-file candidate 'confirm)))))))
  4287. ;;; Anything completion for `insert-file'.==> C-x i
  4288. (defvar anything-c-source-insert-file
  4289. `((name . "Insert File")
  4290. (header-name . (lambda (name)
  4291. (concat name anything-c-find-files-doc-header)))
  4292. ;; It is needed for filenames with capital letters
  4293. (disable-shortcuts)
  4294. (candidates . anything-find-files-get-candidates)
  4295. (filtered-candidate-transformer anything-c-find-files-transformer)
  4296. (persistent-action . anything-find-files-persistent-action)
  4297. (persistent-help . "Expand Candidate")
  4298. (volatile)
  4299. (action .
  4300. (("Insert File" . (lambda (candidate)
  4301. (when (y-or-n-p (format "Really insert %s in %s "
  4302. candidate anything-current-buffer))
  4303. (insert-file-contents candidate))))))))
  4304. ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
  4305. (defvar anything-c-source-copy-files
  4306. `((name . "Copy Files")
  4307. (header-name . (lambda (name)
  4308. (concat name anything-c-find-files-doc-header)))
  4309. ;; It is needed for filenames with capital letters
  4310. (disable-shortcuts)
  4311. (candidates . anything-find-files-get-candidates)
  4312. (filtered-candidate-transformer anything-c-find-files-transformer)
  4313. (persistent-action . anything-find-files-persistent-action)
  4314. (persistent-help . "Expand Candidate")
  4315. (volatile)
  4316. (action .
  4317. (("Copy File"
  4318. . (lambda (candidate)
  4319. (anything-dired-action candidate :action 'copy)))
  4320. ("Copy and Follow"
  4321. . (lambda (candidate)
  4322. (anything-dired-action candidate :action 'copy :follow t)))))))
  4323. (defvar anything-c-source-rename-files
  4324. `((name . "Rename Files")
  4325. (header-name . (lambda (name)
  4326. (concat name anything-c-find-files-doc-header)))
  4327. ;; It is needed for filenames with capital letters
  4328. (disable-shortcuts)
  4329. (candidates . anything-find-files-get-candidates)
  4330. (filtered-candidate-transformer anything-c-find-files-transformer)
  4331. (persistent-action . anything-find-files-persistent-action)
  4332. (persistent-help . "Expand Candidate")
  4333. (volatile)
  4334. (action .
  4335. (("Rename File"
  4336. . (lambda (candidate)
  4337. (anything-dired-action candidate :action 'rename)))
  4338. ("Rename and Follow"
  4339. . (lambda (candidate)
  4340. (anything-dired-action candidate :action 'rename :follow t)))))))
  4341. (defvar anything-c-source-symlink-files
  4342. `((name . "Symlink Files")
  4343. (header-name . (lambda (name)
  4344. (concat name anything-c-find-files-doc-header)))
  4345. ;; It is needed for filenames with capital letters
  4346. (disable-shortcuts)
  4347. (candidates . anything-find-files-get-candidates)
  4348. (filtered-candidate-transformer anything-c-find-files-transformer)
  4349. (persistent-action . anything-find-files-persistent-action)
  4350. (persistent-help . "Expand Candidate")
  4351. (volatile)
  4352. (action
  4353. . (("Symlink File"
  4354. . (lambda (candidate)
  4355. (anything-dired-action candidate :action 'symlink)))
  4356. ("RelSymlink File"
  4357. . (lambda (candidate)
  4358. (anything-dired-action candidate :action 'relsymlink)))))))
  4359. (defvar anything-c-source-hardlink-files
  4360. `((name . "Hardlink Files")
  4361. (header-name . (lambda (name)
  4362. (concat name anything-c-find-files-doc-header)))
  4363. ;; It is needed for filenames with capital letters
  4364. (disable-shortcuts)
  4365. (candidates . anything-find-files-get-candidates)
  4366. (filtered-candidate-transformer anything-c-find-files-transformer)
  4367. (persistent-action . anything-find-files-persistent-action)
  4368. (persistent-help . "Expand Candidate")
  4369. (volatile)
  4370. (action
  4371. . (("Hardlink File"
  4372. . (lambda (candidate)
  4373. (anything-dired-action candidate :action 'hardlink)))))))
  4374. (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
  4375. "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
  4376. ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
  4377. (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
  4378. (let ((fn (case action
  4379. ('copy 'dired-copy-file)
  4380. ('rename 'dired-rename-file)
  4381. ('symlink 'make-symbolic-link)
  4382. ('relsymlink 'dired-make-relative-symlink)
  4383. ('hardlink 'dired-hardlink)))
  4384. (marker (case action
  4385. ((copy rename) dired-keep-marker-copy)
  4386. ('symlink dired-keep-marker-symlink)
  4387. ('relsymlink dired-keep-marker-relsymlink)
  4388. ('hardlink dired-keep-marker-hardlink)))
  4389. (dirflag (and (= (length files) 1)
  4390. (file-directory-p (car files))
  4391. (not (file-directory-p candidate)))))
  4392. (dired-create-files
  4393. fn (symbol-name action) files
  4394. ;; CANDIDATE is the destination.
  4395. (if (file-directory-p candidate)
  4396. ;; When CANDIDATE is a directory, build file-name in this directory.
  4397. ;; Else we use CANDIDATE.
  4398. #'(lambda (from)
  4399. (expand-file-name (file-name-nondirectory from) candidate))
  4400. #'(lambda (from) candidate))
  4401. marker)
  4402. (push (file-name-as-directory
  4403. (if (file-directory-p candidate)
  4404. (expand-file-name candidate)
  4405. (file-name-directory candidate)))
  4406. anything-ff-history)
  4407. (when (and follow (not (get-buffer dired-log-buffer)))
  4408. (let ((target (directory-file-name candidate)))
  4409. (unwind-protect
  4410. (progn
  4411. (setq anything-ff-cand-to-mark
  4412. (anything-get-dest-fnames-from-list files candidate dirflag))
  4413. (if (and dirflag (eq action 'rename))
  4414. (anything-find-files-1 (file-name-directory target)
  4415. (if anything-ff-transformer-show-only-basename
  4416. (anything-c-basename target) target))
  4417. (anything-find-files-1 (expand-file-name candidate))))
  4418. (setq anything-ff-cand-to-mark nil))))))
  4419. (defun anything-c-basename (fname &optional ext)
  4420. "Print FNAME with any leading directory components removed.
  4421. If specified, also remove filename extension EXT."
  4422. (if (and ext (or (string= (file-name-extension fname) ext)
  4423. (string= (file-name-extension fname t) ext))
  4424. (not (file-directory-p fname)))
  4425. (file-name-sans-extension (file-name-nondirectory fname))
  4426. (file-name-nondirectory (directory-file-name fname))))
  4427. (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
  4428. "Transform filenames of FLIST to abs of DEST-CAND.
  4429. If RENAME-DIR-FLAG is non--nil collect the `directory-file-name' of transformed
  4430. members of FLIST."
  4431. ;; At this point files have been renamed/copied at destination.
  4432. ;; That's mean DEST-CAND exists.
  4433. (loop
  4434. with dest = (expand-file-name dest-cand)
  4435. for src in flist
  4436. for basename-src = (anything-c-basename src)
  4437. for fname = (cond (rename-dir-flag (directory-file-name dest))
  4438. ((file-directory-p dest)
  4439. (concat (file-name-as-directory dest) basename-src))
  4440. (t dest))
  4441. when (file-exists-p fname)
  4442. collect fname into tmp-list
  4443. finally return (sort tmp-list 'string<)))
  4444. (defun anything-ff-maybe-mark-candidates ()
  4445. "Mark all candidates of list `anything-ff-cand-to-mark'."
  4446. (when (and (string= (assoc-default 'name (anything-get-current-source))
  4447. (assoc-default 'name anything-c-source-find-files))
  4448. anything-ff-cand-to-mark)
  4449. (with-anything-window
  4450. (while anything-ff-cand-to-mark
  4451. (if (string= (car anything-ff-cand-to-mark) (anything-get-selection))
  4452. (progn
  4453. (anything-make-visible-mark)
  4454. (anything-next-line)
  4455. (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
  4456. (anything-next-line)))
  4457. (unless (anything-this-visible-mark)
  4458. (anything-prev-visible-mark)))))
  4459. (add-hook 'anything-after-update-hook #'anything-ff-maybe-mark-candidates)
  4460. (defun* anything-dired-do-action-on-file (&key action)
  4461. (let* ((files (dired-get-marked-files))
  4462. (len (length files))
  4463. (fname (if (> len 1)
  4464. (format "* %d Files" len)
  4465. (car files)))
  4466. (source (case action
  4467. ('copy 'anything-c-source-copy-files)
  4468. ('rename 'anything-c-source-rename-files)
  4469. ('symlink 'anything-c-source-symlink-files)
  4470. ('hardlink 'anything-c-source-hardlink-files)))
  4471. (prompt-fm (case action
  4472. ('copy "Copy %s to: ")
  4473. ('rename "Rename %s to: ")
  4474. ('symlink "Symlink %s to: ")
  4475. ('hardlink "Hardlink %s to: ")))
  4476. (buffer (case action
  4477. ('copy "*Anything Copy Files*")
  4478. ('rename "*Anything Rename Files*")
  4479. ('symlink "*Anything Symlink Files*")
  4480. ('hardlink "*Anything Hardlink Files*")))
  4481. (anything-mp-highlight-delay nil))
  4482. (anything :sources source
  4483. :input (or (dired-dwim-target-directory)
  4484. (expand-file-name (anything-c-current-directory)))
  4485. :preselect (dired-get-filename)
  4486. :prompt (format prompt-fm fname)
  4487. :keymap anything-c-read-file-map
  4488. :buffer buffer)))
  4489. ;;;###autoload
  4490. (define-minor-mode anything-dired-mode ()
  4491. "Enable anything completion in Dired functions.
  4492. Bindings affected are C, R, S, H.
  4493. This is deprecated for Emacs24+ users, use `ac-mode' instead."
  4494. :group 'anything-config
  4495. :global t
  4496. (if anything-dired-mode
  4497. (progn
  4498. (substitute-key-definition
  4499. 'dired-do-copy 'anything-dired-copy-file dired-mode-map)
  4500. (substitute-key-definition
  4501. 'dired-do-rename 'anything-dired-rename-file dired-mode-map)
  4502. (substitute-key-definition
  4503. 'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
  4504. (substitute-key-definition
  4505. 'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
  4506. (substitute-key-definition
  4507. 'anything-dired-copy-file 'dired-do-copy dired-mode-map)
  4508. (substitute-key-definition
  4509. 'anything-dired-rename-file 'dired-do-rename dired-mode-map)
  4510. (substitute-key-definition
  4511. 'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
  4512. (substitute-key-definition
  4513. 'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
  4514. (defalias 'anything-dired-bindings 'anything-dired-mode)
  4515. (defun* anything-c-read-file-name
  4516. (prompt
  4517. &key
  4518. (name "Read File Name")
  4519. (initial-input (expand-file-name default-directory))
  4520. (buffer "*Anything Completions*")
  4521. test
  4522. (preselect nil)
  4523. (history nil)
  4524. must-match
  4525. (marked-candidates nil)
  4526. (alistp t)
  4527. (persistent-action 'anything-find-files-persistent-action)
  4528. (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
  4529. "Read a file name with anything completion.
  4530. It is anything `read-file-name' emulation.
  4531. Argument PROMPT is the default prompt to use.
  4532. Keys description:
  4533. - NAME: Source name, default to \"Read File Name\".
  4534. - INITIAL-INPUT: Where to start read file name, default to `default-directory'.
  4535. - BUFFER: `anything-buffer' name default to \"*Anything Completions*\".
  4536. - TEST: A predicate called with one arg 'candidate'.
  4537. - PRESELECT: anything preselection.
  4538. - HISTORY: Display HISTORY in a special source.
  4539. - MUST-MATCH: Can be 'confirm, nil, or t.
  4540. - MARKED-CANDIDATES: When non--nil return a list of marked candidates.
  4541. - ALISTP: Don't use `all-completions' in history (take effect only on history).
  4542. - PERSISTENT-ACTION: a persistent action function.
  4543. - PERSISTENT-HELP: persistent help message."
  4544. (when (get-buffer anything-action-buffer)
  4545. (kill-buffer anything-action-buffer))
  4546. ;; Assume completion have been already required,
  4547. ;; so always use 'confirm.
  4548. (when (eq must-match 'confirm-after-completion)
  4549. (setq must-match 'confirm))
  4550. (flet ((action-fn (candidate)
  4551. (if marked-candidates
  4552. (anything-marked-candidates)
  4553. (identity candidate))))
  4554. (let* ((anything-mp-highlight-delay nil)
  4555. ;; Be sure we don't erase the underlying minibuffer if some.
  4556. (anything-ff-auto-update-initial-value
  4557. (and anything-ff-auto-update-initial-value
  4558. (not (minibuffer-window-active-p (minibuffer-window)))))
  4559. anything-same-window
  4560. (hist (and history (anything-comp-read-get-candidates
  4561. history nil nil alistp)))
  4562. (minibuffer-completion-confirm must-match)
  4563. (must-match-map (when must-match
  4564. (let ((map (make-sparse-keymap)))
  4565. (define-key map (kbd "RET")
  4566. 'anything-confirm-and-exit-minibuffer)
  4567. map)))
  4568. (anything-map (if must-match-map
  4569. (make-composed-keymap
  4570. must-match-map anything-c-read-file-map)
  4571. anything-c-read-file-map)))
  4572. (or (anything
  4573. :sources
  4574. `(((name . ,(format "%s History" name))
  4575. (header-name . (lambda (name)
  4576. (concat name anything-c-find-files-doc-header)))
  4577. (disable-shortcuts)
  4578. (mode-line . anything-read-file-name-mode-line-string)
  4579. (candidates . hist)
  4580. (persistent-action . ,persistent-action)
  4581. (persistent-help . ,persistent-help)
  4582. (action . ,'action-fn))
  4583. ((name . ,name)
  4584. (header-name . (lambda (name)
  4585. (concat name anything-c-find-files-doc-header)))
  4586. (init . (lambda ()
  4587. (setq anything-ff-auto-update-flag
  4588. anything-ff-auto-update-initial-value)))
  4589. ;; It is needed for filenames with capital letters
  4590. (disable-shortcuts)
  4591. (mode-line . anything-read-file-name-mode-line-string)
  4592. (candidates
  4593. . (lambda ()
  4594. (if test
  4595. (loop with hn = (anything-ff-tramp-hostnames)
  4596. for i in (anything-find-files-get-candidates
  4597. must-match)
  4598. when (or (member i hn) (funcall test i))
  4599. collect i)
  4600. (anything-find-files-get-candidates must-match))))
  4601. (filtered-candidate-transformer anything-c-find-files-transformer)
  4602. (persistent-action . ,persistent-action)
  4603. (candidate-number-limit . 9999)
  4604. (toggle-auto-update . anything-ff-toggle-auto-update)
  4605. (persistent-help . ,persistent-help)
  4606. (volatile)
  4607. (action . ,'action-fn)))
  4608. :input initial-input
  4609. :prompt prompt
  4610. :resume 'noresume
  4611. :buffer buffer
  4612. :preselect preselect)
  4613. (when (and (not (string= anything-pattern ""))
  4614. (eq anything-exit-status 0)
  4615. (eq must-match 'confirm))
  4616. (identity anything-pattern))
  4617. (keyboard-quit)))))
  4618. ;;; File Cache
  4619. (defvar anything-c-file-cache-initialized-p nil)
  4620. (defvar anything-c-file-cache-files nil)
  4621. (defvar anything-c-source-file-cache
  4622. `((name . "File Cache")
  4623. (init
  4624. . (lambda ()
  4625. (require 'filecache nil t)
  4626. (unless anything-c-file-cache-initialized-p
  4627. (setq anything-c-file-cache-files
  4628. (loop for item in file-cache-alist append
  4629. (destructuring-bind (base &rest dirs) item
  4630. (loop for dir in dirs collect
  4631. (concat dir base)))))
  4632. (defadvice file-cache-add-file (after file-cache-list activate)
  4633. (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
  4634. (setq anything-c-file-cache-initialized-p t))))
  4635. (keymap . ,anything-generic-files-map)
  4636. (help-message . anything-generic-file-help-message)
  4637. (mode-line . anything-generic-file-mode-line-string)
  4638. (candidates . anything-c-file-cache-files)
  4639. (match anything-c-match-on-basename)
  4640. (type . file)))
  4641. ;;; Locate
  4642. ;;
  4643. ;;
  4644. ;; NOTE for WINDOZE users:
  4645. ;; You have to install Everything with his command line interface here:
  4646. ;; http://www.voidtools.com/download.php
  4647. (defun anything-ff-find-locatedb (&optional from-ff)
  4648. "Try to find if a local locatedb file is available.
  4649. The search is done in `anything-ff-default-directory' or
  4650. fall back to `default-directory' if FROM-FF is nil."
  4651. (when anything-ff-locate-db-filename
  4652. (cond ((and anything-ff-default-directory
  4653. from-ff
  4654. (file-exists-p (expand-file-name
  4655. anything-ff-locate-db-filename
  4656. anything-ff-default-directory))
  4657. (expand-file-name
  4658. anything-ff-locate-db-filename
  4659. anything-ff-default-directory)))
  4660. ((and (not from-ff)
  4661. (file-exists-p (expand-file-name
  4662. anything-ff-locate-db-filename
  4663. default-directory))
  4664. (expand-file-name
  4665. anything-ff-locate-db-filename
  4666. default-directory))))))
  4667. (defun anything-locate-1 (&optional localdb init from-ff)
  4668. "Generic function to run Locate.
  4669. if LOCALDB is non--nil search and use a local locate db file.
  4670. INIT is a string to use as initial input in prompt.
  4671. See `anything-locate-with-db' and `anything-locate'."
  4672. (anything-locate-with-db
  4673. (and localdb
  4674. (or (anything-ff-find-locatedb from-ff)
  4675. (anything-c-read-file-name
  4676. "LocateDBFiles: "
  4677. :initial-input (or anything-ff-default-directory
  4678. default-directory)
  4679. :marked-candidates t
  4680. :preselect anything-locate-db-file-regexp
  4681. :test #'(lambda (x)
  4682. (if anything-locate-db-file-regexp
  4683. ;; Select only locate db files and directories
  4684. ;; to allow navigation.
  4685. (or (string-match
  4686. anything-locate-db-file-regexp x)
  4687. (file-directory-p x))
  4688. x)))))
  4689. init))
  4690. ;; (anything-locate-1 t)
  4691. (defun anything-locate-with-db (&optional db initial-input)
  4692. "Run locate -d DB.
  4693. If DB is not given or nil use locate without -d option.
  4694. Argument DB can be given as a string or list of db files.
  4695. Argument INITIAL-INPUT is a string to use as initial-input.
  4696. See also `anything-locate'."
  4697. (when (and db (stringp db)) (setq db (list db)))
  4698. (unless anything-c-locate-command
  4699. (setq anything-c-locate-command
  4700. (case system-type
  4701. ('gnu/linux "locate -i -r %s")
  4702. ('berkeley-unix "locate -i %s")
  4703. ('windows-nt "es -i -r %s")
  4704. (t "locate %s"))))
  4705. (let ((anything-c-locate-command
  4706. (if db
  4707. (replace-regexp-in-string
  4708. "locate"
  4709. (format "locate -d %s"
  4710. (mapconcat 'identity
  4711. ;; Remove eventually
  4712. ;; marked directories by error.
  4713. (loop for i in db
  4714. unless (file-directory-p i)
  4715. collect i) ":"))
  4716. anything-c-locate-command)
  4717. anything-c-locate-command)))
  4718. (anything :sources 'anything-c-source-locate
  4719. :buffer "*anything locate*"
  4720. :input initial-input
  4721. :keymap anything-generic-files-map)))
  4722. ;; (anything-locate-with-db "~/locate.db")
  4723. (defun anything-c-locate-init ()
  4724. "Initialize async locate process for `anything-c-source-locate'."
  4725. (setq mode-line-format
  4726. '(" " mode-line-buffer-identification " "
  4727. (line-number-mode "%l") " "
  4728. (:eval (propertize "(Locate Process Running) "
  4729. 'face '((:foreground "red"))))))
  4730. (prog1
  4731. (start-process-shell-command "locate-process" nil
  4732. (format anything-c-locate-command
  4733. anything-pattern))
  4734. (set-process-sentinel (get-process "locate-process")
  4735. #'(lambda (process event)
  4736. (when (string= event "finished\n")
  4737. (with-anything-window
  4738. (force-mode-line-update nil)
  4739. (anything-update-move-first-line)))))))
  4740. (defvar anything-c-source-locate
  4741. `((name . "Locate")
  4742. (candidates . anything-c-locate-init)
  4743. (type . file)
  4744. (requires-pattern . 3)
  4745. (keymap . ,anything-generic-files-map)
  4746. (help-message . anything-generic-file-help-message)
  4747. (candidate-number-limit . 9999)
  4748. (mode-line . anything-generic-file-mode-line-string)
  4749. (delayed))
  4750. "Find files matching the current input pattern with locate.")
  4751. (defun anything-c-locate-read-file-name (prompt &optional init)
  4752. "Search a file with locate and return it's filename.
  4753. Use argument PROMPT and INIT for `anything' arguments
  4754. prompt and input."
  4755. (anything :sources
  4756. '((name . "Locate")
  4757. (candidates . anything-c-locate-init)
  4758. (action . identity)
  4759. (requires-pattern . 3)
  4760. (candidate-number-limit . 9999)
  4761. (mode-line . anything-generic-file-mode-line-string)
  4762. (delayed))
  4763. :prompt prompt
  4764. :input init
  4765. :buffer "*anything locate rfn*"))
  4766. ;;; Anything Incremental Grep.
  4767. ;;
  4768. ;;
  4769. ;; Allow to grep incrementally with anything interface.
  4770. ;; It allow also to Grep files recursively without using 'find' shell command.
  4771. ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
  4772. (defvar anything-c-grep-default-command
  4773. "grep -d skip %e -niH -e %p %f"
  4774. "Default grep format command for `anything-do-grep-1'.
  4775. Where:
  4776. '%e' format spec is for --exclude or --include grep options.
  4777. '%p' format spec is for pattern.
  4778. '%f' format spec is for filenames.")
  4779. (defvar anything-c-grep-default-recurse-command
  4780. "grep -d recurse %e -niH -e %p %f"
  4781. "Default recursive grep format command for `anything-do-grep-1'.
  4782. See `anything-c-grep-default-command' for format specs.")
  4783. (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
  4784. (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
  4785. (defvar anything-c-grep-default-function 'anything-c-grep-init)
  4786. (defvar anything-c-grep-debug-command-line nil
  4787. "Turn on anything grep command-line debugging when non--nil.")
  4788. (defvar anything-c-zgrep-recurse-flag nil)
  4789. (defvar anything-c-grep-history nil)
  4790. (defvar anything-c-grep-max-length-history 100
  4791. "*Max number of elements to save in `anything-c-grep-history'.")
  4792. (defun anything-c-grep-prepare-candidates (candidates)
  4793. "Prepare filenames and directories CANDIDATES for grep command line."
  4794. ;; If one or more candidate is a directory, search in all files
  4795. ;; of this candidate (e.g /home/user/directory/*).
  4796. ;; If r option is enabled search also in subdidrectories.
  4797. ;; We need here to expand wildcards to support crap windows filenames
  4798. ;; as grep doesn't accept quoted wildcards (e.g "dir/*.el").
  4799. (if anything-c-zgrep-recurse-flag
  4800. (mapconcat 'shell-quote-argument candidates " ")
  4801. (loop for i in candidates append
  4802. (cond ( ;; Candidate is a directory and we use recursion.
  4803. (and (file-directory-p i)
  4804. (anything-c-grep-recurse-p))
  4805. (list (expand-file-name i)))
  4806. ;; Candidate is a directory, search in all files.
  4807. ((file-directory-p i)
  4808. (file-expand-wildcards
  4809. (concat (file-name-as-directory (expand-file-name i)) "*") t))
  4810. ;; Candidate is a file or wildcard and we use recursion, use the
  4811. ;; current directory instead of candidate.
  4812. ((and (or (file-exists-p i) (string-match "\*" i))
  4813. (anything-c-grep-recurse-p))
  4814. (list (expand-file-name
  4815. (directory-file-name ; Needed for windoze.
  4816. (file-name-directory (directory-file-name i))))))
  4817. ;; Candidate use wildcard.
  4818. ((string-match "^\*" (anything-c-basename i))
  4819. (file-expand-wildcards i t))
  4820. ;; Else should be one or more file.
  4821. (t (list i))) into all-files
  4822. finally return
  4823. (mapconcat 'shell-quote-argument all-files " "))))
  4824. (defun anything-c-grep-recurse-p ()
  4825. "Check if `anything-do-grep-1' have switched to recursive."
  4826. (let ((args (replace-regexp-in-string
  4827. "grep" "" anything-c-grep-default-command)))
  4828. (string-match-p "r\\|recurse" args)))
  4829. (defun anything-c-grep-init (only-files &optional include zgrep)
  4830. "Start an asynchronous grep process in ONLY-FILES list."
  4831. (let* ((fnargs (anything-c-grep-prepare-candidates
  4832. (if (file-remote-p anything-ff-default-directory)
  4833. (mapcar #'(lambda (x)
  4834. (file-remote-p x 'localname))
  4835. only-files)
  4836. only-files)))
  4837. (ignored-files (mapconcat
  4838. #'(lambda (x)
  4839. (concat "--exclude=" (shell-quote-argument x)))
  4840. grep-find-ignored-files " "))
  4841. (ignored-dirs (mapconcat
  4842. ;; Need grep version >=2.5.4 of Gnuwin32 on windoze.
  4843. #'(lambda (x)
  4844. (concat "--exclude-dir=" (shell-quote-argument x)))
  4845. grep-find-ignored-directories " "))
  4846. (exclude (if (anything-c-grep-recurse-p)
  4847. (concat (or include ignored-files) " " ignored-dirs)
  4848. ignored-files))
  4849. (cmd-line (format-spec
  4850. anything-c-grep-default-command
  4851. (delq nil
  4852. (list (unless zgrep (cons ?e exclude))
  4853. (cons ?p (shell-quote-argument anything-pattern))
  4854. (cons ?f fnargs))))))
  4855. (when anything-c-grep-debug-command-line
  4856. (with-current-buffer (get-buffer-create "*any grep debug*")
  4857. (goto-char (point-max))
  4858. (insert (concat ">>> " cmd-line "\n\n"))))
  4859. (setq mode-line-format
  4860. '(" " mode-line-buffer-identification " "
  4861. (line-number-mode "%l") " "
  4862. (:eval (when (get-process "grep-process")
  4863. (propertize "[Grep Process Running] "
  4864. 'face 'anything-grep-running)))))
  4865. (force-mode-line-update nil)
  4866. (prog1
  4867. (let ((default-directory anything-ff-default-directory))
  4868. (start-file-process-shell-command "grep-process" nil cmd-line))
  4869. (message nil)
  4870. (set-process-sentinel
  4871. (get-process "grep-process")
  4872. #'(lambda (process event)
  4873. (when (string= event "finished\n")
  4874. (with-anything-window
  4875. (anything-update-move-first-line)
  4876. (setq mode-line-format
  4877. '(" " mode-line-buffer-identification " "
  4878. (line-number-mode "%l") " "
  4879. (:eval (propertize
  4880. (format "[Grep Process Finished - (%s results)] "
  4881. (let ((nlines (1- (count-lines
  4882. (point-min)
  4883. (point-max)))))
  4884. (if (> nlines 0) nlines 0)))
  4885. 'face 'anything-grep-finish))))
  4886. (force-mode-line-update nil))))))))
  4887. (defun anything-c-grep-action (candidate &optional where mark)
  4888. "Define a default action for `anything-do-grep' on CANDIDATE.
  4889. WHERE can be one of other-window, elscreen, other-frame."
  4890. (let* ((split (anything-c-grep-split-line candidate))
  4891. (lineno (string-to-number (nth 1 split)))
  4892. (loc-fname (car split))
  4893. (tramp-method (file-remote-p anything-ff-default-directory 'method))
  4894. (tramp-host (file-remote-p anything-ff-default-directory 'host))
  4895. (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
  4896. (fname (if tramp-host
  4897. (concat tramp-prefix loc-fname) loc-fname)))
  4898. (case where
  4899. (other-window (find-file-other-window fname))
  4900. (elscreen (anything-elscreen-find-file fname))
  4901. (other-frame (find-file-other-frame fname))
  4902. (grep (anything-c-grep-save-results-1))
  4903. (t (find-file fname)))
  4904. (unless (eq where 'grep)
  4905. (anything-goto-line lineno))
  4906. (when mark
  4907. (set-marker (mark-marker) (point))
  4908. (push-mark (point) 'nomsg))
  4909. ;; Save history
  4910. (unless (or anything-in-persistent-action
  4911. (string= anything-pattern ""))
  4912. (setq anything-c-grep-history
  4913. (cons anything-pattern
  4914. (delete anything-pattern anything-c-grep-history)))
  4915. (when (> (length anything-c-grep-history)
  4916. anything-c-grep-max-length-history)
  4917. (setq anything-c-grep-history
  4918. (delete (car (last anything-c-grep-history))
  4919. anything-c-grep-history))))))
  4920. (defun anything-c-grep-other-window (candidate)
  4921. "Jump to result in other window from anything grep."
  4922. (anything-c-grep-action candidate 'other-window))
  4923. (defun anything-c-grep-other-frame (candidate)
  4924. "Jump to result in other frame from anything grep."
  4925. (anything-c-grep-action candidate 'other-frame))
  4926. (defun anything-c-grep-jump-elscreen (candidate)
  4927. "Jump to result in elscreen from anything grep."
  4928. (anything-c-grep-action candidate 'elscreen))
  4929. (defun anything-c-grep-save-results (_candidate)
  4930. (anything-c-grep-action _candidate 'grep))
  4931. (defun anything-c-grep-save-results-1 ()
  4932. "Save anything grep result in a `grep-mode' buffer."
  4933. (let ((buf "*grep*")
  4934. new-buf)
  4935. (when (get-buffer buf)
  4936. (setq new-buf (read-string "GrepBufferName: " buf))
  4937. (loop for b in (anything-c-buffer-list)
  4938. when (and (string= new-buf b)
  4939. (not (y-or-n-p
  4940. (format "Buffer `%s' already exists overwrite? "
  4941. new-buf))))
  4942. do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
  4943. (setq buf new-buf))
  4944. (with-current-buffer (get-buffer-create buf)
  4945. (let ((inhibit-read-only t))
  4946. (erase-buffer)
  4947. (insert "-*- mode: grep -*-\n\n"
  4948. (format "Grep Results for `%s':\n\n" anything-pattern))
  4949. (save-excursion
  4950. (insert (with-current-buffer anything-buffer
  4951. (goto-char (point-min)) (forward-line 1)
  4952. (buffer-substring (point) (point-max))))
  4953. (grep-mode))))
  4954. (message "Anything Grep Results saved in `%s' buffer" buf)))
  4955. (defun anything-c-grep-persistent-action (candidate)
  4956. "Persistent action for `anything-do-grep'.
  4957. With a prefix arg record CANDIDATE in `mark-ring'."
  4958. (if current-prefix-arg
  4959. (anything-c-grep-action candidate nil 'mark)
  4960. (anything-c-grep-action candidate))
  4961. (anything-match-line-color-current-line))
  4962. (defun anything-c-grep-guess-extensions (files)
  4963. "Try to guess file extensions in FILES list when using grep recurse.
  4964. These extensions will be added to command line with --include arg of grep."
  4965. (loop
  4966. with glob-list = nil
  4967. with lst = (if (file-directory-p (car files))
  4968. (directory-files
  4969. (car files) nil
  4970. directory-files-no-dot-files-regexp)
  4971. files)
  4972. for i in lst
  4973. for ext = (file-name-extension i t)
  4974. for glob = (and ext (not (string= ext ""))
  4975. (concat "*" ext))
  4976. unless (or (not glob)
  4977. (member glob glob-list)
  4978. (member glob grep-find-ignored-files))
  4979. collect glob into glob-list
  4980. finally return glob-list))
  4981. (defun anything-do-grep-1 (only &optional recurse zgrep)
  4982. "Launch grep with a list of ONLY files.
  4983. When RECURSE is given use -r option of grep and prompt user
  4984. to set the --include args of grep.
  4985. You can give more than one arg separated by space.
  4986. e.g *.el *.py *.tex.
  4987. If it's empty --exclude `grep-find-ignored-files' is used instead."
  4988. (let* ((anything-compile-source-functions
  4989. ;; rule out anything-match-plugin because the input is one regexp.
  4990. (delq 'anything-compile-source--match-plugin
  4991. (copy-sequence anything-compile-source-functions)))
  4992. (exts (anything-c-grep-guess-extensions only))
  4993. (globs (and (not zgrep) (mapconcat 'identity exts " ")))
  4994. (include-files (and recurse (not zgrep)
  4995. (read-string "OnlyExt(*.[ext]): "
  4996. globs)))
  4997. ;; Set `minibuffer-history' AFTER includes-files
  4998. ;; to avoid storing wild-cards here.
  4999. (minibuffer-history anything-c-grep-history)
  5000. (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
  5001. (recurse anything-c-grep-default-recurse-command)
  5002. (zgrep anything-c-default-zgrep-command)
  5003. (t anything-c-grep-default-command)))
  5004. ;; Disable match-plugin and use here own highlighting.
  5005. (anything-mp-highlight-delay nil))
  5006. (when include-files
  5007. (setq include-files
  5008. (and (not (string= include-files ""))
  5009. (mapconcat #'(lambda (x)
  5010. (concat "--include=" (shell-quote-argument x)))
  5011. (split-string include-files) " "))))
  5012. ;; When called as action from an other source e.g *-find-files
  5013. ;; we have to kill action buffer.
  5014. (when (get-buffer anything-action-buffer)
  5015. (kill-buffer anything-action-buffer))
  5016. ;; `anything-find-files' haven't already started,
  5017. ;; give a default value to `anything-ff-default-directory'.
  5018. (setq anything-ff-default-directory (or anything-ff-default-directory
  5019. default-directory))
  5020. (anything
  5021. :sources
  5022. `(((name . "Grep")
  5023. (header-name . (lambda (name)
  5024. (concat name "(C-c ? Help)")))
  5025. (candidates
  5026. . (lambda ()
  5027. (funcall anything-c-grep-default-function only include-files zgrep)))
  5028. (filtered-candidate-transformer anything-c-grep-cand-transformer)
  5029. (candidate-number-limit . 9999)
  5030. (mode-line . anything-grep-mode-line-string)
  5031. (keymap . ,anything-c-grep-map)
  5032. (action . ,(delq
  5033. nil
  5034. `(("Find File" . anything-c-grep-action)
  5035. ("Find file other frame" . anything-c-grep-other-frame)
  5036. ,(and (locate-library "elscreen")
  5037. '("Find file in Elscreen"
  5038. . anything-c-grep-jump-elscreen))
  5039. ("Save results in grep buffer" . anything-c-grep-save-results)
  5040. ("Find file other window" . anything-c-grep-other-window))))
  5041. (persistent-action . anything-c-grep-persistent-action)
  5042. (persistent-help . "Jump to line (`C-u' Record in mark ring)")
  5043. (requires-pattern . 3)
  5044. (delayed)))
  5045. :buffer "*anything grep*")))
  5046. (defun anything-ff-zgrep-1 (flist recursive)
  5047. (unwind-protect
  5048. (let* ((def-dir (or anything-ff-default-directory
  5049. default-directory))
  5050. (only (if recursive
  5051. (or (gethash def-dir anything-c-rzgrep-cache)
  5052. (puthash
  5053. def-dir
  5054. (anything-c-walk-directory
  5055. def-dir
  5056. :directories nil
  5057. :path 'full
  5058. :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
  5059. anything-c-rzgrep-cache))
  5060. flist)))
  5061. (when recursive (setq anything-c-zgrep-recurse-flag t))
  5062. (anything-do-grep-1 only recursive 'zgrep))
  5063. (setq anything-c-zgrep-recurse-flag nil)))
  5064. (defun anything-c-grep-split-line (line)
  5065. "Split a grep output line."
  5066. (let (beg fname lineno str)
  5067. ;; Don't print until grep line is valid.
  5068. (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
  5069. (with-temp-buffer
  5070. (insert line)
  5071. (goto-char (point-min))
  5072. (setq beg (point))
  5073. (forward-char 2)
  5074. (re-search-forward ":" nil t)
  5075. (setq fname (buffer-substring-no-properties beg (1- (point))))
  5076. (setq beg (point))
  5077. (re-search-forward ":" nil t)
  5078. (setq lineno (buffer-substring-no-properties beg (1- (point))))
  5079. (setq str (buffer-substring-no-properties (point) (point-at-eol))))
  5080. (list fname lineno str))))
  5081. (defun anything-c-grep-cand-transformer (candidates sources)
  5082. "Filtered candidate transformer function for `anything-do-grep'."
  5083. (loop for i in candidates
  5084. for split = (and i (anything-c-grep-split-line i))
  5085. for fname = (car split)
  5086. for lineno = (nth 1 split)
  5087. for str = (nth 2 split)
  5088. when (and fname lineno str)
  5089. collect
  5090. (cons (concat (propertize (file-name-nondirectory fname)
  5091. 'face 'anything-grep-file
  5092. 'help-echo fname) ":"
  5093. (propertize lineno 'face 'anything-grep-lineno) ":"
  5094. (anything-c-grep-highlight-match str))
  5095. i)))
  5096. (defun anything-c-grep-highlight-match (str)
  5097. "Highlight in string STR all occurences matching `anything-pattern'."
  5098. (condition-case nil
  5099. (with-temp-buffer
  5100. (insert str)
  5101. (goto-char (point-min))
  5102. (while (and (re-search-forward anything-pattern nil t)
  5103. (> (- (match-end 0) (match-beginning 0)) 0))
  5104. (add-text-properties
  5105. (match-beginning 0) (match-end 0)
  5106. '(face anything-grep-match)))
  5107. (buffer-string))
  5108. (error nil)))
  5109. ;; Go to next or precedent file (common to etags and grep).
  5110. (defun anything-c-goto-next-or-prec-file (n)
  5111. "Go to next or precedent candidate file in anything grep/etags buffers.
  5112. If N is positive go forward otherwise go backward."
  5113. (with-anything-window
  5114. (let* ((current-line-list (split-string
  5115. (buffer-substring
  5116. (point-at-bol)
  5117. (point-at-eol)) ":"))
  5118. (current-fname (nth 0 current-line-list))
  5119. (fn-b-o-f (if (eq n 1) 'eobp 'bobp)))
  5120. (catch 'break
  5121. (while (not (funcall fn-b-o-f))
  5122. (forward-line n) ; Go forward or backward depending of n value.
  5123. (unless (search-forward current-fname (point-at-eol) t)
  5124. (anything-mark-current-line)
  5125. (throw 'break nil))))
  5126. (cond ((and (eq n 1) (eobp))
  5127. (re-search-backward ".")
  5128. (forward-line 0)
  5129. (anything-mark-current-line))
  5130. ((and (< n 1) (bobp))
  5131. (forward-line 1)
  5132. (anything-mark-current-line))))))
  5133. ;;;###autoload
  5134. (defun anything-c-goto-precedent-file ()
  5135. "Go to precedent file in anything grep/etags buffers."
  5136. (interactive)
  5137. (anything-c-goto-next-or-prec-file -1))
  5138. ;;;###autoload
  5139. (defun anything-c-goto-next-file ()
  5140. "Go to precedent file in anything grep/etags buffers."
  5141. (interactive)
  5142. (anything-c-goto-next-or-prec-file 1))
  5143. ;;;###autoload
  5144. (defun anything-c-grep-run-persistent-action ()
  5145. "Run grep persistent action from `anything-do-grep-1'."
  5146. (interactive)
  5147. (anything-attrset 'jump-persistent 'anything-c-grep-persistent-action)
  5148. (anything-execute-persistent-action 'jump-persistent))
  5149. ;;;###autoload
  5150. (defun anything-c-grep-run-default-action ()
  5151. "Run grep default action from `anything-do-grep-1'."
  5152. (interactive)
  5153. (anything-c-quit-and-execute-action 'anything-c-grep-action))
  5154. ;;;###autoload
  5155. (defun anything-c-grep-run-other-window-action ()
  5156. "Run grep goto other window action from `anything-do-grep-1'."
  5157. (interactive)
  5158. (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
  5159. ;;;###autoload
  5160. (defun anything-c-grep-run-save-buffer ()
  5161. "Run grep save results action from `anything-do-grep-1'."
  5162. (interactive)
  5163. (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
  5164. ;; Grep buffers
  5165. (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
  5166. "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
  5167. If one of selected buffers is not a file--buffer,
  5168. it is ignored and grep will run on all others file--buffers.
  5169. If only one candidate is selected and it is not a file--buffer,
  5170. switch to this buffer and run `anything-occur'.
  5171. If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
  5172. (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
  5173. (cands (if prefarg
  5174. (buffer-list)
  5175. (anything-marked-candidates)))
  5176. (win-conf (current-window-configuration))
  5177. ;; Non--fname buffers are ignored.
  5178. (bufs (loop for buf in cands
  5179. for fname = (buffer-file-name (get-buffer buf))
  5180. when fname
  5181. collect (expand-file-name fname))))
  5182. (if bufs
  5183. (if zgrep
  5184. (anything-do-grep-1 bufs nil 'zgrep)
  5185. (anything-do-grep-1 bufs))
  5186. ;; bufs is empty, thats mean we have only CANDIDATE
  5187. ;; and it is not a buffer-filename, fallback to occur.
  5188. (anything-c-switch-to-buffer candidate)
  5189. (when (get-buffer anything-action-buffer)
  5190. (kill-buffer anything-action-buffer))
  5191. (anything-occur)
  5192. (when (eq anything-exit-status 1)
  5193. (set-window-configuration win-conf)))))
  5194. (defun anything-c-grep-buffers (candidate)
  5195. "Action to grep buffers."
  5196. (anything-c-grep-buffers-1 candidate))
  5197. (defun anything-c-zgrep-buffers (candidate)
  5198. "Action to zgrep buffers."
  5199. (anything-c-grep-buffers-1 candidate 'zgrep))
  5200. ;;; Anything interface for pdfgrep
  5201. ;; pdfgrep program <http://pdfgrep.sourceforge.net/>
  5202. ;; and a pdf-reader (e.g xpdf) are needed.
  5203. ;;
  5204. (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
  5205. (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
  5206. (defvar anything-c-pdfgrep-debug-command-line nil)
  5207. (defun anything-c-pdfgrep-init (only-files)
  5208. "Start an asynchronous pdfgrep process in ONLY-FILES list."
  5209. (let* ((fnargs (anything-c-grep-prepare-candidates
  5210. (if (file-remote-p anything-ff-default-directory)
  5211. (mapcar #'(lambda (x)
  5212. (file-remote-p x 'localname))
  5213. only-files)
  5214. only-files)))
  5215. (cmd-line (format anything-c-pdfgrep-default-command
  5216. anything-pattern
  5217. fnargs)))
  5218. (when anything-c-pdfgrep-debug-command-line
  5219. (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
  5220. (goto-char (point-max))
  5221. (insert (concat ">>> " cmd-line "\n\n"))))
  5222. (setq mode-line-format
  5223. '(" " mode-line-buffer-identification " "
  5224. (line-number-mode "%l") " "
  5225. (:eval (propertize "(Pdfgrep Process Running) "
  5226. 'face '((:foreground "red"))))))
  5227. (prog1
  5228. (let ((default-directory anything-ff-default-directory))
  5229. (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
  5230. (message nil)
  5231. (set-process-sentinel
  5232. (get-process "pdfgrep-process")
  5233. #'(lambda (process event)
  5234. (when (string= event "finished\n")
  5235. (with-anything-window
  5236. (anything-update-move-first-line))
  5237. (force-mode-line-update nil)))))))
  5238. (defun anything-do-pdfgrep-1 (only)
  5239. "Launch pdfgrep with a list of ONLY files."
  5240. (unless (executable-find "pdfgrep")
  5241. (error "Error: No such program `pdfgrep'."))
  5242. (let* ((anything-compile-source-functions
  5243. ;; rule out anything-match-plugin because the input is one regexp.
  5244. (delq 'anything-compile-source--match-plugin
  5245. (copy-sequence anything-compile-source-functions)))
  5246. ;; Disable match-plugin and use here own highlighting.
  5247. (anything-mp-highlight-delay nil))
  5248. ;; When called as action from an other source e.g *-find-files
  5249. ;; we have to kill action buffer.
  5250. (when (get-buffer anything-action-buffer)
  5251. (kill-buffer anything-action-buffer))
  5252. ;; If `anything-find-files' haven't already started,
  5253. ;; give a default value to `anything-ff-default-directory'.
  5254. (setq anything-ff-default-directory (or anything-ff-default-directory
  5255. default-directory))
  5256. (anything
  5257. :sources
  5258. `(((name . "PdfGrep")
  5259. (candidates
  5260. . (lambda ()
  5261. (funcall anything-c-pdfgrep-default-function only)))
  5262. (filtered-candidate-transformer anything-c-grep-cand-transformer)
  5263. (candidate-number-limit . 9999)
  5264. (mode-line . anything-pdfgrep-mode-line-string)
  5265. (action . anything-c-pdfgrep-action)
  5266. (persistent-help . "Jump to PDF Page")
  5267. (requires-pattern . 3)
  5268. (delayed)))
  5269. :keymap anything-c-pdfgrep-map
  5270. :buffer "*anything grep*")))
  5271. (defun anything-c-pdfgrep-action (candidate)
  5272. (let* ((split (anything-c-grep-split-line candidate))
  5273. (pageno (nth 1 split))
  5274. (fname (car split)))
  5275. (start-file-process-shell-command
  5276. "pdf-reader" nil
  5277. (format-spec anything-c-pdfgrep-default-read-command
  5278. (list (cons ?f fname) (cons ?p pageno))))))
  5279. ;; Yank text at point.
  5280. ;;
  5281. ;;
  5282. ;; Internal
  5283. (defvar anything-yank-point nil)
  5284. ;;;###autoload
  5285. (defun anything-yank-text-at-point ()
  5286. "Yank text at point in minibuffer."
  5287. (interactive)
  5288. (let (input)
  5289. (flet ((insert-in-minibuffer (word)
  5290. (with-selected-window (minibuffer-window)
  5291. (let ((str anything-pattern))
  5292. (delete-minibuffer-contents)
  5293. (set-text-properties 0 (length word) nil word)
  5294. (insert (concat str word))))))
  5295. (with-anything-current-buffer
  5296. ;; Start to initial point if C-w have never been hit.
  5297. (unless anything-yank-point (setq anything-yank-point (point)))
  5298. (and anything-yank-point (goto-char anything-yank-point))
  5299. (forward-word 1)
  5300. (setq input (buffer-substring-no-properties anything-yank-point (point)))
  5301. (setq anything-yank-point (point))) ; End of last forward-word
  5302. (insert-in-minibuffer input))))
  5303. (defun anything-reset-yank-point ()
  5304. (setq anything-yank-point nil))
  5305. (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
  5306. (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
  5307. ;;; Recentf files
  5308. ;;
  5309. ;;
  5310. (defvar anything-c-source-recentf
  5311. `((name . "Recentf")
  5312. (init . (lambda ()
  5313. (require 'recentf)
  5314. (or recentf-mode (recentf-mode 1))))
  5315. ;; Needed for filenames with capitals letters.
  5316. (disable-shortcuts)
  5317. (candidates . recentf-list)
  5318. (keymap . ,anything-generic-files-map)
  5319. (help-message . anything-generic-file-help-message)
  5320. (mode-line . anything-generic-file-mode-line-string)
  5321. (match anything-c-match-on-basename)
  5322. (type . file))
  5323. "See (info \"(emacs)File Conveniences\").
  5324. Set `recentf-max-saved-items' to a bigger value if default is too small.")
  5325. ;;; ffap
  5326. (eval-when-compile (require 'ffap))
  5327. (defvar anything-c-source-ffap-guesser
  5328. `((name . "File at point")
  5329. (init . (lambda () (require 'ffap)))
  5330. (candidates . (lambda ()
  5331. (anything-aif
  5332. (with-anything-current-buffer
  5333. (ffap-guesser))
  5334. (list it))))
  5335. (keymap . ,anything-generic-files-map)
  5336. (help-message . anything-generic-file-help-message)
  5337. (mode-line . anything-generic-file-mode-line-string)
  5338. (type . file)))
  5339. ;;; ffap with line number
  5340. (defun anything-c-ffap-file-line-at-point ()
  5341. "Get (FILENAME . LINENO) at point."
  5342. (anything-aif (let (ffap-alist) (ffap-file-at-point))
  5343. (save-excursion
  5344. (beginning-of-line)
  5345. (when (and (search-forward it nil t)
  5346. (looking-at ":\\([0-9]+\\)"))
  5347. (cons it (string-to-number (match-string 1)))))))
  5348. (defun anything-c-ffap-line-candidates ()
  5349. (with-anything-current-buffer
  5350. (anything-attrset 'ffap-line-location (anything-c-ffap-file-line-at-point)))
  5351. (anything-aif (anything-attr 'ffap-line-location)
  5352. (destructuring-bind (file . line) it
  5353. (list (cons (format "%s (line %d)" file line) file)))))
  5354. ;;; Goto line after opening file by `anything-c-source-ffap-line'.
  5355. (defun anything-c-ffap-line-goto-line ()
  5356. (when (car (anything-attr 'ffap-line-location))
  5357. (unwind-protect
  5358. (ignore-errors
  5359. (with-selected-window
  5360. (get-buffer-window
  5361. (get-file-buffer (car (anything-attr 'ffap-line-location))))
  5362. (anything-goto-line (cdr (anything-attr 'ffap-line-location)))))
  5363. (anything-attrset 'ffap-line-location nil))))
  5364. (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
  5365. (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
  5366. (defvar anything-c-source-ffap-line
  5367. `((name . "File/Lineno at point")
  5368. (init . (lambda () (require 'ffap)))
  5369. (candidates . anything-c-ffap-line-candidates)
  5370. (keymap . ,anything-map)
  5371. (type . file)))
  5372. ;;; list of files gleaned from every dired buffer
  5373. (defun anything-c-files-in-all-dired-candidates ()
  5374. (save-excursion
  5375. (mapcan
  5376. (lambda (dir)
  5377. (cond ((listp dir) ;filelist
  5378. dir)
  5379. ((equal "" (file-name-nondirectory dir)) ;dir
  5380. (directory-files dir t))
  5381. (t ;wildcard
  5382. (file-expand-wildcards dir t))))
  5383. (delq nil
  5384. (mapcar (lambda (buf)
  5385. (set-buffer buf)
  5386. (when (eq major-mode 'dired-mode)
  5387. (if (consp dired-directory)
  5388. (cdr dired-directory) ;filelist
  5389. dired-directory))) ;dir or wildcard
  5390. (buffer-list))))))
  5391. ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
  5392. (defvar anything-c-source-files-in-all-dired
  5393. '((name . "Files in all dired buffer.")
  5394. (candidates . anything-c-files-in-all-dired-candidates)
  5395. (type . file)))
  5396. (defvar anything-c-source-filelist
  5397. '((name . "FileList")
  5398. (grep-candidates . anything-c-filelist-file-name)
  5399. (candidate-number-limit . 200)
  5400. (requires-pattern . 4)
  5401. (type . file))
  5402. "Source to find files instantly.
  5403. See `anything-c-filelist-file-name' docstring for usage.")
  5404. ;;;; <info>
  5405. ;;; Info pages
  5406. (defvar anything-c-info-pages nil
  5407. "All info pages on system.
  5408. Will be calculated the first time you invoke anything with this
  5409. source.")
  5410. (defun anything-c-info-pages-init ()
  5411. "Collect candidates for initial Info node Top."
  5412. (if anything-c-info-pages
  5413. anything-c-info-pages
  5414. (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
  5415. topics)
  5416. (require 'info)
  5417. (with-temp-buffer
  5418. (Info-find-node "dir" "top")
  5419. (goto-char (point-min))
  5420. (while (re-search-forward info-topic-regexp nil t)
  5421. (push (match-string-no-properties 1) topics))
  5422. (kill-buffer))
  5423. (setq anything-c-info-pages topics))))
  5424. (defvar anything-c-source-info-pages
  5425. `((name . "Info Pages")
  5426. (init . anything-c-info-pages-init)
  5427. (candidates . anything-c-info-pages)
  5428. (action . (("Show with Info" .(lambda (node-str)
  5429. (info (replace-regexp-in-string
  5430. "^[^:]+: " "" node-str))))))
  5431. (requires-pattern . 2)))
  5432. ;;; Man and woman UI
  5433. ;;
  5434. ;;
  5435. (defvar anything-c-man-pages nil
  5436. "All man pages on system.
  5437. Will be calculated the first time you invoke anything with this
  5438. source.")
  5439. (defun anything-c-man-default-action (candidate)
  5440. "Default action for jumping to a woman or man page from anything."
  5441. (let ((wfiles (woman-file-name-all-completions candidate)))
  5442. (condition-case err
  5443. (if (> (length wfiles) 1)
  5444. (woman-find-file
  5445. (anything-comp-read
  5446. "ManFile: " wfiles :must-match t))
  5447. (woman candidate))
  5448. ;; If woman is unable to format correctly
  5449. ;; use man instead.
  5450. (error (kill-buffer) ; Kill woman buffer.
  5451. (let ((Man-notify-method 'meek))
  5452. (Man-getpage-in-background candidate))))))
  5453. (defvar anything-c-source-man-pages
  5454. `((name . "Manual Pages")
  5455. (candidates . (lambda ()
  5456. (if anything-c-man-pages
  5457. anything-c-man-pages
  5458. ;; XEmacs doesn't have a woman :)
  5459. (setq anything-c-man-pages
  5460. (ignore-errors
  5461. (require 'woman)
  5462. (woman-file-name "")
  5463. (sort (mapcar 'car woman-topic-all-completions)
  5464. 'string-lessp))))))
  5465. (action ("Show with Woman" . anything-c-man-default-action))
  5466. ;; Woman does not work OS X
  5467. ;; http://xahlee.org/emacs/modernization_man_page.html
  5468. (action-transformer . (lambda (actions candidate)
  5469. (if (eq system-type 'darwin)
  5470. '(("Show with Man" . man))
  5471. actions)))
  5472. (requires-pattern . 2)))
  5473. ;;;; <Command>
  5474. ;;; Anything M-x - Enhanced M-x UI
  5475. ;;
  5476. ;;
  5477. ;; Another replacement of `M-x' that act exactly like the
  5478. ;; vanilla Emacs one, no problem of windows configuration, prefix args
  5479. ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
  5480. ;; anything invocation.
  5481. ;; Documentation of commands available without quitting,
  5482. ;; Show keybindings of commands.
  5483. ;; Show history.
  5484. (defvar anything-M-x-input-history nil)
  5485. (defun* anything-M-x-get-major-mode-command-alist (mode-map)
  5486. "Return alist of MODE-MAP."
  5487. (loop for key being the key-seqs of mode-map using (key-bindings com)
  5488. for str-key = (key-description key)
  5489. for ismenu = (string-match "<menu-bar>" str-key)
  5490. unless ismenu collect (cons str-key com)))
  5491. (defun anything-get-mode-map-from-mode (mode)
  5492. "Guess the mode-map name according to MODE.
  5493. Some modes don't use conventional mode-map name
  5494. so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
  5495. Return nil if no mode-map found."
  5496. (loop
  5497. ;; Start with a conventional mode-map name.
  5498. with mode-map = (intern-soft (format "%s-map" mode))
  5499. with mode-string = (symbol-name mode)
  5500. with mode-name = (replace-regexp-in-string "-mode" "" mode-string)
  5501. while (not mode-map)
  5502. for count downfrom (length mode-name)
  5503. ;; Return when no result after parsing entire string.
  5504. when (eq count 0) return nil
  5505. for sub-name = (substring mode-name 0 count)
  5506. do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
  5507. finally return mode-map))
  5508. (defun anything-M-x-current-mode-map-alist ()
  5509. "Return mode-map alist of current `major-mode'."
  5510. (let ((map (anything-get-mode-map-from-mode major-mode)))
  5511. (when (and map (boundp map))
  5512. (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
  5513. (defun anything-M-x-transformer (candidates sources)
  5514. "filtered-candidate-transformer to show bindings in emacs commands.
  5515. Show global bindings and local bindings according to current `major-mode'."
  5516. (with-anything-current-buffer
  5517. (loop with local-map = (anything-M-x-current-mode-map-alist)
  5518. for cand in candidates
  5519. for local-key = (car (rassq cand local-map))
  5520. for key = (substitute-command-keys (format "\\[%s]" cand))
  5521. collect
  5522. (cons (cond ((and (string-match "^M-x" key) local-key)
  5523. (format "%s (%s)"
  5524. cand (propertize
  5525. local-key
  5526. 'face 'anything-M-x-key-face)))
  5527. ((string-match "^M-x" key) cand)
  5528. (t (format "%s (%s)"
  5529. cand (propertize
  5530. key
  5531. 'face 'anything-M-x-key-face))))
  5532. cand) into ls
  5533. finally return
  5534. (sort ls #'(lambda (x y) (string-lessp (car x) (car y)))))))
  5535. ;;; Complex command history
  5536. ;;
  5537. ;;
  5538. (defvar anything-c-source-complex-command-history
  5539. '((name . "Complex Command History")
  5540. (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
  5541. (type . sexp)))
  5542. ;;; M-x history (not related to `anything-M-x')
  5543. ;;
  5544. ;;
  5545. (defvar anything-c-source-extended-command-history
  5546. '((name . "Emacs Commands History")
  5547. (candidates
  5548. . (lambda ()
  5549. (anything-fast-remove-dups extended-command-history :test 'equal)))
  5550. (type . command)))
  5551. ;;; Emacs commands (Basic source for emacs commands)
  5552. ;;
  5553. ;;
  5554. (defvar anything-c-source-emacs-commands
  5555. '((name . "Emacs Commands")
  5556. (candidates . (lambda ()
  5557. (let (commands)
  5558. (mapatoms (lambda (a)
  5559. (if (commandp a)
  5560. (push (symbol-name a)
  5561. commands))))
  5562. (sort commands 'string-lessp))))
  5563. (type . command)
  5564. (requires-pattern . 2))
  5565. "Source for completing and invoking Emacs commands.
  5566. A command is a function with interactive spec that can
  5567. be invoked with `M-x'.
  5568. To get non-interactive functions listed, use
  5569. `anything-c-source-emacs-functions'.")
  5570. ;;;; <Function>
  5571. ;;; Emacs functions
  5572. ;;
  5573. ;;
  5574. (defvar anything-c-source-emacs-functions
  5575. '((name . "Emacs Functions")
  5576. (candidates . (lambda ()
  5577. (let (commands)
  5578. (mapatoms (lambda (a)
  5579. (if (functionp a)
  5580. (push (symbol-name a) commands))))
  5581. (sort commands 'string-lessp))))
  5582. (type . function)
  5583. (requires-pattern . 2))
  5584. "Source for completing Emacs functions.")
  5585. ;;; With abbrev expansion
  5586. ;;; Similar to my exec-abbrev-cmd.el
  5587. ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
  5588. (defvar anything-c-function-abbrev-regexp nil
  5589. "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
  5590. Regexp built from the current `anything-pattern' interpreting it
  5591. as abbreviation.
  5592. Only for internal use.")
  5593. (defun anything-c-match-function-by-abbrev (candidate)
  5594. "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
  5595. Abbreviations are made by taking the first character from each
  5596. word in the function's name, e.g. \"bb\" is an abbrev for
  5597. `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
  5598. (string-match anything-c-function-abbrev-regexp candidate))
  5599. (defvar anything-c-source-emacs-functions-with-abbrevs
  5600. (append anything-c-source-emacs-functions
  5601. '((match anything-c-match-function-by-abbrev
  5602. anything-c-string-match))
  5603. '((init
  5604. . (lambda ()
  5605. (defadvice anything-update
  5606. (before anything-c-update-function-abbrev-regexp activate)
  5607. (let ((char-list (append anything-pattern nil))
  5608. (str "^"))
  5609. (dolist (c char-list)
  5610. (setq str (concat str (list c) "[^-]*-")))
  5611. (setq str (concat (substring str 0 (1- (length str))) "$"))
  5612. (setq anything-c-function-abbrev-regexp str))))))))
  5613. (defvar anything-c-source-advice
  5614. '((name . "Function Advice")
  5615. (candidates . anything-c-advice-candidates)
  5616. (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
  5617. (persistent-action . anything-c-advice-persistent-action)
  5618. (multiline)
  5619. (persistent-help . "Describe function / C-u C-z: Toggle advice")))
  5620. ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
  5621. ;; (testadvice)
  5622. (defun anything-c-advice-candidates ()
  5623. (require 'advice)
  5624. (loop for (fname) in ad-advised-functions
  5625. for function = (intern fname)
  5626. append
  5627. (loop for class in ad-advice-classes append
  5628. (loop for advice in (ad-get-advice-info-field function class)
  5629. for enabled = (ad-advice-enabled advice)
  5630. collect
  5631. (cons (format
  5632. "%s %s %s"
  5633. (if enabled "Enabled " "Disabled")
  5634. (propertize fname 'face 'font-lock-function-name-face)
  5635. (ad-make-single-advice-docstring advice class nil))
  5636. (list function class advice))))))
  5637. (defun anything-c-advice-persistent-action (func-class-advice)
  5638. (if current-prefix-arg
  5639. (anything-c-advice-toggle func-class-advice)
  5640. (describe-function (car func-class-advice))))
  5641. (defun anything-c-advice-toggle (func-class-advice)
  5642. (destructuring-bind (function class advice) func-class-advice
  5643. (cond ((ad-advice-enabled advice)
  5644. (ad-advice-set-enabled advice nil)
  5645. (message "Disabled"))
  5646. (t ;disabled
  5647. (ad-advice-set-enabled advice t)
  5648. (message "Enabled")))
  5649. (ad-activate function)
  5650. (and anything-in-persistent-action
  5651. (anything-c-advice-update-current-display-string))))
  5652. (defun anything-c-advice-update-current-display-string ()
  5653. (anything-edit-current-selection
  5654. (let ((newword (cond ((looking-at "Disabled") "Enabled")
  5655. ((looking-at "Enabled") "Disabled")))
  5656. realvalue)
  5657. (when newword
  5658. (delete-region (point) (progn (forward-word 1) (point)))
  5659. (insert newword)))))
  5660. ;;;; <Variable>
  5661. ;;; Emacs variables
  5662. ;;
  5663. ;;
  5664. (defvar anything-c-source-emacs-variables
  5665. '((name . "Emacs Variables")
  5666. (candidates . (lambda ()
  5667. (sort (all-completions "" obarray 'boundp) 'string-lessp)))
  5668. (type . variable)
  5669. (requires-pattern . 2))
  5670. "Source for completing Emacs variables.")
  5671. ;;; LaCarte
  5672. (defvar anything-c-source-lacarte
  5673. '((name . "Lacarte")
  5674. (init . (lambda () (require 'lacarte )))
  5675. (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
  5676. (candidate-number-limit . 9999)
  5677. (action . anything-c-call-interactively))
  5678. "Needs lacarte.el.
  5679. http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
  5680. ;;; Bookmarks
  5681. ;;
  5682. ;;
  5683. ;; Bind some faces for bookmarks.
  5684. (defvar anything-c-bookmarks-face1 'anything-ff-directory)
  5685. (defvar anything-c-bookmarks-face2 'anything-ff-file)
  5686. (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
  5687. (eval-when-compile (require 'bookmark))
  5688. (defvar anything-c-source-bookmarks
  5689. `((name . "Bookmarks")
  5690. (init . (lambda ()
  5691. (require 'bookmark)))
  5692. (candidates . bookmark-all-names)
  5693. (type . bookmark))
  5694. "See (info \"(emacs)Bookmarks\").")
  5695. ;;; bookmark-set
  5696. (defvar anything-c-source-bookmark-set
  5697. '((name . "Set Bookmark")
  5698. (dummy)
  5699. (action . bookmark-set))
  5700. "See (info \"(emacs)Bookmarks\").")
  5701. ;;; Visible Bookmarks
  5702. ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
  5703. ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
  5704. (defvar anything-c-source-bm
  5705. '((name . "Visible Bookmarks")
  5706. (init . anything-c-bm-init)
  5707. (candidates-in-buffer)
  5708. (type . line))
  5709. "Needs bm.el.
  5710. http://www.nongnu.org/bm/")
  5711. (defun anything-c-bm-init ()
  5712. "Init function for `anything-c-source-bm'."
  5713. (when (require 'bm nil t)
  5714. (with-no-warnings
  5715. (let ((bookmarks (bm-lists))
  5716. (buf (anything-candidate-buffer 'global)))
  5717. (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
  5718. '< :key 'overlay-start))
  5719. (let ((start (overlay-start bm))
  5720. (end (overlay-end bm))
  5721. (annotation (or (overlay-get bm 'annotation) "")))
  5722. (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
  5723. (let ((str (format "%5d: [%s]: %s\n"
  5724. (line-number-at-pos start)
  5725. annotation
  5726. (buffer-substring start (1- end)))))
  5727. (with-current-buffer buf (insert str))))))))))
  5728. ;;; Special bookmarks
  5729. (defvar anything-c-source-bookmarks-ssh
  5730. '((name . "Bookmarks-ssh")
  5731. (init . (lambda ()
  5732. (require 'bookmark)))
  5733. (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
  5734. (type . bookmark))
  5735. "See (info \"(emacs)Bookmarks\").")
  5736. (defvar anything-c-source-bookmarks-su
  5737. '((name . "Bookmarks-root")
  5738. (init . (lambda ()
  5739. (require 'bookmark)))
  5740. (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
  5741. (filtered-candidate-transformer anything-c-highlight-bookmark-su)
  5742. (type . bookmark))
  5743. "See (info \"(emacs)Bookmarks\").")
  5744. (defvar anything-c-source-bookmarks-local
  5745. '((name . "Bookmarks-Local")
  5746. (init . (lambda ()
  5747. (require 'bookmark)))
  5748. (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
  5749. (filtered-candidate-transformer
  5750. anything-c-adaptive-sort
  5751. anything-c-highlight-bookmark)
  5752. (type . bookmark))
  5753. "See (info \"(emacs)Bookmarks\").")
  5754. (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
  5755. (let* ((lis-all (bookmark-all-names))
  5756. (lis-loc (cond (local (loop for i in lis-all
  5757. unless (string-match "^(ssh)\\|^(su)" i)
  5758. collect i))
  5759. (su (loop for i in lis-all
  5760. when (string-match "^(su)" i)
  5761. collect i))
  5762. (sudo (loop for i in lis-all
  5763. when (string-match "^(sudo)" i)
  5764. collect i))
  5765. (ssh (loop for i in lis-all
  5766. when (string-match "^(ssh)" i)
  5767. collect i)))))
  5768. (sort lis-loc 'string-lessp)))
  5769. (defun anything-c-bookmark-root-logged-p ()
  5770. (catch 'break
  5771. (dolist (i (mapcar #'buffer-name (buffer-list)))
  5772. (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
  5773. (throw 'break t)))))
  5774. (defun anything-c-highlight-bookmark-su (files source)
  5775. (if (anything-c-bookmark-root-logged-p)
  5776. (anything-c-highlight-bookmark files source)
  5777. (anything-c-highlight-not-logged files source)))
  5778. (defun anything-c-highlight-not-logged (files source)
  5779. (loop for i in files
  5780. collect (propertize i 'face anything-c-bookmarks-face3)))
  5781. (defun anything-c-highlight-bookmark (bookmarks source)
  5782. "Used as `candidate-transformer' to colorize bookmarks.
  5783. Work both with standard Emacs bookmarks and bookmark-extensions.el."
  5784. (loop for i in bookmarks
  5785. for isfile = (bookmark-get-filename i)
  5786. for bufp = (and (fboundp 'bmkext-get-buffer-name)
  5787. (bmkext-get-buffer-name i))
  5788. for handlerp = (and (fboundp 'bookmark-get-handler)
  5789. (bookmark-get-handler i))
  5790. for isw3m = (and (fboundp 'bmkext-w3m-bookmark-p)
  5791. (bmkext-w3m-bookmark-p i))
  5792. for isgnus = (and (fboundp 'bmkext-gnus-bookmark-p)
  5793. (bmkext-gnus-bookmark-p i))
  5794. for isman = (and (fboundp 'bmkext-man-bookmark-p) ; Man
  5795. (bmkext-man-bookmark-p i))
  5796. for iswoman = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
  5797. (bmkext-woman-bookmark-p i))
  5798. for handlerp = (bookmark-get-handler i)
  5799. for isannotation = (bookmark-get-annotation i)
  5800. for isabook = (string= (bookmark-prop-get i 'type) "addressbook")
  5801. for isinfo = (eq handlerp 'Info-bookmark-jump)
  5802. ;; Add a * if bookmark have annotation
  5803. if (and isannotation (not (string-equal isannotation "")))
  5804. do (setq i (concat "*" i))
  5805. collect (cond (;; info buffers
  5806. isinfo
  5807. (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
  5808. (;; w3m buffers
  5809. isw3m
  5810. (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
  5811. (;; gnus buffers
  5812. isgnus
  5813. (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
  5814. (;; Man Woman
  5815. (or iswoman isman)
  5816. (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
  5817. (;; Addressbook
  5818. isabook
  5819. (propertize i 'face '((:foreground "Tomato"))))
  5820. (;; directories
  5821. (and isfile (file-directory-p isfile))
  5822. (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
  5823. (;; regular files
  5824. t
  5825. (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
  5826. (defun anything-c-bookmark-jump (candidate)
  5827. "Jump to bookmark from keyboard."
  5828. (let ((current-prefix-arg anything-current-prefix-arg))
  5829. (bookmark-jump candidate)))
  5830. ;;;###autoload
  5831. (defun anything-c-bookmark-run-jump-other-window ()
  5832. "Jump to bookmark from keyboard."
  5833. (interactive)
  5834. (anything-c-quit-and-execute-action 'bookmark-jump-other-window))
  5835. ;;;###autoload
  5836. (defun anything-c-bookmark-run-delete ()
  5837. "Delete bookmark from keyboard."
  5838. (interactive)
  5839. (when (y-or-n-p "Delete bookmark?")
  5840. (anything-c-quit-and-execute-action 'anything-delete-marked-bookmarks)))
  5841. ;;; Sources to filter bookmark-extensions bookmarks.
  5842. ;;
  5843. ;;
  5844. ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
  5845. ;; If you want to enable google-maps in addressbook you will need
  5846. ;; Julien Danjou google-maps-el package available here:
  5847. ;; http://julien.danjou.info/google-maps-el.html
  5848. (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
  5849. "Return a filtered `bookmark-alist' sorted alphabetically."
  5850. (loop
  5851. with alist = (if args
  5852. (apply #'(lambda (x) (funcall fn x)) args)
  5853. (funcall fn))
  5854. for i in alist
  5855. for b = (car i)
  5856. collect b into sa
  5857. finally return (sort sa 'string-lessp)))
  5858. ;;;###autoload
  5859. (defun anything-c-bmkext-run-edit ()
  5860. "Run `bmkext-edit-bookmark' from keyboard."
  5861. (interactive)
  5862. (anything-c-quit-and-execute-action 'bmkext-edit-bookmark))
  5863. ;;; Addressbook.
  5864. ;;
  5865. ;;
  5866. (defvar anything-c-source-bmkext-addressbook
  5867. '((name . "Bookmark Addressbook")
  5868. (init . (lambda ()
  5869. (require 'bookmark-extensions)
  5870. (bookmark-maybe-load-default-file)))
  5871. (candidates . anything-c-bmkext-addressbook-setup-alist)
  5872. (persistent-action
  5873. . (lambda (candidate)
  5874. (let ((bmk (anything-bookmark-get-bookmark-from-name
  5875. candidate)))
  5876. (bookmark--jump-via bmk 'pop-to-buffer))))
  5877. (persistent-help . "Show contact - Prefix with C-u to append")
  5878. (filtered-candidate-transformer
  5879. anything-c-adaptive-sort
  5880. anything-c-highlight-bookmark)
  5881. (action . (("Show Contact(s)"
  5882. . (lambda (candidate)
  5883. (let* ((contacts (anything-marked-candidates))
  5884. (current-prefix-arg (or anything-current-prefix-arg
  5885. (> (length contacts) 1))))
  5886. (bookmark-jump
  5887. (anything-bookmark-get-bookmark-from-name (car contacts)))
  5888. (anything-aif (cdr contacts)
  5889. (loop for bmk in it do
  5890. (bookmark-jump
  5891. (anything-bookmark-get-bookmark-from-name bmk)))))))
  5892. ("Send Mail"
  5893. . (lambda (candidate)
  5894. (let* ((contacts (anything-marked-candidates))
  5895. (bmk (anything-bookmark-get-bookmark-from-name
  5896. (car contacts)))
  5897. (append (message-buffers)))
  5898. (if append
  5899. (addressbook-set-mail-buffer1 bmk 'append)
  5900. (addressbook-set-mail-buffer1 bmk))
  5901. (setq contacts (cdr contacts))
  5902. (when contacts
  5903. (loop for bmk in contacts do
  5904. (addressbook-set-mail-buffer1 bmk 'append))))))
  5905. ("Edit Bookmark"
  5906. . (lambda (candidate)
  5907. (let ((bmk (anything-bookmark-get-bookmark-from-name
  5908. candidate)))
  5909. (addressbook-bookmark-edit
  5910. (assoc bmk bookmark-alist)))))
  5911. ("Insert Email at point"
  5912. . (lambda (candidate)
  5913. (let* ((bmk (anything-bookmark-get-bookmark-from-name
  5914. candidate))
  5915. (mlist (split-string
  5916. (assoc-default
  5917. 'email (assoc bmk bookmark-alist))
  5918. ", ")))
  5919. (insert
  5920. (if (> (length mlist) 1)
  5921. (anything-comp-read
  5922. "Insert Mail Address: " mlist :must-match t)
  5923. (car mlist))))))
  5924. ("Show annotation"
  5925. . (lambda (candidate)
  5926. (let ((bmk (anything-bookmark-get-bookmark-from-name
  5927. candidate)))
  5928. (bookmark-show-annotation bmk))))
  5929. ("Edit annotation"
  5930. . (lambda (candidate)
  5931. (let ((bmk (anything-bookmark-get-bookmark-from-name
  5932. candidate)))
  5933. (bookmark-edit-annotation bmk))))
  5934. ("Show Google map"
  5935. . (lambda (candidate)
  5936. (let* ((bmk (anything-bookmark-get-bookmark-from-name
  5937. candidate))
  5938. (full-bmk (assoc bmk bookmark-alist)))
  5939. (addressbook-google-map full-bmk))))))))
  5940. (defun anything-c-bmkext-addressbook-setup-alist ()
  5941. "Specialized filter function for bookmarks w3m."
  5942. (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
  5943. ;; W3m bookmarks from bookmark-extensions.
  5944. (defvar anything-c-source-bookmark-w3m
  5945. '((name . "Bookmark W3m")
  5946. (init . (lambda ()
  5947. (require 'bookmark-extensions)
  5948. (bookmark-maybe-load-default-file)))
  5949. (candidates . anything-c-bookmark-w3m-setup-alist)
  5950. (filtered-candidate-transformer
  5951. anything-c-adaptive-sort
  5952. anything-c-highlight-bookmark)
  5953. (type . bookmark)))
  5954. (defun anything-c-bookmark-w3m-setup-alist ()
  5955. "Specialized filter function for bookmarks w3m."
  5956. (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
  5957. ;; Images
  5958. (defvar anything-c-source-bookmark-images
  5959. '((name . "Bookmark Images")
  5960. (init . (lambda ()
  5961. (require 'bookmark-extensions)
  5962. (bookmark-maybe-load-default-file)))
  5963. (candidates . anything-c-bookmark-images-setup-alist)
  5964. (filtered-candidate-transformer
  5965. anything-c-adaptive-sort
  5966. anything-c-highlight-bookmark)
  5967. (type . bookmark)))
  5968. (defun anything-c-bookmark-images-setup-alist ()
  5969. "Specialized filter function for images bookmarks."
  5970. (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
  5971. ;; Woman Man
  5972. (defvar anything-c-source-bookmark-man
  5973. '((name . "Bookmark Woman&Man")
  5974. (init . (lambda ()
  5975. (require 'bookmark-extensions)
  5976. (bookmark-maybe-load-default-file)))
  5977. (candidates . anything-c-bookmark-man-setup-alist)
  5978. (filtered-candidate-transformer
  5979. anything-c-adaptive-sort
  5980. anything-c-highlight-bookmark)
  5981. (type . bookmark)))
  5982. (defun anything-c-bookmark-man-setup-alist ()
  5983. "Specialized filter function for bookmarks w3m."
  5984. (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
  5985. (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
  5986. ;; Gnus
  5987. (defvar anything-c-source-bookmark-gnus
  5988. '((name . "Bookmark Gnus")
  5989. (init . (lambda ()
  5990. (require 'bookmark-extensions)
  5991. (bookmark-maybe-load-default-file)))
  5992. (candidates . anything-c-bookmark-gnus-setup-alist)
  5993. (filtered-candidate-transformer
  5994. anything-c-adaptive-sort
  5995. anything-c-highlight-bookmark)
  5996. (type . bookmark)))
  5997. (defun anything-c-bookmark-gnus-setup-alist ()
  5998. "Specialized filter function for bookmarks gnus."
  5999. (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
  6000. ;; Info
  6001. (defvar anything-c-source-bookmark-info
  6002. '((name . "Bookmark Info")
  6003. (init . (lambda ()
  6004. (require 'bookmark-extensions)
  6005. (bookmark-maybe-load-default-file)))
  6006. (candidates . anything-c-bookmark-info-setup-alist)
  6007. (filtered-candidate-transformer
  6008. anything-c-adaptive-sort
  6009. anything-c-highlight-bookmark)
  6010. (type . bookmark)))
  6011. (defun anything-c-bookmark-info-setup-alist ()
  6012. "Specialized filter function for bookmarks info."
  6013. (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
  6014. ;; Local Files&directories
  6015. (defvar anything-c-source-bookmark-files&dirs
  6016. '((name . "Bookmark Files&Directories")
  6017. (init . (lambda ()
  6018. (require 'bookmark-extensions)
  6019. (bookmark-maybe-load-default-file)))
  6020. (candidates . anything-c-bookmark-local-files-setup-alist)
  6021. (filtered-candidate-transformer
  6022. anything-c-adaptive-sort
  6023. anything-c-highlight-bookmark)
  6024. (type . bookmark)))
  6025. (defun anything-c-bookmark-local-files-setup-alist ()
  6026. "Specialized filter function for bookmarks locals files."
  6027. (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
  6028. ;; Su Files&directories
  6029. (defvar anything-c-source-bookmark-su-files&dirs
  6030. '((name . "Bookmark Root-Files&Directories")
  6031. (init . (lambda ()
  6032. (require 'bookmark-extensions)
  6033. (bookmark-maybe-load-default-file)))
  6034. (candidates . anything-c-bookmark-su-files-setup-alist)
  6035. (filtered-candidate-transformer
  6036. anything-c-adaptive-sort
  6037. anything-c-highlight-bookmark-su)
  6038. (type . bookmark)))
  6039. (defun anything-c-bookmark-su-files-setup-alist ()
  6040. "Specialized filter function for bookmarks su/sudo files."
  6041. (declare (special bmkext-su-or-sudo-regexp))
  6042. (loop
  6043. with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
  6044. for i in l
  6045. for isfile = (bookmark-get-filename i)
  6046. for istramp = (and isfile (boundp 'tramp-file-name-regexp)
  6047. (save-match-data
  6048. (string-match tramp-file-name-regexp isfile)))
  6049. for issu = (and istramp
  6050. (string-match bmkext-su-or-sudo-regexp isfile))
  6051. if issu
  6052. collect i))
  6053. ;; Ssh Files&directories
  6054. (defvar anything-c-source-bookmark-ssh-files&dirs
  6055. '((name . "Bookmark Ssh-Files&Directories")
  6056. (init . (lambda ()
  6057. (require 'bookmark-extensions)
  6058. (bookmark-maybe-load-default-file)))
  6059. (candidates . anything-c-bookmark-ssh-files-setup-alist)
  6060. (filtered-candidate-transformer . anything-c-adaptive-sort)
  6061. (type . bookmark)))
  6062. (defun anything-c-bookmark-ssh-files-setup-alist ()
  6063. "Specialized filter function for bookmarks ssh files."
  6064. (loop
  6065. with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
  6066. for i in l
  6067. for isfile = (bookmark-get-filename i)
  6068. for istramp = (and isfile (boundp 'tramp-file-name-regexp)
  6069. (save-match-data
  6070. (string-match tramp-file-name-regexp isfile)))
  6071. for isssh = (and istramp
  6072. (string-match "/ssh:" isfile))
  6073. if isssh
  6074. collect i))
  6075. ;;; Firefox bookmarks
  6076. ;;
  6077. ;;
  6078. ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
  6079. ;; (only for firefox versions >=3)
  6080. ;; To achieve that, open about:config in firefox and double click on this line to enable value
  6081. ;; to true:
  6082. ;; user_pref("browser.bookmarks.autoExportHTML", false);
  6083. ;; You should have now:
  6084. ;; user_pref("browser.bookmarks.autoExportHTML", true);
  6085. ;; NOTE: This is also working in the same way for mozilla aka seamonkey.
  6086. (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
  6087. (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
  6088. (defun anything-get-firefox-user-init-dir ()
  6089. "Guess the default Firefox user directory name."
  6090. (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
  6091. (moz-user-dir
  6092. (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
  6093. (goto-char (point-min))
  6094. (prog1
  6095. (when (search-forward "Path=" nil t)
  6096. (buffer-substring-no-properties (point) (point-at-eol)))
  6097. (kill-buffer)))))
  6098. (file-name-as-directory (concat moz-dir moz-user-dir))))
  6099. (defun anything-guess-firefox-bookmark-file ()
  6100. "Return the path of the Firefox bookmarks file."
  6101. (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
  6102. (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
  6103. "Parse html bookmark FILE and return an alist with (title . url) as elements."
  6104. (let (bookmarks-alist url title)
  6105. (with-temp-buffer
  6106. (insert-file-contents file)
  6107. (goto-char (point-min))
  6108. (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
  6109. (forward-line 0)
  6110. (when (re-search-forward url-regexp nil t)
  6111. (setq url (match-string 0)))
  6112. (when (re-search-forward bmk-regexp nil t)
  6113. (setq title (match-string 1)))
  6114. (push (cons title url) bookmarks-alist)
  6115. (forward-line)))
  6116. (nreverse bookmarks-alist)))
  6117. (defvar anything-c-firefox-bookmarks-alist nil)
  6118. (defvar anything-c-source-firefox-bookmarks
  6119. '((name . "Firefox Bookmarks")
  6120. (init . (lambda ()
  6121. (setq anything-c-firefox-bookmarks-alist
  6122. (anything-html-bookmarks-to-alist
  6123. (anything-guess-firefox-bookmark-file)
  6124. anything-firefox-bookmark-url-regexp
  6125. anything-firefox-bookmarks-regexp))))
  6126. (candidates . (lambda ()
  6127. (mapcar #'car anything-c-firefox-bookmarks-alist)))
  6128. (filtered-candidate-transformer
  6129. anything-c-adaptive-sort
  6130. anything-c-highlight-firefox-bookmarks)
  6131. (action . (("Browse Url"
  6132. . (lambda (candidate)
  6133. (anything-c-browse-url
  6134. (anything-c-firefox-bookmarks-get-value candidate))))
  6135. ("Copy Url"
  6136. . (lambda (elm)
  6137. (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
  6138. (defun anything-c-firefox-bookmarks-get-value (elm)
  6139. (assoc-default elm anything-c-firefox-bookmarks-alist))
  6140. (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
  6141. (loop for i in bookmarks
  6142. collect (propertize
  6143. i 'face '((:foreground "YellowGreen"))
  6144. 'help-echo (anything-c-firefox-bookmarks-get-value i))))
  6145. ;;; W3m bookmark - anything interface.
  6146. ;;
  6147. ;;
  6148. ;; Some users have the emacs-w3m library in load-path
  6149. ;; without having the w3m executable :-;
  6150. ;; So check if w3m program is present before trying to load
  6151. ;; emacs-w3m.
  6152. (eval-when-compile
  6153. (when (executable-find "w3m")
  6154. (require 'w3m-bookmark nil t)))
  6155. (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
  6156. (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
  6157. (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
  6158. (defvar anything-c-w3m-bookmarks-alist nil)
  6159. (defvar anything-c-source-w3m-bookmarks
  6160. '((name . "W3m Bookmarks")
  6161. (init . (lambda ()
  6162. (setq anything-c-w3m-bookmarks-alist
  6163. (anything-html-bookmarks-to-alist
  6164. w3m-bookmark-file
  6165. anything-w3m-bookmark-url-regexp
  6166. anything-w3m-bookmarks-regexp))))
  6167. (candidates . (lambda ()
  6168. (mapcar #'car anything-c-w3m-bookmarks-alist)))
  6169. (filtered-candidate-transformer
  6170. anything-c-adaptive-sort
  6171. anything-c-highlight-w3m-bookmarks)
  6172. (action . (("Browse Url"
  6173. . (lambda (candidate)
  6174. (anything-c-w3m-browse-bookmark candidate)))
  6175. ("Copy Url"
  6176. . (lambda (elm)
  6177. (kill-new (anything-c-w3m-bookmarks-get-value elm))))
  6178. ("Browse Url Externally"
  6179. . (lambda (candidate)
  6180. (anything-c-w3m-browse-bookmark candidate t)))
  6181. ("Delete Bookmark"
  6182. . (lambda (candidate)
  6183. (anything-c-w3m-delete-bookmark candidate)))
  6184. ("Rename Bookmark"
  6185. . (lambda (candidate)
  6186. (anything-c-w3m-rename-bookmark candidate)))))
  6187. (persistent-action . (lambda (candidate)
  6188. (if current-prefix-arg
  6189. (anything-c-w3m-browse-bookmark candidate t)
  6190. (anything-c-w3m-browse-bookmark candidate nil t))))
  6191. (persistent-help . "Open URL with emacs-w3m in new tab / \
  6192. C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
  6193. "Needs w3m and emacs-w3m.
  6194. http://w3m.sourceforge.net/
  6195. http://emacs-w3m.namazu.org/")
  6196. (defun anything-c-w3m-bookmarks-get-value (elm)
  6197. (replace-regexp-in-string
  6198. "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
  6199. (defun anything-c-w3m-browse-bookmark (elm &optional use-external new-tab)
  6200. (let* ((fn (if use-external 'anything-c-browse-url 'w3m-browse-url))
  6201. (arg (and (eq fn 'w3m-browse-url) new-tab)))
  6202. (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
  6203. (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
  6204. (loop for i in bookmarks
  6205. collect (propertize
  6206. i 'face 'anything-w3m-bookmarks-face
  6207. 'help-echo (anything-c-w3m-bookmarks-get-value i))))
  6208. (defun anything-c-w3m-delete-bookmark (elm)
  6209. "Delete w3m bookmark from `w3m-bookmark-file'."
  6210. (with-current-buffer
  6211. (find-file-literally w3m-bookmark-file)
  6212. (goto-char (point-min))
  6213. (when (re-search-forward elm nil t)
  6214. (beginning-of-line)
  6215. (delete-region (point)
  6216. (line-end-position))
  6217. (delete-blank-lines))
  6218. (save-buffer)
  6219. (kill-buffer)))
  6220. (defun anything-c-w3m-rename-bookmark (elm)
  6221. "Rename w3m bookmark in `w3m-bookmark-file'."
  6222. (let* ((old-title (replace-regexp-in-string ">" "" elm))
  6223. (new-title (read-string "NewTitle: " old-title)))
  6224. (with-current-buffer
  6225. (find-file-literally w3m-bookmark-file)
  6226. (goto-char (point-min))
  6227. (when (re-search-forward (concat elm "<") nil t)
  6228. (goto-char (1- (point)))
  6229. (delete-char (- (length old-title)))
  6230. (insert new-title))
  6231. (save-buffer)
  6232. (kill-buffer))))
  6233. ;;;; <Library>
  6234. ;;; Elisp library scan
  6235. ;;
  6236. ;;
  6237. (defvar anything-c-source-elisp-library-scan
  6238. '((name . "Elisp libraries (Scan)")
  6239. (init . (anything-c-elisp-library-scan-init))
  6240. (candidates-in-buffer)
  6241. (action ("Find library"
  6242. . (lambda (candidate) (find-file (find-library-name candidate))))
  6243. ("Find library other window"
  6244. . (lambda (candidate)
  6245. (find-file-other-window (find-library-name candidate))))
  6246. ("Load library"
  6247. . (lambda (candidate) (load-library candidate))))))
  6248. (defun anything-c-elisp-library-scan-init ()
  6249. "Init anything buffer status."
  6250. (let ((anything-buffer (anything-candidate-buffer 'global))
  6251. (library-list (anything-c-elisp-library-scan-list)))
  6252. (with-current-buffer anything-buffer
  6253. (dolist (library library-list)
  6254. (insert (format "%s\n" library))))))
  6255. (defun anything-c-elisp-library-scan-list (&optional dirs string)
  6256. "Do completion for file names passed to `locate-file'.
  6257. DIRS is directory to search path.
  6258. STRING is string to match."
  6259. ;; Use `load-path' as path when ignore `dirs'.
  6260. (or dirs (setq dirs load-path))
  6261. ;; Init with blank when ignore `string'.
  6262. (or string (setq string ""))
  6263. ;; Get library list.
  6264. (let ((string-dir (file-name-directory string))
  6265. ;; File regexp that suffix match `load-file-rep-suffixes'.
  6266. (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
  6267. name
  6268. names)
  6269. (dolist (dir dirs)
  6270. (unless dir
  6271. (setq dir default-directory))
  6272. (if string-dir
  6273. (setq dir (expand-file-name string-dir dir)))
  6274. (when (file-directory-p dir)
  6275. (dolist (file (file-name-all-completions
  6276. (file-name-nondirectory string) dir))
  6277. ;; Suffixes match `load-file-rep-suffixes'.
  6278. (setq name (if string-dir (concat string-dir file) file))
  6279. (if (string-match match-regexp name)
  6280. (add-to-list 'names name)))))
  6281. names))
  6282. ;;;; <Programming>
  6283. ;;
  6284. ;;
  6285. ;;; Imenu
  6286. ;;
  6287. ;;
  6288. (defvar anything-c-imenu-delimiter " / ")
  6289. (defvar anything-c-imenu-index-filter nil)
  6290. (make-variable-buffer-local 'anything-c-imenu-index-filter)
  6291. (defvar anything-c-cached-imenu-alist nil)
  6292. (make-variable-buffer-local 'anything-c-cached-imenu-alist)
  6293. (defvar anything-c-cached-imenu-candidates nil)
  6294. (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
  6295. (defvar anything-c-cached-imenu-tick nil)
  6296. (make-variable-buffer-local 'anything-c-cached-imenu-tick)
  6297. (eval-when-compile (require 'imenu))
  6298. (setq imenu-auto-rescan t)
  6299. (defun anything-imenu-create-candidates (entry)
  6300. "Create candidates with ENTRY."
  6301. (if (listp (cdr entry))
  6302. (mapcan
  6303. (lambda (sub)
  6304. (if (consp (cdr sub))
  6305. (mapcar
  6306. (lambda (subentry)
  6307. (concat (car entry) anything-c-imenu-delimiter subentry))
  6308. (anything-imenu-create-candidates sub))
  6309. (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
  6310. (cdr entry))
  6311. (list entry)))
  6312. (defvar anything-c-source-imenu
  6313. '((name . "Imenu")
  6314. (init . (lambda () (require 'imenu)))
  6315. (candidates . anything-c-imenu-candidates)
  6316. (persistent-action . (lambda (elm)
  6317. (anything-c-imenu-default-action elm)
  6318. (unless (fboundp 'semantic-imenu-tag-overlay)
  6319. (anything-match-line-color-current-line))))
  6320. (persistent-help . "Show this entry")
  6321. (action . anything-c-imenu-default-action))
  6322. "See (info \"(emacs)Imenu\")")
  6323. (defun anything-c-imenu-candidates ()
  6324. (with-anything-current-buffer
  6325. (let ((tick (buffer-modified-tick)))
  6326. (if (eq anything-c-cached-imenu-tick tick)
  6327. anything-c-cached-imenu-candidates
  6328. (setq imenu--index-alist nil)
  6329. (setq anything-c-cached-imenu-tick tick
  6330. anything-c-cached-imenu-candidates
  6331. (ignore-errors
  6332. (mapcan
  6333. 'anything-imenu-create-candidates
  6334. (setq anything-c-cached-imenu-alist
  6335. (let ((index (imenu--make-index-alist)))
  6336. (if anything-c-imenu-index-filter
  6337. (funcall anything-c-imenu-index-filter index)
  6338. index))))))
  6339. (setq anything-c-cached-imenu-candidates
  6340. (mapcar #'(lambda (x)
  6341. (if (stringp x)
  6342. x
  6343. (car x)))
  6344. anything-c-cached-imenu-candidates))))))
  6345. (setq imenu-default-goto-function 'imenu-default-goto-function)
  6346. (defun anything-c-imenu-default-action (elm)
  6347. "The default action for `anything-c-source-imenu'."
  6348. (let ((path (split-string elm anything-c-imenu-delimiter))
  6349. (alist anything-c-cached-imenu-alist))
  6350. (dolist (elm path)
  6351. (setq alist (assoc elm alist)))
  6352. (imenu alist)))
  6353. ;;; Ctags
  6354. ;;
  6355. ;;
  6356. (defvar anything-c-ctags-modes
  6357. '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
  6358. makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
  6359. scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
  6360. (defun anything-c-source-ctags-init ()
  6361. (when (and buffer-file-name
  6362. (memq major-mode anything-c-ctags-modes)
  6363. (anything-current-buffer-is-modified))
  6364. (with-current-buffer (anything-candidate-buffer 'local)
  6365. (call-process-shell-command
  6366. (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
  6367. (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
  6368. anything-buffer-file-name)
  6369. (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
  6370. nil (current-buffer))
  6371. (goto-char (point-min))
  6372. (forward-line 2)
  6373. (delete-region (point-min) (point))
  6374. (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
  6375. for lineno-start = (point)
  6376. for lineno = (buffer-substring
  6377. lineno-start
  6378. (1- (search-forward "," (point-at-eol) t)))
  6379. do
  6380. (beginning-of-line)
  6381. (insert (format "%5s:" lineno))
  6382. (search-forward "\177" (point-at-eol) t)
  6383. (delete-region (1- (point)) (point-at-eol))
  6384. (forward-line 1)))))
  6385. (defvar anything-c-source-ctags
  6386. '((name . "Exuberant ctags")
  6387. (init . anything-c-source-ctags-init)
  6388. (candidates-in-buffer)
  6389. (adjust)
  6390. (type . line))
  6391. "Needs Exuberant Ctags.
  6392. http://ctags.sourceforge.net/")
  6393. ;;; Etags
  6394. ;;
  6395. ;;
  6396. ;; anything-etags.el is deprecated, if this file is found,
  6397. ;; warn user at compile time.
  6398. (eval-when-compile
  6399. (when (locate-library "anything-etags.el")
  6400. (display-warning
  6401. '(anything-config)
  6402. "You are using obsolete library `anything-etags.el' and should remove it."
  6403. :warning)))
  6404. (defvar anything-c-etags-tag-file-dir nil
  6405. "Etags file directory.")
  6406. (defvar anything-c-etags-mtime-alist nil
  6407. "Store the last modification time of etags files here.")
  6408. (defvar anything-c-etags-cache (make-hash-table :test 'equal)
  6409. "Cache content of etags files used here for faster access.")
  6410. (defun anything-c-etags-get-tag-file (&optional directory)
  6411. "Return the path of etags file if found."
  6412. ;; Get tag file from `default-directory' or upper directory.
  6413. (let ((current-dir (anything-c-etags-find-tag-file-directory
  6414. (or directory default-directory))))
  6415. ;; Return nil if not find tag file.
  6416. (when current-dir
  6417. ;; Set tag file directory.
  6418. (setq anything-c-etags-tag-file-dir current-dir)
  6419. (expand-file-name anything-c-etags-tag-file-name current-dir))))
  6420. (defun anything-c-etags-find-tag-file-directory (current-dir)
  6421. "Try to find the directory containing tag file.
  6422. If not found in CURRENT-DIR search in upper directory."
  6423. (flet ((file-exists? (dir)
  6424. (let ((tag-path (expand-file-name
  6425. anything-c-etags-tag-file-name dir)))
  6426. (and (stringp tag-path)
  6427. (file-regular-p tag-path)
  6428. (file-readable-p tag-path)))))
  6429. (loop with count = 0
  6430. until (file-exists? current-dir)
  6431. ;; Return nil if outside the value of
  6432. ;; `anything-c-etags-tag-file-search-limit'.
  6433. if (= count anything-c-etags-tag-file-search-limit)
  6434. do (return nil)
  6435. ;; Or search upper directories.
  6436. else
  6437. do (incf count)
  6438. (setq current-dir (expand-file-name (concat current-dir "../")))
  6439. finally return current-dir)))
  6440. (defun anything-c-source-etags-header-name (x)
  6441. "Create header name for this anything etags session."
  6442. (concat "Etags in "
  6443. (with-anything-current-buffer
  6444. (anything-c-etags-get-tag-file))))
  6445. (defmacro anything-c-etags-create-buffer (file)
  6446. "Create the `anything-buffer' based on contents of etags tag FILE."
  6447. `(let* ((tag-fname ,file)
  6448. max
  6449. (split (with-current-buffer (find-file-noselect tag-fname)
  6450. (prog1
  6451. (split-string (buffer-string) "\n" 'omit-nulls)
  6452. (setq max (line-number-at-pos (point-max)))
  6453. (kill-buffer))))
  6454. (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
  6455. (loop
  6456. with fname
  6457. with cand
  6458. for i in split for count from 0
  6459. for elm = (unless (string-match "^\x0c" i)
  6460. (anything-aif (string-match "\177" i)
  6461. (substring i 0 it)
  6462. i))
  6463. do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
  6464. (setq fname (match-string 1 elm)))
  6465. (elm (setq cand (concat fname ": " elm)))
  6466. (t (setq cand nil)))
  6467. when cand do (progn
  6468. (insert (concat cand "\n"))
  6469. (progress-reporter-update progress-reporter count)))))
  6470. (defun anything-c-etags-init ()
  6471. "Feed `anything-buffer' using `anything-c-etags-cache' or tag file.
  6472. If no entry in cache, create one."
  6473. (let ((tagfile (anything-c-etags-get-tag-file)))
  6474. (when tagfile
  6475. (with-current-buffer (anything-candidate-buffer 'global)
  6476. (anything-aif (gethash tagfile anything-c-etags-cache)
  6477. ;; An entry is present in cache, insert it.
  6478. (insert it)
  6479. ;; No entry, create a new buffer using content of tag file (slower).
  6480. (anything-c-etags-create-buffer tagfile)
  6481. ;; Store content of buffer in cache.
  6482. (puthash tagfile (buffer-string) anything-c-etags-cache)
  6483. ;; Store or set the last modification of tag file.
  6484. (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
  6485. ;; If an entry exists modify it.
  6486. (setcdr it (anything-c-etags-mtime tagfile))
  6487. ;; No entry create a new one.
  6488. (add-to-list 'anything-c-etags-mtime-alist
  6489. (cons tagfile (anything-c-etags-mtime tagfile)))))))))
  6490. (defvar anything-c-source-etags-select
  6491. '((name . "Etags")
  6492. (header-name . anything-c-source-etags-header-name)
  6493. (init . anything-c-etags-init)
  6494. (candidates-in-buffer)
  6495. (search . (anything-c-etags-search-fn))
  6496. (mode-line . anything-etags-mode-line-string)
  6497. (action . anything-c-etags-default-action)
  6498. (persistent-action . (lambda (candidate)
  6499. (anything-c-etags-default-action candidate)
  6500. (anything-match-line-color-current-line))))
  6501. "Anything source for Etags.")
  6502. (defun anything-c-etags-search-fn (pattern)
  6503. "Search function for `anything-c-source-etags-select'."
  6504. (re-search-forward
  6505. (if anything-c-etags-use-regexp-search
  6506. (format anything-c-etags-search-regexp pattern)
  6507. pattern)
  6508. nil t))
  6509. (defun anything-c-etags-default-action (candidate)
  6510. "Anything default action to jump to an etags entry."
  6511. (let* ((split (split-string candidate ": "))
  6512. (fname (expand-file-name
  6513. (car split) anything-c-etags-tag-file-dir))
  6514. (elm (cadr split)))
  6515. (find-file fname)
  6516. (goto-char (point-min))
  6517. (search-forward elm nil t)
  6518. (goto-char (match-beginning 0))))
  6519. (defun anything-c-etags-mtime (file)
  6520. "Last modification time of etags tag FILE."
  6521. (cadr (nth 5 (file-attributes file))))
  6522. (defun anything-c-etags-file-modified-p (file)
  6523. "Check if tag FILE have been modified in this session.
  6524. If FILE is nil return nil."
  6525. (let ((last-modif (and file
  6526. (assoc-default file anything-c-etags-mtime-alist))))
  6527. (and last-modif
  6528. (/= last-modif (anything-c-etags-mtime file)))))
  6529. ;;; Semantic
  6530. ;;
  6531. ;;
  6532. (defvar anything-semantic-candidates nil)
  6533. (defun anything-semantic-construct-candidates (tags depth)
  6534. (when (require 'semantic nil t)
  6535. (apply
  6536. 'append
  6537. (mapcar
  6538. (lambda (tag)
  6539. (if (listp tag)
  6540. (let ((type (semantic-tag-type tag))
  6541. (class (semantic-tag-class tag)))
  6542. (if (or (and (stringp type)
  6543. (or (string= type "class")
  6544. (string= type "namespace")))
  6545. (eq class 'function)
  6546. (eq class 'variable))
  6547. (cons (cons (concat (make-string (* depth 2) ?\s)
  6548. (semantic-format-tag-summarize tag nil t))
  6549. tag)
  6550. (anything-semantic-construct-candidates
  6551. (semantic-tag-components tag) (1+ depth)))))))
  6552. tags))))
  6553. (defun anything-semantic-default-action (candidate)
  6554. (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
  6555. (semantic-go-to-tag tag)))
  6556. (defvar anything-c-source-semantic
  6557. '((name . "Semantic Tags")
  6558. (init . (lambda ()
  6559. (setq anything-semantic-candidates
  6560. (ignore-errors (anything-semantic-construct-candidates
  6561. (semantic-fetch-tags) 0)))))
  6562. (candidates . (lambda ()
  6563. (if anything-semantic-candidates
  6564. (mapcar 'car anything-semantic-candidates))))
  6565. (persistent-action . (lambda (elm)
  6566. (anything-semantic-default-action elm)
  6567. (anything-match-line-color-current-line)))
  6568. (persistent-help . "Show this entry")
  6569. (action . anything-semantic-default-action)
  6570. "Needs semantic in CEDET.
  6571. http://cedet.sourceforge.net/semantic.shtml
  6572. http://cedet.sourceforge.net/"))
  6573. ;;; Anything interface of `simple-call-tree.el'.
  6574. ;;
  6575. ;; <http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el>
  6576. ;;
  6577. ;; Function is called by
  6578. (defvar anything-c-source-simple-call-tree-functions-callers
  6579. '((name . "Function is called by")
  6580. (init . anything-c-simple-call-tree-functions-callers-init)
  6581. (multiline)
  6582. (candidates . anything-c-simple-call-tree-candidates)
  6583. (persistent-action . anything-c-simple-call-tree-persistent-action)
  6584. (persistent-help . "Show function definitions by rotation")
  6585. (action ("Find definition selected by persistent-action" .
  6586. anything-c-simple-call-tree-find-definition)))
  6587. "Needs simple-call-tree.el.
  6588. http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
  6589. (defvar anything-c-simple-call-tree-tick nil)
  6590. (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
  6591. (defun anything-c-simple-call-tree-analyze-maybe ()
  6592. (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
  6593. (simple-call-tree-analyze)
  6594. (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
  6595. (defun anything-c-simple-call-tree-init-base (function message)
  6596. (require 'simple-call-tree)
  6597. (with-no-warnings
  6598. (when (anything-current-buffer-is-modified)
  6599. (anything-c-simple-call-tree-analyze-maybe)
  6600. (let ((list (funcall function simple-call-tree-alist)))
  6601. (with-current-buffer (anything-candidate-buffer 'local)
  6602. (dolist (entry list)
  6603. (let ((funcs (concat " " (mapconcat #'identity (cdr entry) "\n "))))
  6604. (insert (car entry) message
  6605. (if (string= funcs " ")
  6606. " no functions."
  6607. funcs)
  6608. "\n\n"))))))))
  6609. (defun anything-c-simple-call-tree-functions-callers-init ()
  6610. (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
  6611. " is called by\n"))
  6612. (defun anything-c-simple-call-tree-candidates ()
  6613. (with-current-buffer (anything-candidate-buffer)
  6614. (split-string (buffer-string) "\n\n")))
  6615. (defvar anything-c-simple-call-tree-related-functions nil)
  6616. (defvar anything-c-simple-call-tree-function-index 0)
  6617. (defun anything-c-simple-call-tree-persistent-action (candidate)
  6618. (unless (eq last-command 'anything-execute-persistent-action)
  6619. (setq anything-c-simple-call-tree-related-functions
  6620. (delete "no functions."
  6621. (split-string
  6622. (replace-regexp-in-string " \\| is called by\\| calls "
  6623. "" candidate)
  6624. "\n")))
  6625. (setq anything-c-simple-call-tree-function-index -1))
  6626. (incf anything-c-simple-call-tree-function-index)
  6627. (anything-c-simple-call-tree-find-definition candidate))
  6628. (defun anything-c-simple-call-tree-find-definition (candidate)
  6629. (find-function
  6630. (intern
  6631. (nth (mod anything-c-simple-call-tree-function-index
  6632. (length anything-c-simple-call-tree-related-functions))
  6633. anything-c-simple-call-tree-related-functions))))
  6634. ;;; Function calls
  6635. (defvar anything-c-source-simple-call-tree-callers-functions
  6636. '((name . "Function calls")
  6637. (init . anything-c-simple-call-tree-callers-functions-init)
  6638. (multiline)
  6639. (candidates . anything-c-simple-call-tree-candidates)
  6640. (persistent-action . anything-c-simple-call-tree-persistent-action)
  6641. (persistent-help . "Show function definitions by rotation")
  6642. (action ("Find definition selected by persistent-action" .
  6643. anything-c-simple-call-tree-find-definition)))
  6644. "Needs simple-call-tree.el.
  6645. http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
  6646. (defun anything-c-simple-call-tree-callers-functions-init ()
  6647. (anything-c-simple-call-tree-init-base 'identity " calls \n"))
  6648. ;;; Anything UI of auto-document.el
  6649. ;;
  6650. ;; <http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el>
  6651. ;;
  6652. ;; Commands/Options with doc
  6653. (defvar anything-c-auto-document-data nil)
  6654. (make-variable-buffer-local 'anything-c-auto-document-data)
  6655. (defvar anything-c-source-commands-and-options-in-file
  6656. '((name . "Commands/Options in file")
  6657. (header-name
  6658. . (lambda (x) (format "Commands/Options in %s"
  6659. (buffer-local-value 'buffer-file-name
  6660. anything-current-buffer))))
  6661. (candidates . anything-command-and-options-candidates)
  6662. (multiline)
  6663. (action . imenu))
  6664. "List Commands and Options with doc. It needs auto-document.el .
  6665. http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
  6666. (eval-when-compile (require 'auto-document nil t))
  6667. (defun anything-command-and-options-candidates ()
  6668. (with-anything-current-buffer
  6669. (when (and (require 'auto-document nil t)
  6670. (eq major-mode 'emacs-lisp-mode)
  6671. (or (anything-current-buffer-is-modified)
  6672. (not anything-c-auto-document-data)))
  6673. (or imenu--index-alist (imenu--make-index-alist t))
  6674. (setq anything-c-auto-document-data
  6675. (destructuring-bind (commands options)
  6676. (adoc-construct anything-current-buffer)
  6677. (append
  6678. (loop for (command . doc) in commands
  6679. for cmdname = (symbol-name command)
  6680. collect
  6681. (cons
  6682. (format "Command: %s\n %s"
  6683. (propertize cmdname 'face font-lock-function-name-face)
  6684. (adoc-first-line doc))
  6685. (assoc cmdname imenu--index-alist)))
  6686. (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
  6687. for (option doc default) in options
  6688. for optname = (symbol-name option)
  6689. collect
  6690. (cons
  6691. (format "Option: %s\n %s\n default = %s"
  6692. (propertize optname 'face font-lock-variable-name-face)
  6693. (adoc-first-line doc)
  6694. (adoc-prin1-to-string default))
  6695. (assoc optname
  6696. var-alist)))))))
  6697. anything-c-auto-document-data))
  6698. ;;;; <Color and Face>
  6699. ;;
  6700. ;;; Customize Face
  6701. ;;
  6702. ;;
  6703. (defvar anything-c-source-customize-face
  6704. '((name . "Customize Face")
  6705. (init . (lambda ()
  6706. (unless (anything-candidate-buffer)
  6707. (save-selected-window
  6708. (list-faces-display))
  6709. (anything-candidate-buffer (get-buffer "*Faces*")))))
  6710. (candidates-in-buffer)
  6711. (get-line . buffer-substring)
  6712. (action . (lambda (line)
  6713. (customize-face (intern (car (split-string line))))))
  6714. (requires-pattern . 3))
  6715. "See (info \"(emacs)Faces\")")
  6716. ;;; Colors browser
  6717. ;;
  6718. ;;
  6719. (defvar anything-c-source-colors
  6720. '((name . "Colors")
  6721. (init . (lambda () (unless (anything-candidate-buffer)
  6722. (save-selected-window
  6723. (list-colors-display))
  6724. (anything-candidate-buffer (get-buffer "*Colors*")))))
  6725. (candidates-in-buffer)
  6726. (get-line . buffer-substring)
  6727. (action
  6728. ("Copy Name" . (lambda (candidate)
  6729. (kill-new (anything-c-colors-get-name candidate))))
  6730. ("Copy RGB" . (lambda (candidate)
  6731. (kill-new (anything-c-colors-get-rgb candidate))))
  6732. ("Insert Name" . (lambda (candidate)
  6733. (with-anything-current-buffer
  6734. (insert (anything-c-colors-get-name candidate)))))
  6735. ("Insert RGB" . (lambda (candidate)
  6736. (with-anything-current-buffer
  6737. (insert (anything-c-colors-get-rgb candidate))))))))
  6738. (defun anything-c-colors-get-name (candidate)
  6739. "Get color name."
  6740. (replace-regexp-in-string
  6741. " " ""
  6742. (with-temp-buffer
  6743. (insert (capitalize candidate))
  6744. (goto-char (point-min))
  6745. (search-forward-regexp "\\s-\\{2,\\}")
  6746. (delete-region (point) (point-max))
  6747. (buffer-string))))
  6748. (defun anything-c-colors-get-rgb (candidate)
  6749. "Get color RGB."
  6750. (replace-regexp-in-string
  6751. " " ""
  6752. (with-temp-buffer
  6753. (insert (capitalize candidate))
  6754. (goto-char (point-max))
  6755. (search-backward-regexp "\\s-\\{2,\\}")
  6756. (delete-region (point) (point-min))
  6757. (buffer-string))))
  6758. ;;;; <Search Engine>
  6759. ;;; Tracker desktop search
  6760. (defvar anything-c-source-tracker-search
  6761. '((name . "Tracker Search")
  6762. (candidates . (lambda ()
  6763. (start-process "tracker-search-process" nil
  6764. "tracker-search"
  6765. anything-pattern)))
  6766. (type . file)
  6767. (requires-pattern . 3)
  6768. (delayed))
  6769. "Source for retrieving files matching the current input pattern
  6770. with the tracker desktop search.")
  6771. ;;; Spotlight (MacOS X desktop search)
  6772. (defvar anything-c-source-mac-spotlight
  6773. '((name . "mdfind")
  6774. (candidates
  6775. . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
  6776. (type . file)
  6777. (requires-pattern . 3)
  6778. (delayed))
  6779. "Source for retrieving files via Spotlight's command line
  6780. utility mdfind.")
  6781. ;;; Picklist
  6782. (defvar anything-c-source-picklist
  6783. '((name . "Picklist")
  6784. (candidates . (lambda () (mapcar 'car picklist-list)))
  6785. (type . file)))
  6786. ;;; Kill ring
  6787. ;;
  6788. ;;
  6789. (defvar anything-c-source-kill-ring
  6790. `((name . "Kill Ring")
  6791. (init . (lambda () (anything-attrset 'last-command last-command)))
  6792. (candidates . anything-c-kill-ring-candidates)
  6793. (filtered-candidate-transformer anything-c-kill-ring-transformer)
  6794. (action . anything-c-kill-ring-action)
  6795. (keymap . ,anything-kill-ring-map)
  6796. (last-command)
  6797. (migemo)
  6798. (multiline))
  6799. "Source for browse and insert contents of kill-ring.")
  6800. (defun anything-c-kill-ring-candidates ()
  6801. (loop for kill in (anything-fast-remove-dups kill-ring :test 'equal)
  6802. unless (or (< (length kill) anything-kill-ring-threshold)
  6803. (string-match "^[\\s\\t]+$" kill))
  6804. collect kill))
  6805. (defun anything-c-kill-ring-transformer (candidates source)
  6806. "Display only the `anything-c-kill-ring-max-lines-number' lines of candidate."
  6807. (loop for i in candidates
  6808. for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max)))
  6809. if (and anything-c-kill-ring-max-lines-number
  6810. (> nlines anything-c-kill-ring-max-lines-number))
  6811. collect (cons
  6812. (with-temp-buffer
  6813. (insert i)
  6814. (goto-char (point-min))
  6815. (concat
  6816. (buffer-substring
  6817. (point-min)
  6818. (save-excursion
  6819. (forward-line anything-c-kill-ring-max-lines-number)
  6820. (point)))
  6821. "[...]")) i)
  6822. else collect i))
  6823. (defun anything-c-kill-ring-action (str)
  6824. "Insert STR in `kill-ring' and set STR to the head.
  6825. If this action is executed just after `yank',
  6826. replace with STR as yanked string."
  6827. (setq kill-ring (delete str kill-ring))
  6828. (if (not (eq (anything-attr 'last-command) 'yank))
  6829. (insert-for-yank str)
  6830. ;; from `yank-pop'
  6831. (let ((inhibit-read-only t)
  6832. (before (< (point) (mark t))))
  6833. (if before
  6834. (funcall (or yank-undo-function 'delete-region) (point) (mark t))
  6835. (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
  6836. (setq yank-undo-function nil)
  6837. (set-marker (mark-marker) (point) (current-buffer))
  6838. (insert-for-yank str)
  6839. ;; Set the window start back where it was in the yank command,
  6840. ;; if possible.
  6841. (set-window-start (selected-window) yank-window-start t)
  6842. (if before
  6843. ;; This is like exchange-point-and-mark, but doesn't activate the mark.
  6844. ;; It is cleaner to avoid activation, even though the command
  6845. ;; loop would deactivate the mark because we inserted text.
  6846. (goto-char (prog1 (mark t)
  6847. (set-marker (mark-marker) (point) (current-buffer)))))))
  6848. (kill-new str))
  6849. ;;;; <Mark ring>
  6850. ;; DO NOT include these sources in `anything-sources' use
  6851. ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
  6852. ;; `anything-all-mark-rings' instead.
  6853. (defun anything-c-source-mark-ring-candidates ()
  6854. (flet ((get-marks (pos)
  6855. (save-excursion
  6856. (goto-char pos)
  6857. (beginning-of-line)
  6858. (let ((line (car (split-string (thing-at-point 'line) "[\n\r]"))))
  6859. (when (string= "" line)
  6860. (setq line "<EMPTY LINE>"))
  6861. (format "%7d: %s" (line-number-at-pos) line)))))
  6862. (with-anything-current-buffer
  6863. (loop
  6864. with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
  6865. with recip = nil
  6866. for i in marks
  6867. for m = (get-marks i)
  6868. unless (member m recip)
  6869. collect m into recip
  6870. finally return recip))))
  6871. (defvar anything-mark-ring-cache nil)
  6872. (defvar anything-c-source-mark-ring
  6873. '((name . "mark-ring")
  6874. (init . (lambda ()
  6875. (setq anything-mark-ring-cache
  6876. (ignore-errors (anything-c-source-mark-ring-candidates)))))
  6877. (candidates . (lambda ()
  6878. (anything-aif anything-mark-ring-cache
  6879. it)))
  6880. (action . (("Goto line"
  6881. . (lambda (candidate)
  6882. (anything-goto-line (string-to-number candidate))))))
  6883. (persistent-action . (lambda (candidate)
  6884. (anything-goto-line (string-to-number candidate))
  6885. (anything-match-line-color-current-line)))
  6886. (persistent-help . "Show this line")))
  6887. ;;; Global-mark-ring
  6888. (defvar anything-c-source-global-mark-ring
  6889. '((name . "global-mark-ring")
  6890. (candidates . anything-c-source-global-mark-ring-candidates)
  6891. (action . (("Goto line"
  6892. . (lambda (candidate)
  6893. (let ((items (split-string candidate ":")))
  6894. (anything-c-switch-to-buffer (second items))
  6895. (anything-goto-line (string-to-number (car items))))))))
  6896. (persistent-action . (lambda (candidate)
  6897. (let ((items (split-string candidate ":")))
  6898. (anything-c-switch-to-buffer (second items))
  6899. (anything-goto-line (string-to-number (car items)))
  6900. (anything-match-line-color-current-line))))
  6901. (persistent-help . "Show this line")))
  6902. (defun anything-c-source-global-mark-ring-candidates ()
  6903. (flet ((buf-fn (m)
  6904. (with-current-buffer (marker-buffer m)
  6905. (goto-char m)
  6906. (beginning-of-line)
  6907. (let (line)
  6908. (if (string= "" line)
  6909. (setq line "<EMPTY LINE>")
  6910. (setq line (car (split-string (thing-at-point 'line)
  6911. "[\n\r]"))))
  6912. (format "%7d:%s: %s"
  6913. (line-number-at-pos) (marker-buffer m) line)))))
  6914. (loop
  6915. with marks = global-mark-ring
  6916. with recip = nil
  6917. for i in marks
  6918. for gm = (unless (or (string-match
  6919. "^ " (format "%s" (marker-buffer i)))
  6920. (null (marker-buffer i)))
  6921. (buf-fn i))
  6922. when (and gm (not (member gm recip)))
  6923. collect gm into recip
  6924. finally return recip)))
  6925. ;;;; <Register>
  6926. ;;; Insert from register
  6927. (defvar anything-c-source-register
  6928. '((name . "Registers")
  6929. (candidates . anything-c-register-candidates)
  6930. (action-transformer . anything-c-register-action-transformer)
  6931. (multiline)
  6932. (action))
  6933. "See (info \"(emacs)Registers\")")
  6934. (defun anything-c-register-candidates ()
  6935. "Collecting register contents and appropriate commands."
  6936. (loop for (char . val) in register-alist
  6937. for key = (single-key-description char)
  6938. for string-actions =
  6939. (cond
  6940. ((numberp val)
  6941. (list (int-to-string val)
  6942. 'insert-register
  6943. 'increment-register))
  6944. ((markerp val)
  6945. (let ((buf (marker-buffer val)))
  6946. (if (null buf)
  6947. (list "a marker in no buffer")
  6948. (list (concat
  6949. "a buffer position:"
  6950. (buffer-name buf)
  6951. ", position "
  6952. (int-to-string (marker-position val)))
  6953. 'jump-to-register
  6954. 'insert-register))))
  6955. ((and (consp val) (window-configuration-p (car val)))
  6956. (list "window configuration."
  6957. 'jump-to-register))
  6958. ((and (consp val) (frame-configuration-p (car val)))
  6959. (list "frame configuration."
  6960. 'jump-to-register))
  6961. ((and (consp val) (eq (car val) 'file))
  6962. (list (concat "file:"
  6963. (prin1-to-string (cdr val))
  6964. ".")
  6965. 'jump-to-register))
  6966. ((and (consp val) (eq (car val) 'file-query))
  6967. (list (concat "file:a file-query reference: file "
  6968. (car (cdr val))
  6969. ", position "
  6970. (int-to-string (car (cdr (cdr val))))
  6971. ".")
  6972. 'jump-to-register))
  6973. ((consp val)
  6974. (let ((lines (format "%4d" (length val))))
  6975. (list (format "%s: %s\n" lines
  6976. (truncate-string-to-width
  6977. (mapconcat 'identity (list (car val))
  6978. "^J") (- (window-width) 15)))
  6979. 'insert-register)))
  6980. ((stringp val)
  6981. (list
  6982. ;; without properties
  6983. (concat (substring-no-properties
  6984. val 0 (min (length val) anything-c-register-max-offset))
  6985. (if (> (length val) anything-c-register-max-offset)
  6986. "[...]" ""))
  6987. 'insert-register
  6988. 'append-to-register
  6989. 'prepend-to-register))
  6990. ((vectorp val)
  6991. (list
  6992. "Undo-tree entry."
  6993. 'undo-tree-restore-state-from-register))
  6994. (t
  6995. "GARBAGE!"))
  6996. collect (cons (format "register %3s: %s" key (car string-actions))
  6997. (cons char (cdr string-actions)))))
  6998. (defun anything-c-register-action-transformer (actions register-and-functions)
  6999. "Decide actions by the contents of register."
  7000. (loop with func-actions =
  7001. '((insert-register
  7002. "Insert Register" .
  7003. (lambda (c) (insert-register (car c))))
  7004. (jump-to-register
  7005. "Jump to Register" .
  7006. (lambda (c) (jump-to-register (car c))))
  7007. (append-to-register
  7008. "Append Region to Register" .
  7009. (lambda (c) (append-to-register
  7010. (car c) (region-beginning) (region-end))))
  7011. (prepend-to-register
  7012. "Prepend Region to Register" .
  7013. (lambda (c) (prepend-to-register
  7014. (car c) (region-beginning) (region-end))))
  7015. (increment-register
  7016. "Increment Prefix Arg to Register" .
  7017. (lambda (c) (increment-register
  7018. anything-current-prefix-arg (car c))))
  7019. (undo-tree-restore-state-from-register
  7020. "Restore Undo-tree register"
  7021. (lambda (c) (and (fboundp 'undo-tree-restore-state-from-register)
  7022. (undo-tree-restore-state-from-register (car c))))))
  7023. for func in (cdr register-and-functions)
  7024. for cell = (assq func func-actions)
  7025. when cell
  7026. collect (cdr cell)))
  7027. ;;; Latex completion
  7028. (defun anything-c-latex-math-candidates ()
  7029. "Collect candidates for latex math completion."
  7030. (declare (special LaTeX-math-menu))
  7031. (loop for i in (cddr LaTeX-math-menu)
  7032. for elm = (loop for s in i when (vectorp s)
  7033. collect (cons (aref s 0) (aref s 1)))
  7034. append elm))
  7035. (defvar anything-c-source-latex-math
  7036. '((name . "Latex Math Menu")
  7037. (init . (lambda ()
  7038. (with-anything-current-buffer
  7039. (LaTeX-math-mode 1))))
  7040. (candidate-number-limit . 9999)
  7041. (candidates . anything-c-latex-math-candidates)
  7042. (action . (lambda (candidate)
  7043. (call-interactively candidate)))))
  7044. ;;;; <Headline Extraction>
  7045. (defvar anything-c-source-fixme
  7046. '((name . "TODO/FIXME/DRY comments")
  7047. (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
  7048. (adjust)
  7049. (recenter))
  7050. "Show TODO/FIXME/DRY comments in current file.")
  7051. (defvar anything-c-source-rd-headline
  7052. '((name . "RD HeadLine")
  7053. (headline "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
  7054. (condition . (memq major-mode '(rdgrep-mode rd-mode)))
  7055. (migemo)
  7056. (subexp . 1))
  7057. "Show RD headlines.
  7058. RD is Ruby's POD.
  7059. http://en.wikipedia.org/wiki/Ruby_Document_format")
  7060. (defvar anything-c-source-oddmuse-headline
  7061. '((name . "Oddmuse HeadLine")
  7062. (headline "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
  7063. "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
  7064. (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
  7065. (migemo)
  7066. (subexp . 1))
  7067. "Show Oddmuse headlines, such as EmacsWiki.")
  7068. (defvar anything-c-source-emacs-source-defun
  7069. '((name . "Emacs Source DEFUN")
  7070. (headline . "DEFUN\\|DEFVAR")
  7071. (condition . (string-match "/emacs2[0-9].+/src/.+c$"
  7072. (or buffer-file-name ""))))
  7073. "Show DEFUN/DEFVAR in Emacs C source file.")
  7074. (defvar anything-c-source-emacs-lisp-expectations
  7075. '((name . "Emacs Lisp Expectations")
  7076. (headline . "(desc[ ]\\|(expectations")
  7077. (condition . (eq major-mode 'emacs-lisp-mode)))
  7078. "Show descriptions (desc) in Emacs Lisp Expectations.
  7079. http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
  7080. (defvar anything-c-source-emacs-lisp-toplevels
  7081. '((name . "Emacs Lisp Toplevel / Level 4 Comment / Linkd Star")
  7082. (headline . "^(\\|(@\\*\\|^;;;;")
  7083. (get-line . buffer-substring)
  7084. (condition . (eq major-mode 'emacs-lisp-mode))
  7085. (adjust))
  7086. "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
  7087. linkd.el is optional because linkd stars are extracted by regexp.
  7088. http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
  7089. ;;; Anything yaoddmuse
  7090. ;;
  7091. ;; Be sure to have yaoddmuse.el installed
  7092. ;; install-elisp may be required if you want to install elisp file from here.
  7093. (defvar anything-yaoddmuse-use-cache-file nil)
  7094. (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
  7095. (defvar anything-c-yaoddmuse-ew-cache nil)
  7096. (defun anything-yaoddmuse-get-candidates ()
  7097. (declare (special yaoddmuse-pages-hash))
  7098. (if anything-yaoddmuse-use-cache-file
  7099. (ignore-errors
  7100. (unless anything-c-yaoddmuse-ew-cache
  7101. (load anything-c-yaoddmuse-cache-file)
  7102. (setq anything-c-yaoddmuse-ew-cache
  7103. (gethash "EmacsWiki" yaoddmuse-pages-hash)))
  7104. anything-c-yaoddmuse-ew-cache)
  7105. (yaoddmuse-update-pagename t)
  7106. (gethash "EmacsWiki" yaoddmuse-pages-hash)))
  7107. (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
  7108. '((name . "Yaoddmuse Edit or View (EmacsWiki)")
  7109. (candidates . anything-yaoddmuse-get-candidates)
  7110. (action . (("Edit page" . (lambda (candidate)
  7111. (yaoddmuse-edit "EmacsWiki" candidate)))
  7112. ("Browse page"
  7113. . (lambda (candidate)
  7114. (yaoddmuse-browse-page "EmacsWiki" candidate)))
  7115. ("Browse page other window"
  7116. . (lambda (candidate)
  7117. (if (one-window-p)
  7118. (split-window-vertically))
  7119. (yaoddmuse-browse-page "EmacsWiki" candidate)))
  7120. ("Browse diff"
  7121. . (lambda (candidate)
  7122. (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
  7123. ("Copy URL"
  7124. . (lambda (candidate)
  7125. (kill-new (yaoddmuse-url "EmacsWiki" candidate))
  7126. (message "Have copy page %s's URL to yank." candidate)))
  7127. ("Create page"
  7128. . (lambda (candidate)
  7129. (yaoddmuse-edit "EmacsWiki" anything-input)))
  7130. ("Update cache"
  7131. . (lambda (candidate)
  7132. (if anything-yaoddmuse-use-cache-file
  7133. (progn
  7134. (anything-yaoddmuse-cache-pages t)
  7135. (setq anything-c-yaoddmuse-ew-cache
  7136. (gethash "EmacsWiki" yaoddmuse-pages-hash)))
  7137. (yaoddmuse-update-pagename))))))
  7138. (action-transformer anything-c-yaoddmuse-action-transformer))
  7139. "Needs yaoddmuse.el.
  7140. http://www.emacswiki.org/emacs/download/yaoddmuse.el")
  7141. (defvar anything-c-source-yaoddmuse-emacswiki-post-library
  7142. '((name . "Yaoddmuse Post library (EmacsWiki)")
  7143. (init . (anything-yaoddmuse-init))
  7144. (candidates-in-buffer)
  7145. (action . (("Post library and Browse"
  7146. . (lambda (candidate)
  7147. (yaoddmuse-post-file
  7148. (find-library-name candidate)
  7149. "EmacsWiki"
  7150. (file-name-nondirectory (find-library-name candidate))
  7151. nil t)))
  7152. ("Post library"
  7153. . (lambda (candidate)
  7154. (yaoddmuse-post-file
  7155. (find-library-name candidate)
  7156. "EmacsWiki"
  7157. (file-name-nondirectory
  7158. (find-library-name candidate))))))))
  7159. "Needs yaoddmuse.el.
  7160. http://www.emacswiki.org/emacs/download/yaoddmuse.el")
  7161. (defun anything-c-yaoddmuse-action-transformer (actions candidate)
  7162. "Allow the use of `install-elisp' only on elisp files."
  7163. (if (string-match "\.el$" candidate)
  7164. (append actions '(("Install Elisp"
  7165. . (lambda (elm)
  7166. (install-elisp-from-emacswiki elm)))))
  7167. actions))
  7168. ;;;###autoload
  7169. (defun anything-yaoddmuse-cache-pages (&optional load)
  7170. "Fetch the list of files on emacswiki and create cache file.
  7171. If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
  7172. (interactive)
  7173. (declare (special yaoddmuse-pages-hash))
  7174. (yaoddmuse-update-pagename)
  7175. (save-excursion
  7176. (find-file anything-c-yaoddmuse-cache-file)
  7177. (erase-buffer)
  7178. (insert "(puthash \"EmacsWiki\" '(")
  7179. (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
  7180. do
  7181. (insert (concat "(\"" (car i) "\") ")))
  7182. (insert ") yaoddmuse-pages-hash)\n")
  7183. (save-buffer)
  7184. (kill-buffer (current-buffer))
  7185. (when (or current-prefix-arg
  7186. load)
  7187. (load anything-c-yaoddmuse-cache-file))))
  7188. (defun anything-yaoddmuse-init ()
  7189. "Init anything buffer status."
  7190. (let ((anything-buffer (anything-candidate-buffer 'global))
  7191. (library-list (yaoddmuse-get-library-list)))
  7192. (with-current-buffer anything-buffer
  7193. ;; Insert library name.
  7194. (dolist (library library-list)
  7195. (insert (format "%s\n" library)))
  7196. ;; Sort lines.
  7197. (sort-lines nil (point-min) (point-max)))))
  7198. ;;; Eev anchors
  7199. (defvar anything-c-source-eev-anchor
  7200. '((name . "Anchors")
  7201. (candidates
  7202. . (lambda ()
  7203. (ignore-errors
  7204. (with-anything-current-buffer
  7205. (loop initially (goto-char (point-min))
  7206. while (re-search-forward
  7207. (format ee-anchor-format "\\([^\.].+\\)") nil t)
  7208. for anchor = (match-string-no-properties 1)
  7209. collect (cons (format "%5d:%s"
  7210. (line-number-at-pos (match-beginning 0))
  7211. (format ee-anchor-format anchor))
  7212. anchor))))))
  7213. (persistent-action . (lambda (item)
  7214. (ee-to item)
  7215. (anything-match-line-color-current-line)))
  7216. (persistent-help . "Show this entry")
  7217. (action . (("Goto link" . ee-to)))))
  7218. ;;; Org headlines
  7219. ;;
  7220. ;;
  7221. (defvar anything-c-source-org-headline
  7222. `((name . "Org HeadLine")
  7223. (headline
  7224. ,@(mapcar
  7225. (lambda (num)
  7226. (format "^\\*\\{%d\\} \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
  7227. num))
  7228. (number-sequence 1 8)))
  7229. (condition . (eq major-mode 'org-mode))
  7230. (migemo)
  7231. (subexp . 1)
  7232. (persistent-action . (lambda (elm)
  7233. (anything-c-action-line-goto elm)
  7234. (org-cycle)))
  7235. (action-transformer
  7236. . (lambda (actions candidate)
  7237. '(("Go to Line" . anything-c-action-line-goto)
  7238. ("Refile to this Headline" . anything-c-org-headline-refile)
  7239. ("Insert Link to This Headline"
  7240. . anything-c-org-headline-insert-link-to-headline)))))
  7241. "Show Org headlines.
  7242. org-mode is very very much extended text-mode/outline-mode.
  7243. See (find-library \"org.el\")
  7244. See http://orgmode.org for the latest version.")
  7245. (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
  7246. (insert
  7247. (save-excursion
  7248. (anything-goto-line (car lineno-and-content))
  7249. (and (looking-at org-complex-heading-regexp)
  7250. (org-make-link-string (concat "*" (match-string 4)))))))
  7251. (defun anything-c-org-headline-refile (lineno-and-content)
  7252. "Refile current org entry to LINENO-AND-CONTENT."
  7253. (with-anything-current-buffer
  7254. (org-cut-subtree)
  7255. (anything-goto-line (car lineno-and-content))
  7256. (org-end-of-subtree t t)
  7257. (let ((org-yank-adjusted-subtrees t))
  7258. (org-yank))))
  7259. ;;; Org keywords
  7260. ;;
  7261. ;;
  7262. (defvar anything-c-source-org-keywords
  7263. '((name . "Org Keywords")
  7264. (init . anything-c-org-keywords-init)
  7265. (candidates . anything-c-org-keywords-candidates)
  7266. (action . anything-c-org-keywords-insert)
  7267. (persistent-action . anything-c-org-keywords-show-help)
  7268. (persistent-help . "Show an example and info page to describe this keyword.")
  7269. (keywords-examples)
  7270. (keywords)))
  7271. (defvar anything-c-org-keywords-info-location
  7272. '(("#+TITLE:" . "(org)Export options")
  7273. ("#+AUTHOR:" . "(org)Export options")
  7274. ("#+DATE:" . "(org)Export options")
  7275. ("#+EMAIL:" . "(org)Export options")
  7276. ("#+DESCRIPTION:" . "(org)Export options")
  7277. ("#+KEYWORDS:" . "(org)Export options")
  7278. ("#+LANGUAGE:" . "(org)Export options")
  7279. ("#+TEXT:" . "(org)Export options")
  7280. ("#+TEXT:" . "(org)Export options")
  7281. ("#+OPTIONS:" . "(org)Export options")
  7282. ("#+BIND:" . "(org)Export options")
  7283. ("#+LINK_UP:" . "(org)Export options")
  7284. ("#+LINK_HOME:" . "(org)Export options")
  7285. ("#+LATEX_HEADER:" . "(org)Export options")
  7286. ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
  7287. ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
  7288. ("#+INFOJS_OPT" . "(org)Javascript support")
  7289. ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
  7290. ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
  7291. ("#+ORGTBL" . "(org)Radio tables")
  7292. ("#+HTML:" . "(org)Quoting HTML tags")
  7293. ("#+LaTeX:" . "(org)Quoting LaTeX code")
  7294. ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
  7295. ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
  7296. ("#+BEGIN_QUOTE" . "(org)Paragraphs")
  7297. ("#+BEGIN_VERSE" . "(org)Paragraphs")
  7298. ("#+BEGIN_SRC" . "(org)Literal examples")
  7299. ("#+CAPTION" . "(org)Tables in HTML export")
  7300. ("#+LABEL" . "(org)Tables in LaTeX export")
  7301. ("#+ATTR_HTML" . "(org)Links")
  7302. ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
  7303. (defun anything-c-org-keywords-init ()
  7304. (unless (anything-attr 'keywords-examples)
  7305. (require 'org)
  7306. (anything-attrset 'keywords-examples
  7307. (append
  7308. (mapcar
  7309. (lambda (x)
  7310. (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
  7311. (cons (match-string 2 x) (match-string 1 x)))
  7312. (org-split-string (org-get-current-options) "\n"))
  7313. (mapcar 'list org-additional-option-like-keywords)))
  7314. (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
  7315. (defun anything-c-org-keywords-candidates ()
  7316. (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
  7317. (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
  7318. (anything-attr 'keywords)))
  7319. (defun anything-c-org-keywords-insert (keyword)
  7320. (cond ((and (string-match "BEGIN" keyword)
  7321. (anything-region-active-p))
  7322. (let ((beg (region-beginning))
  7323. (end (region-end)))
  7324. (goto-char end)
  7325. (insert "\n#+" (replace-regexp-in-string
  7326. "BEGIN" "END" keyword) "\n")
  7327. (goto-char beg)
  7328. (insert "#+" keyword " ")
  7329. (save-excursion (insert "\n"))))
  7330. ((string-match "BEGIN" keyword)
  7331. (insert "#+" keyword " ")
  7332. (save-excursion
  7333. (insert "\n#+" (replace-regexp-in-string
  7334. "BEGIN" "END" keyword) "\n")))
  7335. (t (insert "#+" keyword " "))))
  7336. (defun anything-c-org-keywords-show-help (keyword)
  7337. (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
  7338. "(org)In-buffer settings"))
  7339. (search-forward (concat "#+" keyword) nil t)
  7340. (anything-persistent-highlight-point)
  7341. (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
  7342. ;;; bbdb
  7343. ;;
  7344. ;;
  7345. (defvar bbdb-records)
  7346. (defvar bbdb-buffer-name)
  7347. (defun anything-c-bbdb-candidates ()
  7348. "Return a list of all names in the bbdb database. The format
  7349. is \"Firstname Lastname\"."
  7350. (mapcar (lambda (bbdb-record)
  7351. (replace-regexp-in-string
  7352. "\\s-+$" ""
  7353. (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
  7354. (bbdb-records)))
  7355. (defun anything-c-bbdb-create-contact (actions candidate)
  7356. "Action transformer that returns only an entry to add the
  7357. current `anything-pattern' as new contact. All other actions are
  7358. removed."
  7359. (if (string= candidate "*Add to contacts*")
  7360. '(("Add to contacts" . (lambda (actions)
  7361. (bbdb-create-internal
  7362. (read-from-minibuffer "Name: " anything-c-bbdb-name)
  7363. (read-from-minibuffer "Company: ")
  7364. (read-from-minibuffer "Email: ")
  7365. nil
  7366. nil
  7367. (read-from-minibuffer "Note: ")))))
  7368. actions))
  7369. (defun anything-c-bbdb-get-record (candidate)
  7370. "Return record that match CANDIDATE."
  7371. (bbdb candidate nil)
  7372. (set-buffer "*BBDB*")
  7373. (bbdb-current-record))
  7374. (defvar anything-c-bbdb-name nil
  7375. "Only for internal use.")
  7376. (defvar anything-c-source-bbdb
  7377. '((name . "BBDB")
  7378. (candidates . anything-c-bbdb-candidates)
  7379. (action ("Send a mail" . anything-c-bbdb-compose-mail)
  7380. ("View person's data" . anything-c-bbdb-view-person-action))
  7381. (filtered-candidate-transformer . (lambda (candidates source)
  7382. (setq anything-c-bbdb-name anything-pattern)
  7383. (if (not candidates)
  7384. (list "*Add to contacts*")
  7385. candidates)))
  7386. (action-transformer . (lambda (actions candidate)
  7387. (anything-c-bbdb-create-contact actions candidate))))
  7388. "Needs BBDB.
  7389. http://bbdb.sourceforge.net/")
  7390. (defun anything-c-bbdb-view-person-action (candidate)
  7391. "View BBDB data of single CANDIDATE or marked candidates."
  7392. (anything-aif (anything-marked-candidates)
  7393. (let ((bbdb-append-records (length it)))
  7394. (dolist (i it)
  7395. (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
  7396. (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
  7397. (defun anything-c-bbdb-collect-mail-addresses ()
  7398. "Return a list of all mail addresses of records in bbdb buffer."
  7399. (with-current-buffer bbdb-buffer-name
  7400. (loop for i in bbdb-records
  7401. if (bbdb-record-net (car i))
  7402. collect (bbdb-dwim-net-address (car i)))))
  7403. (defun anything-c-bbdb-compose-mail (candidate)
  7404. "Compose a mail with all records of bbdb buffer."
  7405. (anything-c-bbdb-view-person-action candidate)
  7406. (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
  7407. (address-str (mapconcat 'identity address-list ",\n ")))
  7408. (compose-mail address-str)))
  7409. ;;; Evaluation Result
  7410. ;;
  7411. ;;
  7412. ;; Internal
  7413. (defvar anything-eldoc-active-minibuffers-list nil)
  7414. (defvar anything-eval-expression-input-history nil)
  7415. (defvar anything-c-source-evaluation-result
  7416. '((name . "Evaluation Result")
  7417. (disable-shortcuts)
  7418. (dummy)
  7419. (multiline)
  7420. (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
  7421. (filtered-candidate-transformer . (lambda (candidates source)
  7422. (list
  7423. (condition-case nil
  7424. (with-anything-current-buffer
  7425. (pp-to-string
  7426. (eval (read anything-pattern))))
  7427. (error "Error")))))
  7428. (action . (("Copy result to kill-ring" . (lambda (candidate)
  7429. (with-current-buffer anything-buffer
  7430. (let ((end (save-excursion
  7431. (goto-char (point-max))
  7432. (search-backward "\n")
  7433. (point))))
  7434. (kill-region (point) end)))))
  7435. ("copy sexp to kill-ring" . (lambda (candidate)
  7436. (kill-new anything-input)))))))
  7437. (defun anything-eval-new-line-and-indent ()
  7438. (interactive)
  7439. (newline) (lisp-indent-line))
  7440. (defun anything-eldoc-store-minibuffer ()
  7441. "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
  7442. (with-selected-window (minibuffer-window)
  7443. (push (buffer-name) anything-eldoc-active-minibuffers-list)))
  7444. (defun anything-eldoc-show-in-eval ()
  7445. "Return eldoc in mode-line for current minibuffer input."
  7446. (let ((buf (with-selected-window (minibuffer-window)
  7447. (buffer-name))))
  7448. (when (member buf anything-eldoc-active-minibuffers-list)
  7449. (let* ((str-all (with-current-buffer buf
  7450. (minibuffer-completion-contents)))
  7451. (sym (when str-all
  7452. (with-temp-buffer
  7453. (insert str-all)
  7454. (goto-char (point-max))
  7455. (unless (looking-back ")\\|\"") (forward-char -1))
  7456. (eldoc-current-symbol))))
  7457. (info-fn (eldoc-fnsym-in-current-sexp))
  7458. (doc (or (eldoc-get-var-docstring sym)
  7459. (eldoc-get-fnsym-args-string
  7460. (car info-fn) (cadr info-fn)))))
  7461. (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
  7462. (defun anything-c-show-info-in-mode-line (str)
  7463. "Display string STR in mode-line."
  7464. (save-selected-window
  7465. (with-current-buffer anything-buffer
  7466. (let ((mode-line-format (concat " " str)))
  7467. (force-mode-line-update)
  7468. (sit-for anything-c-show-info-in-mode-line-delay))
  7469. (force-mode-line-update))))
  7470. ;;; Calculation Result
  7471. ;;
  7472. ;;
  7473. (defvar anything-c-source-calculation-result
  7474. '((name . "Calculation Result")
  7475. (dummy)
  7476. (filtered-candidate-transformer . (lambda (candidates source)
  7477. (list
  7478. (condition-case nil
  7479. (calc-eval anything-pattern)
  7480. (error "error")))))
  7481. (action ("Copy result to kill-ring" . kill-new))))
  7482. ;;; Google Suggestions
  7483. ;;
  7484. ;;
  7485. ;; Internal
  7486. (defvar anything-ggs-max-length-real-flag 0)
  7487. (defvar anything-ggs-max-length-num-flag 0)
  7488. (defun anything-c-google-suggest-fetch (input)
  7489. "Fetch suggestions for INPUT from XML buffer.
  7490. Return an alist with elements like (data . number_results)."
  7491. (setq anything-ggs-max-length-real-flag 0
  7492. anything-ggs-max-length-num-flag 0)
  7493. (let ((request (concat anything-c-google-suggest-url
  7494. (url-hexify-string input))))
  7495. (flet ((fetch ()
  7496. (loop
  7497. with result-alist = (xml-get-children
  7498. (car (xml-parse-region
  7499. (point-min) (point-max)))
  7500. 'CompleteSuggestion)
  7501. for i in result-alist
  7502. for data = (cdr (caadr (assoc 'suggestion i)))
  7503. for nqueries = (cdr (caadr (assoc 'num_queries i)))
  7504. for lqueries = (length (anything-c-ggs-set-number-result
  7505. nqueries))
  7506. for ldata = (length data)
  7507. do
  7508. (progn
  7509. (when (> ldata anything-ggs-max-length-real-flag)
  7510. (setq anything-ggs-max-length-real-flag ldata))
  7511. (when (> lqueries anything-ggs-max-length-num-flag)
  7512. (setq anything-ggs-max-length-num-flag lqueries)))
  7513. collect (cons data nqueries) into cont
  7514. finally return cont)))
  7515. (if anything-google-suggest-use-curl-p
  7516. (with-temp-buffer
  7517. (call-process "curl" nil t nil request)
  7518. (fetch))
  7519. (with-current-buffer
  7520. (url-retrieve-synchronously request)
  7521. (fetch))))))
  7522. (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
  7523. "Set candidates with result and number of google results found."
  7524. (let ((suggestions
  7525. (loop with suggested-results = (anything-c-google-suggest-fetch
  7526. (or (and request-prefix
  7527. (concat request-prefix
  7528. " " anything-pattern))
  7529. anything-pattern))
  7530. for (real . numresult) in suggested-results
  7531. ;; Prepare number of results with ","
  7532. for fnumresult = (anything-c-ggs-set-number-result numresult)
  7533. ;; Calculate number of spaces to add before fnumresult
  7534. ;; if it is smaller than longest result
  7535. ;; `anything-ggs-max-length-num-flag'.
  7536. ;; e.g 1,234,567
  7537. ;; 345,678
  7538. ;; To be sure it is aligned properly.
  7539. for nspaces = (if (< (length fnumresult)
  7540. anything-ggs-max-length-num-flag)
  7541. (- anything-ggs-max-length-num-flag
  7542. (length fnumresult))
  7543. 0)
  7544. ;; Add now the spaces before fnumresult.
  7545. for align-fnumresult = (concat (make-string nspaces ? )
  7546. fnumresult)
  7547. for interval = (- anything-ggs-max-length-real-flag
  7548. (length real))
  7549. for spaces = (make-string (+ 2 interval) ? )
  7550. for display = (format "%s%s(%s results)"
  7551. real spaces align-fnumresult)
  7552. collect (cons display real))))
  7553. (if (loop for (disp . dat) in suggestions
  7554. thereis (equal dat anything-pattern))
  7555. suggestions
  7556. ;; if there is no suggestion exactly matching the input then
  7557. ;; prepend a Search on Google item to the list
  7558. (append
  7559. suggestions
  7560. (list (cons (concat "Search for " "'" anything-input "'" " on Google")
  7561. anything-input))))))
  7562. (defun anything-c-ggs-set-number-result (num)
  7563. (if num
  7564. (progn
  7565. (and (numberp num) (setq num (number-to-string num)))
  7566. (loop for i in (reverse (split-string num "" t))
  7567. for count from 1
  7568. append (list i) into C
  7569. when (= count 3)
  7570. append (list ",") into C
  7571. and do (setq count 0)
  7572. finally return
  7573. (replace-regexp-in-string
  7574. "^," "" (mapconcat 'identity (reverse C) ""))))
  7575. "?"))
  7576. (defvar anything-c-google-suggest-default-browser-function nil
  7577. "*The browse url function you prefer to use with google suggest.
  7578. When nil, use the first browser function available
  7579. See `anything-browse-url-default-browser-alist'.")
  7580. (defun anything-c-google-suggest-action (candidate)
  7581. "Default action to jump to a google suggested candidate."
  7582. (let ((arg (concat anything-c-google-suggest-search-url
  7583. (url-hexify-string candidate))))
  7584. (anything-aif anything-c-google-suggest-default-browser-function
  7585. (funcall it arg)
  7586. (anything-c-browse-url arg))))
  7587. (defvar anything-c-google-suggest-default-function
  7588. 'anything-c-google-suggest-set-candidates
  7589. "Default function to use in anything google suggest.")
  7590. (defvar anything-c-source-google-suggest
  7591. '((name . "Google Suggest")
  7592. (candidates . (lambda ()
  7593. (funcall anything-c-google-suggest-default-function)))
  7594. (action . (("Google Search" . anything-c-google-suggest-action)))
  7595. (volatile)
  7596. (requires-pattern . 3)
  7597. (delayed)))
  7598. (defun anything-c-google-suggest-emacs-lisp ()
  7599. "Try to emacs lisp complete with google suggestions."
  7600. (anything-c-google-suggest-set-candidates "emacs lisp"))
  7601. ;;; Yahoo suggestions
  7602. ;;
  7603. ;;
  7604. (defun anything-c-yahoo-suggest-fetch (input)
  7605. "Fetch Yahoo suggestions for INPUT from XML buffer.
  7606. Return an alist with elements like (data . number_results)."
  7607. (let ((request (concat anything-c-yahoo-suggest-url
  7608. (url-hexify-string input))))
  7609. (flet ((fetch ()
  7610. (loop
  7611. with result-alist = (xml-get-children
  7612. (car (xml-parse-region
  7613. (point-min) (point-max)))
  7614. 'Result)
  7615. for i in result-alist
  7616. collect (caddr i))))
  7617. (with-current-buffer
  7618. (url-retrieve-synchronously request)
  7619. (fetch)))))
  7620. (defun anything-c-yahoo-suggest-set-candidates ()
  7621. "Set candidates with Yahoo results found."
  7622. (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
  7623. (or suggestions
  7624. (append
  7625. suggestions
  7626. (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
  7627. anything-input))))))
  7628. (defun anything-c-yahoo-suggest-action (candidate)
  7629. "Default action to jump to a Yahoo suggested candidate."
  7630. (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
  7631. (url-hexify-string candidate))))
  7632. (defvar anything-c-source-yahoo-suggest
  7633. '((name . "Yahoo Suggest")
  7634. (candidates . anything-c-yahoo-suggest-set-candidates)
  7635. (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
  7636. (volatile)
  7637. (requires-pattern . 3)
  7638. (delayed)))
  7639. ;;; Web browser functions.
  7640. ;;
  7641. ;;
  7642. (require 'browse-url)
  7643. ;; If default setting of `w3m-command' is not
  7644. ;; what you want you and you modify it, you will have to reeval
  7645. ;; also `anything-browse-url-default-browser-alist'.
  7646. (defvar w3m-command "/usr/bin/w3m")
  7647. (defvar anything-c-home-url "http://www.google.fr"
  7648. "*Default url to use as home url.")
  7649. (defvar ac-browse-url-chromium-program "chromium-browser")
  7650. (defvar ac-browse-url-uzbl-program "uzbl-browser")
  7651. (defvar anything-browse-url-default-browser-alist
  7652. `((,w3m-command . w3m-browse-url)
  7653. (,browse-url-firefox-program . browse-url-firefox)
  7654. (,ac-browse-url-chromium-program . ac-browse-url-chromium)
  7655. (,ac-browse-url-uzbl-program . ac-browse-url-uzbl)
  7656. (,browse-url-kde-program . browse-url-kde)
  7657. (,browse-url-gnome-moz-program . browse-url-gnome-moz)
  7658. (,browse-url-mozilla-program . browse-url-mozilla)
  7659. (,browse-url-galeon-program . browse-url-galeon)
  7660. (,browse-url-netscape-program . browse-url-netscape)
  7661. (,browse-url-mosaic-program . browse-url-mosaic)
  7662. (,browse-url-xterm-program . browse-url-text-xterm))
  7663. "*Alist of \(executable . function\) to try to find a suitable url browser.")
  7664. (defun* anything-c-generic-browser (url name &rest args)
  7665. "Browse URL with NAME browser."
  7666. (let ((proc (concat name " " url)))
  7667. (message "Starting %s..." name)
  7668. (apply 'start-process proc nil name
  7669. (append args (list url)))
  7670. (set-process-sentinel
  7671. (get-process proc)
  7672. #'(lambda (process event)
  7673. (when (string= event "finished\n")
  7674. (message "%s process %s" process event))))))
  7675. (defun ac-browse-url-chromium (url)
  7676. "Browse URL with google chrome browser."
  7677. (interactive "sURL: ")
  7678. (anything-c-generic-browser
  7679. url ac-browse-url-chromium-program))
  7680. (defun ac-browse-url-uzbl (url &optional ignore)
  7681. "Browse URL with uzbl browser."
  7682. (interactive "sURL: ")
  7683. (anything-c-generic-browser url ac-browse-url-uzbl-program "-u"))
  7684. (defun anything-browse-url-default-browser (url &rest args)
  7685. "Find the first available browser and ask it to load URL."
  7686. (let ((default-browser-fn
  7687. (loop for (exe . fn) in anything-browse-url-default-browser-alist
  7688. thereis (and exe (executable-find exe) fn))))
  7689. (if default-browser-fn
  7690. (apply default-browser-fn url args)
  7691. (error "No usable browser found"))))
  7692. (defun anything-c-browse-url (url &rest args)
  7693. "Default command to browse URL."
  7694. (if browse-url-browser-function
  7695. (browse-url url args)
  7696. (anything-browse-url-default-browser url args)))
  7697. ;;; Surfraw
  7698. ;;
  7699. ;; Need external program surfraw.
  7700. ;; <http://surfraw.alioth.debian.org/>
  7701. (defvar anything-surfraw-default-browser-function nil
  7702. "*The browse url function you prefer to use with surfraw.
  7703. When nil, fallback to `browse-url-browser-function'.")
  7704. ;; Internal
  7705. (defvar anything-surfraw-engines-history nil)
  7706. (defvar anything-surfraw-input-history nil)
  7707. (defun anything-c-build-elvi-list ()
  7708. "Return list of all engines and descriptions handled by surfraw."
  7709. (cdr
  7710. (with-temp-buffer
  7711. (call-process "surfraw" nil t nil
  7712. "-elvi")
  7713. (split-string (buffer-string) "\n"))))
  7714. ;;; Emms
  7715. ;;
  7716. ;;
  7717. (defun anything-emms-stream-edit-bookmark (elm)
  7718. "Change the information of current emms-stream bookmark from anything."
  7719. (declare (special emms-stream-list))
  7720. (let* ((cur-buf anything-current-buffer)
  7721. (bookmark (assoc elm emms-stream-list))
  7722. (name (read-from-minibuffer "Description: "
  7723. (nth 0 bookmark)))
  7724. (url (read-from-minibuffer "URL: "
  7725. (nth 1 bookmark)))
  7726. (fd (read-from-minibuffer "Feed Descriptor: "
  7727. (int-to-string (nth 2 bookmark))))
  7728. (type (read-from-minibuffer "Type (url, streamlist, or lastfm): "
  7729. (format "%s" (car (last bookmark))))))
  7730. (save-window-excursion
  7731. (emms-streams)
  7732. (when (re-search-forward (concat "^" name) nil t)
  7733. (beginning-of-line)
  7734. (emms-stream-delete-bookmark)
  7735. (emms-stream-add-bookmark name url (string-to-number fd) type)
  7736. (emms-stream-save-bookmarks-file)
  7737. (emms-stream-quit)
  7738. (anything-c-switch-to-buffer cur-buf)))))
  7739. (defun anything-emms-stream-delete-bookmark (candidate)
  7740. "Delete emms-streams bookmarks from anything."
  7741. (let* ((cands (anything-marked-candidates))
  7742. (bmks (loop for bm in cands collect
  7743. (car (assoc bm emms-stream-list))))
  7744. (bmk-reg (mapconcat 'regexp-quote bmks "\\|^")))
  7745. (when (y-or-n-p (format "Really delete radios\n -%s: ? "
  7746. (mapconcat 'identity bmks "\n -")))
  7747. (save-window-excursion
  7748. (emms-streams)
  7749. (goto-char (point-min))
  7750. (loop while (re-search-forward bmk-reg nil t)
  7751. do (progn (beginning-of-line)
  7752. (emms-stream-delete-bookmark))
  7753. finally do (progn
  7754. (emms-stream-save-bookmarks-file)
  7755. (emms-stream-quit)))))))
  7756. (defvar anything-c-source-emms-streams
  7757. '((name . "Emms Streams")
  7758. (init . (lambda ()
  7759. (emms-stream-init)))
  7760. (candidates . (lambda ()
  7761. (declare (special emms-stream-list))
  7762. (mapcar 'car emms-stream-list)))
  7763. (action . (("Play" . (lambda (elm)
  7764. (declare (special emms-stream-list))
  7765. (let* ((stream (assoc elm emms-stream-list))
  7766. (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
  7767. (url (second stream)))
  7768. (funcall fn url))))
  7769. ("Delete" . anything-emms-stream-delete-bookmark)
  7770. ("Edit" . anything-emms-stream-edit-bookmark)))
  7771. (filtered-candidate-transformer . anything-c-adaptive-sort)))
  7772. ;; Don't forget to set `emms-source-file-default-directory'
  7773. (defvar anything-c-source-emms-dired
  7774. '((name . "Music Directory")
  7775. (candidates . (lambda ()
  7776. (cddr (directory-files emms-source-file-default-directory))))
  7777. (action .
  7778. (("Play Directory" . (lambda (item)
  7779. (emms-play-directory
  7780. (expand-file-name
  7781. item
  7782. emms-source-file-default-directory))))
  7783. ("Open dired in file's directory" . (lambda (item)
  7784. (anything-c-open-dired
  7785. (expand-file-name
  7786. item
  7787. emms-source-file-default-directory))))))
  7788. (filtered-candidate-transformer . anything-c-adaptive-sort)))
  7789. (defun anything-c-emms-files-modifier (candidates source)
  7790. (let ((current-playlist (with-current-emms-playlist
  7791. (loop with cur-list = (emms-playlist-tracks-in-region
  7792. (point-min) (point-max))
  7793. for i in cur-list
  7794. for name = (assoc-default 'name i)
  7795. when name
  7796. collect name))))
  7797. (loop for i in candidates
  7798. if (member (cdr i) current-playlist)
  7799. collect (cons (propertize (car i)
  7800. 'face 'anything-emms-playlist)
  7801. (cdr i)) into lis
  7802. else collect i into lis
  7803. finally return (reverse lis))))
  7804. (defun anything-c-emms-play-current-playlist ()
  7805. "Play current playlist."
  7806. (with-current-emms-playlist
  7807. (emms-playlist-first)
  7808. (emms-playlist-mode-play-smart)))
  7809. (defvar anything-c-source-emms-files
  7810. '((name . "Emms files")
  7811. (candidates . (lambda ()
  7812. (loop for v being the hash-values in emms-cache-db
  7813. for name = (assoc-default 'name v)
  7814. for artist = (or (assoc-default 'info-artist v) "unknown")
  7815. for genre = (or (assoc-default 'info-genre v) "unknown")
  7816. for tracknum = (or (assoc-default 'info-tracknumber v) "unknown")
  7817. for song = (or (assoc-default 'info-title v) "unknown")
  7818. for info = (concat artist " - " genre " - " tracknum ": " song)
  7819. unless (string-match "^\\(http\\|mms\\):" name)
  7820. collect (cons info name))))
  7821. (filtered-candidate-transformer . anything-c-emms-files-modifier)
  7822. (candidate-number-limit . 9999)
  7823. (action . (("Play file" . emms-play-file)
  7824. ("Add to Playlist and play (C-u clear current)"
  7825. . (lambda (candidate)
  7826. (when anything-current-prefix-arg
  7827. (emms-playlist-current-clear))
  7828. (emms-playlist-new)
  7829. (mapc 'emms-add-playlist-file (anything-marked-candidates))
  7830. (unless emms-player-playing-p
  7831. (anything-c-emms-play-current-playlist))))))))
  7832. ;;; Jabber Contacts (jabber.el)
  7833. (defun anything-c-jabber-online-contacts ()
  7834. "List online Jabber contacts."
  7835. (with-no-warnings
  7836. (let (jids)
  7837. (dolist (item (jabber-concat-rosters) jids)
  7838. (when (get item 'connected)
  7839. (push (if (get item 'name)
  7840. (cons (get item 'name) item)
  7841. (cons (symbol-name item) item)) jids))))))
  7842. (defvar anything-c-source-jabber-contacts
  7843. '((name . "Jabber Contacts")
  7844. (init . (lambda () (require 'jabber)))
  7845. (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
  7846. (action . (lambda (x)
  7847. (jabber-chat-with
  7848. (jabber-read-account)
  7849. (symbol-name
  7850. (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
  7851. ;;; Call source.
  7852. (defvar anything-source-select-buffer "*anything source select*")
  7853. (defvar anything-c-source-call-source
  7854. `((name . "Call anything source")
  7855. (candidate-number-limit)
  7856. (candidates
  7857. . (lambda ()
  7858. (loop for vname in (all-completions "anything-c-source-" obarray)
  7859. for var = (intern vname)
  7860. for name = (ignore-errors (assoc-default 'name (symbol-value var)))
  7861. if name collect
  7862. (cons (format "%s `%s'"
  7863. name (propertize vname 'face 'font-lock-variable-name-face))
  7864. var))))
  7865. (action
  7866. . (("Invoke anything with selected source"
  7867. .
  7868. (lambda (candidate)
  7869. (setq anything-candidate-number-limit 9999)
  7870. (anything candidate nil nil nil nil
  7871. anything-source-select-buffer)))
  7872. ("Describe variable" . describe-variable)
  7873. ("Find variable" . find-variable)))
  7874. (persistent-action . describe-variable)
  7875. (persistent-help . "Show description of this source")))
  7876. (defun anything-call-source-from-anything ()
  7877. "Call anything source within `anything' session."
  7878. (interactive)
  7879. (setq anything-input-idle-delay 0)
  7880. (anything-set-sources '(anything-c-source-call-source)))
  7881. ;;; Execute Preconfigured anything.
  7882. (defvar anything-c-source-anything-commands
  7883. '((name . "Preconfigured Anything")
  7884. (candidates . anything-c-anything-commands-candidates)
  7885. (type . command)
  7886. (candidate-number-limit)))
  7887. (defun anything-c-anything-commands-candidates ()
  7888. (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
  7889. collect (cons (if (where-is-internal cmd nil t)
  7890. (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
  7891. (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
  7892. cmd)))
  7893. ;;; Occur
  7894. ;;
  7895. ;;
  7896. (defun anything-c-occur-init ()
  7897. "Create the initial anything occur buffer.
  7898. If region is active use region as buffer contents
  7899. instead of whole buffer."
  7900. (with-current-buffer (anything-candidate-buffer 'global)
  7901. (erase-buffer)
  7902. (let ((buf-contents
  7903. (with-anything-current-buffer
  7904. (if (anything-region-active-p)
  7905. (buffer-substring (region-beginning) (region-end))
  7906. (buffer-substring (point-min) (point-max))))))
  7907. (insert buf-contents))))
  7908. (defun anything-c-occur-get-line (s e)
  7909. (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
  7910. (defun anything-c-occur-query-replace-regexp (candidate)
  7911. "Query replace regexp starting from CANDIDATE.
  7912. If region is active ignore CANDIDATE and replace only in region.
  7913. With a prefix arg replace only matches surrounded by word boundaries,
  7914. i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
  7915. (let ((regexp anything-input))
  7916. (unless (anything-region-active-p)
  7917. (anything-c-action-line-goto candidate))
  7918. (apply 'query-replace-regexp
  7919. (anything-c-query-replace-args regexp))))
  7920. (defun anything-occur-run-query-replace-regexp ()
  7921. "Run `query-replace-regexp' in anything occur from keymap."
  7922. (interactive)
  7923. (anything-c-quit-and-execute-action
  7924. 'anything-c-occur-query-replace-regexp))
  7925. (defvar anything-c-source-occur
  7926. `((name . "Occur")
  7927. (init . anything-c-occur-init)
  7928. (candidates-in-buffer)
  7929. (migemo)
  7930. (get-line . anything-c-occur-get-line)
  7931. (display-to-real . anything-c-display-to-real-line)
  7932. (action . (("Go to Line" . anything-c-action-line-goto)
  7933. ("Query replace regexp (C-u Not inside word.)"
  7934. . anything-c-occur-query-replace-regexp)))
  7935. (recenter)
  7936. (mode-line . anything-occur-mode-line)
  7937. (keymap . ,anything-occur-map)
  7938. (requires-pattern . 1)
  7939. (delayed)))
  7940. ;;; Anything browse code.
  7941. (defun anything-c-browse-code-get-line (beg end)
  7942. "Select line if it match the regexp corresponding to current `major-mode'.
  7943. Line is parsed for BEG position to END position."
  7944. (let ((str-line (buffer-substring beg end))
  7945. (regexp (assoc-default major-mode
  7946. anything-c-browse-code-regexp-alist))
  7947. (num-line (if (string= anything-pattern "") beg (1- beg))))
  7948. (when (and regexp (string-match regexp str-line))
  7949. (format "%4d:%s" (line-number-at-pos num-line) str-line))))
  7950. (defvar anything-c-source-browse-code
  7951. '((name . "Browse code")
  7952. (init . (lambda ()
  7953. (anything-candidate-buffer anything-current-buffer)
  7954. (with-anything-current-buffer
  7955. (jit-lock-fontify-now))))
  7956. (candidate-number-limit . 9999)
  7957. (candidates-in-buffer)
  7958. (get-line . anything-c-browse-code-get-line)
  7959. (type . line)
  7960. (recenter)))
  7961. ;; Do many actions for input
  7962. (defvar anything-c-source-create
  7963. '((name . "Create")
  7964. (dummy)
  7965. (action)
  7966. (action-transformer . anything-create--actions))
  7967. "Do many create actions from `anything-pattern'.
  7968. See also `anything-create--actions'.")
  7969. (defun anything-create-from-anything ()
  7970. "Run `anything-create' from `anything' as a fallback."
  7971. (interactive)
  7972. (anything-run-after-quit 'anything-create nil anything-pattern))
  7973. (defun anything-create--actions (&rest ignored)
  7974. "Default actions for `anything-create' / `anything-c-source-create'."
  7975. (remove-if-not
  7976. (lambda (pair) (and (consp pair) (functionp (cdr pair))))
  7977. (append anything-create--actions-private
  7978. '(("find-file" . find-file)
  7979. ("find-file other window" . find-file-other-window)
  7980. ("New buffer" . anything-c-switch-to-buffer)
  7981. ("New buffer other window" . switch-to-buffer-other-window)
  7982. ("Bookmark Set" . bookmark-set)
  7983. ("Set Register" .
  7984. (lambda (x) (set-register (read-char "Register: ") x)))
  7985. ("Insert Linkd star" . linkd-insert-star)
  7986. ("Insert Linkd Tag" . linkd-insert-tag)
  7987. ("Insert Linkd Link" . linkd-insert-link)
  7988. ("Insert Linkd Lisp" . linkd-insert-lisp)
  7989. ("Insert Linkd Wiki" . linkd-insert-wiki)
  7990. ("Google Search" . google)))))
  7991. ;; Minibuffer History
  7992. ;;
  7993. ;;
  7994. (defvar anything-c-source-minibuffer-history
  7995. '((name . "Minibuffer History")
  7996. (header-name . (lambda (name)
  7997. (format "%s (%s)" name minibuffer-history-variable)))
  7998. (candidates
  7999. . (lambda ()
  8000. (let ((history (loop for i in
  8001. (symbol-value minibuffer-history-variable)
  8002. unless (string= "" i) collect i)))
  8003. (if (consp (car history))
  8004. (mapcar 'prin1-to-string history)
  8005. history))))
  8006. (migemo)
  8007. (action . (lambda (candidate)
  8008. (delete-minibuffer-contents)
  8009. (insert candidate)))))
  8010. ;;; Elscreen
  8011. ;;
  8012. ;;
  8013. (defvar anything-c-source-elscreen
  8014. '((name . "Elscreen")
  8015. (candidates
  8016. . (lambda ()
  8017. (if (cdr (elscreen-get-screen-to-name-alist))
  8018. (sort
  8019. (loop for sname in (elscreen-get-screen-to-name-alist)
  8020. append (list (format "[%d] %s" (car sname) (cdr sname))))
  8021. #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
  8022. (action
  8023. . (("Change Screen" .
  8024. (lambda (candidate)
  8025. (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
  8026. ("Kill Screen(s)" .
  8027. (lambda (candidate)
  8028. (dolist (i (anything-marked-candidates))
  8029. (elscreen-goto (- (aref i 1) (aref "0" 0)))
  8030. (elscreen-kill))))
  8031. ("Only Screen" .
  8032. (lambda (candidate)
  8033. (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
  8034. (elscreen-kill-others)))))))
  8035. ;;;; <System>
  8036. ;;; Top (process)
  8037. (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
  8038. "Top command (batch mode). %s is replaced with `frame-width'.")
  8039. (defvar anything-c-source-top
  8040. '((name . "Top (Press C-c C-u to refresh)")
  8041. (init . anything-c-top-init)
  8042. (candidates-in-buffer)
  8043. (display-to-real . anything-c-top-display-to-real)
  8044. (persistent-action . anything-c-top-sh-persistent-action)
  8045. (persistent-help . "SIGTERM")
  8046. (action
  8047. ("kill (TERM)" . (lambda (pid)
  8048. (anything-c-top-sh (format "kill -TERM %s" pid))))
  8049. ("kill (KILL)" . (lambda (pid)
  8050. (anything-c-top-sh (format "kill -KILL %s" pid))))
  8051. ("Copy PID" . (lambda (pid) (kill-new pid))))))
  8052. (defun anything-c-top-sh (cmd)
  8053. (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
  8054. (defun anything-c-top-sh-persistent-action (pid)
  8055. (delete-other-windows)
  8056. (anything-c-top-sh (format "kill -TERM %s" pid))
  8057. (anything-force-update))
  8058. (defun anything-c-top-init ()
  8059. (with-current-buffer (anything-candidate-buffer 'global)
  8060. (call-process-shell-command
  8061. (format anything-c-top-command
  8062. (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
  8063. nil (current-buffer))))
  8064. (defun anything-c-top-display-to-real (line)
  8065. (car (split-string line)))
  8066. ;;; Timers
  8067. (defvar anything-c-source-absolute-time-timers
  8068. '((name . "Absolute Time Timers")
  8069. (candidates . timer-list)
  8070. (type . timer)))
  8071. (defvar anything-c-source-idle-time-timers
  8072. '((name . "Idle Time Timers")
  8073. (candidates . timer-idle-list)
  8074. (type . timer)))
  8075. (defun anything-c-timer-real-to-display (timer)
  8076. (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay)
  8077. (append timer nil) ;use `append' to convert vector->list
  8078. (format "%s repeat=%5S %s(%s)"
  8079. (let ((time (list t1 t2 t3)))
  8080. (if idle-delay
  8081. (format-time-string "idle-for=%5s" time)
  8082. (format-time-string "%m/%d %T" time)))
  8083. repeat-delay
  8084. func
  8085. (mapconcat 'prin1-to-string args " "))))
  8086. ;;; X RandR resolution change
  8087. ;;
  8088. ;;
  8089. ;;; FIXME I do not care multi-display.
  8090. (defun anything-c-xrandr-info ()
  8091. "Return a pair with current X screen number and current X display name."
  8092. (with-temp-buffer
  8093. (call-process "xrandr" nil (current-buffer) nil
  8094. "--current")
  8095. (let (screen output)
  8096. (goto-char (point-min))
  8097. (save-excursion
  8098. (when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t)
  8099. (setq screen (match-string 2))))
  8100. (when (re-search-forward "^\\(.*\\) connected" nil t)
  8101. (setq output (match-string 1)))
  8102. (list screen output))))
  8103. (defun anything-c-xrandr-screen ()
  8104. "Return current X screen number."
  8105. (car (anything-c-xrandr-info)))
  8106. (defun anything-c-xrandr-output ()
  8107. "Return current X display name."
  8108. (cadr (anything-c-xrandr-info)))
  8109. (defvar anything-c-source-xrandr-change-resolution
  8110. '((name . "Change Resolution")
  8111. (candidates
  8112. . (lambda ()
  8113. (with-temp-buffer
  8114. (call-process "xrandr" nil (current-buffer) nil
  8115. "--screen" (anything-c-xrandr-screen) "-q")
  8116. (goto-char 1)
  8117. (loop with modes = nil
  8118. while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t)
  8119. for mode = (match-string 1)
  8120. unless (member mode modes)
  8121. collect mode into modes
  8122. finally return modes))))
  8123. (action
  8124. ("Change Resolution"
  8125. . (lambda (mode)
  8126. (call-process "xrandr" nil nil nil
  8127. "--screen" (anything-c-xrandr-screen)
  8128. "--output" (anything-c-xrandr-output)
  8129. "--mode" mode))))))
  8130. ;;; Xfont selection
  8131. ;;
  8132. ;;
  8133. (defun anything-c-persistent-xfont-action (elm)
  8134. "Show current font temporarily"
  8135. (let ((current-font (cdr (assoc 'font (frame-parameters))))
  8136. (default-font elm))
  8137. (unwind-protect
  8138. (progn (set-frame-font default-font 'keep-size) (sit-for 2))
  8139. (set-frame-font current-font))))
  8140. (defvar anything-c-xfonts-cache nil)
  8141. (defvar anything-c-source-xfonts
  8142. '((name . "X Fonts")
  8143. (init . (lambda ()
  8144. (unless anything-c-xfonts-cache
  8145. (setq anything-c-xfonts-cache
  8146. (x-list-fonts "*")))))
  8147. (candidates . anything-c-xfonts-cache)
  8148. (action . (("Copy to kill ring" . (lambda (elm)
  8149. (kill-new elm)))
  8150. ("Set Font" . (lambda (elm)
  8151. (kill-new elm)
  8152. (set-frame-font elm 'keep-size)
  8153. (message "New font have been copied to kill ring")))))
  8154. (persistent-action . anything-c-persistent-xfont-action)
  8155. (persistent-help . "Switch to this font temporarily")))
  8156. ;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟
  8157. ;;
  8158. ;;
  8159. (defvar anything-c-ucs-max-len 0)
  8160. (defun anything-c-calculate-ucs-max-len ()
  8161. "Calculate the length of longest `ucs-names' candidate."
  8162. (loop with count = 0
  8163. for (n . v) in (ucs-names)
  8164. for len = (length n)
  8165. if (> len count)
  8166. do (setq count len)
  8167. finally return count))
  8168. (defun anything-c-ucs-init ()
  8169. "Initialize an anything buffer with ucs symbols.
  8170. Only math* symbols are collected."
  8171. (unless (> anything-c-ucs-max-len 0)
  8172. (setq anything-c-ucs-max-len
  8173. (anything-c-calculate-ucs-max-len)))
  8174. (with-current-buffer (anything-candidate-buffer
  8175. (get-buffer-create "*anything ucs*"))
  8176. ;; `ucs-names' fn will not run again, data is cached in
  8177. ;; var `ucs-names'.
  8178. (loop for (n . v) in (ucs-names)
  8179. for len = (length n)
  8180. for diff = (+ (- anything-c-ucs-max-len len) 2)
  8181. unless (string= "" n)
  8182. do (progn (insert (concat
  8183. n ":"
  8184. (make-string
  8185. diff ? )))
  8186. (ucs-insert v)
  8187. (insert "\n")))))
  8188. (defun anything-c-ucs-forward-char (candidate)
  8189. (with-anything-current-buffer
  8190. (forward-char 1)))
  8191. (defun anything-c-ucs-backward-char (candidate)
  8192. (with-anything-current-buffer
  8193. (forward-char -1)))
  8194. (defun anything-c-ucs-delete-backward (candidate)
  8195. (with-anything-current-buffer
  8196. (delete-char -1)))
  8197. (defun anything-c-ucs-insert-char (candidate)
  8198. (with-anything-current-buffer
  8199. (insert
  8200. (replace-regexp-in-string
  8201. " " ""
  8202. (cadr (split-string candidate ":"))))))
  8203. (defun anything-c-ucs-persistent-insert ()
  8204. (interactive)
  8205. (anything-attrset 'action-insert 'anything-c-ucs-insert-char)
  8206. (anything-execute-persistent-action 'action-insert))
  8207. (defun anything-c-ucs-persistent-forward ()
  8208. (interactive)
  8209. (anything-attrset 'action-forward 'anything-c-ucs-forward-char)
  8210. (anything-execute-persistent-action 'action-forward))
  8211. (defun anything-c-ucs-persistent-backward ()
  8212. (interactive)
  8213. (anything-attrset 'action-back 'anything-c-ucs-backward-char)
  8214. (anything-execute-persistent-action 'action-back))
  8215. (defun anything-c-ucs-persistent-delete ()
  8216. (interactive)
  8217. (anything-attrset 'action-delete 'anything-c-ucs-delete-backward)
  8218. (anything-execute-persistent-action 'action-delete))
  8219. (defvar anything-c-source-ucs
  8220. '((name . "Ucs names")
  8221. (init . anything-c-ucs-init)
  8222. (candidate-number-limit . 9999)
  8223. (candidates-in-buffer)
  8224. (mode-line . anything-c-ucs-mode-line-string)
  8225. (action . (("Insert" . anything-c-ucs-insert-char)
  8226. ("Forward char" . anything-c-ucs-forward-char)
  8227. ("Backward char" . anything-c-ucs-backward-char)
  8228. ("Delete char backward" . anything-c-ucs-delete-backward))))
  8229. "Source for collecting `ucs-names' math symbols.")
  8230. ;;; Emacs process
  8231. ;;
  8232. ;;
  8233. (defvar anything-c-source-emacs-process
  8234. '((name . "Emacs Process")
  8235. (candidates . (lambda () (mapcar #'process-name (process-list))))
  8236. (persistent-action . (lambda (elm)
  8237. (delete-process (get-process elm))
  8238. (anything-delete-current-selection)))
  8239. (persistent-help . "Kill Process")
  8240. (action ("Kill Process" . (lambda (elm)
  8241. (delete-process (get-process elm)))))))
  8242. ;;; World time
  8243. ;;
  8244. ;;
  8245. (defvar anything-c-source-time-world
  8246. '((name . "Time World List")
  8247. (init . (lambda ()
  8248. (let ((anything-buffer (anything-candidate-buffer 'global)))
  8249. (with-current-buffer anything-buffer
  8250. (display-time-world-display display-time-world-list)))))
  8251. (candidates-in-buffer)))
  8252. ;;; Anything interface for Debian/Ubuntu packages (apt-*)
  8253. ;;
  8254. ;;
  8255. (defvar anything-c-source-apt
  8256. '((name . "APT")
  8257. (init . anything-c-apt-init)
  8258. (candidates-in-buffer)
  8259. (candidate-transformer anything-c-apt-candidate-transformer)
  8260. (display-to-real . anything-c-apt-display-to-real)
  8261. (requires-pattern . 2)
  8262. (update . anything-c-apt-refresh)
  8263. (action
  8264. ("Show package description" . anything-c-apt-cache-show)
  8265. ("Install package" . anything-c-apt-install)
  8266. ("Reinstall package" . anything-c-apt-reinstall)
  8267. ("Remove package" . anything-c-apt-uninstall)
  8268. ("Purge package" . anything-c-apt-purge))
  8269. (persistent-action . anything-c-apt-persistent-action)
  8270. (persistent-help . "Show package description")))
  8271. (defvar anything-c-apt-query "emacs")
  8272. (defvar anything-c-apt-search-command "apt-cache search '%s'")
  8273. (defvar anything-c-apt-show-command "apt-cache show '%s'")
  8274. (defvar anything-c-apt-installed-packages nil)
  8275. (defvar anything-c-apt-all-packages nil)
  8276. (defvar anything-c-apt-input-history nil)
  8277. (defun anything-c-apt-refresh ()
  8278. "Refresh installed candidates list."
  8279. (setq anything-c-apt-installed-packages nil)
  8280. (setq anything-c-apt-all-packages nil))
  8281. (defun anything-c-apt-persistent-action (candidate)
  8282. "Persistent action for APT source."
  8283. (anything-c-apt-cache-show candidate))
  8284. (defun anything-c-apt-candidate-transformer (candidates)
  8285. "Show installed CANDIDATES and the ones to deinstall in a different color."
  8286. (loop for cand in candidates
  8287. for name = (anything-c-apt-display-to-real cand)
  8288. collect (cond ((string= (assoc-default
  8289. name anything-c-apt-installed-packages)
  8290. "deinstall")
  8291. (propertize cand 'face 'anything-apt-deinstalled))
  8292. ((string= (assoc-default
  8293. name anything-c-apt-installed-packages)
  8294. "install")
  8295. (propertize cand 'face 'anything-apt-installed))
  8296. (t cand))))
  8297. (defun anything-c-apt-init ()
  8298. "Initialize list of debian packages."
  8299. (let ((query ""))
  8300. (unless (and anything-c-apt-installed-packages
  8301. anything-c-apt-all-packages)
  8302. (message "Loading package list...")
  8303. (setq anything-c-apt-installed-packages
  8304. (with-temp-buffer
  8305. (call-process-shell-command "dpkg --get-selections"
  8306. nil (current-buffer))
  8307. (loop for i in (split-string (buffer-string) "\n" t)
  8308. for p = (split-string i)
  8309. collect (cons (car p) (cadr p)))))
  8310. (setq anything-c-apt-all-packages
  8311. (with-current-buffer
  8312. (anything-candidate-buffer
  8313. (get-buffer-create (format "*anything-apt*")))
  8314. (erase-buffer)
  8315. (call-process-shell-command
  8316. (format anything-c-apt-search-command query)
  8317. nil (current-buffer))))
  8318. (message "Loading package list done")
  8319. (sit-for 0.5))))
  8320. (defun anything-c-apt-display-to-real (line)
  8321. "Return only name of a debian package.
  8322. LINE is displayed like:
  8323. package name - description."
  8324. (car (split-string line " - ")))
  8325. (defun anything-c-shell-command-if-needed (command)
  8326. "Run shell command COMMAND to describe package.
  8327. If a buffer named COMMAND already exists, just switch to it."
  8328. (let ((buf (get-buffer command)))
  8329. (anything-c-switch-to-buffer (get-buffer-create command))
  8330. (unless buf (insert (shell-command-to-string command)))))
  8331. (defun anything-c-apt-cache-show (package)
  8332. "Show information on apt package PACKAGE."
  8333. (anything-c-shell-command-if-needed
  8334. (format anything-c-apt-show-command package)))
  8335. (defun anything-c-apt-install (package)
  8336. "Run 'apt-get install' shell command on PACKAGE."
  8337. (anything-c-apt-generic-action :action 'install))
  8338. (defun anything-c-apt-reinstall (package)
  8339. "Run 'apt-get install --reinstall' shell command on PACKAGE."
  8340. (anything-c-apt-generic-action :action 'reinstall))
  8341. (defun anything-c-apt-uninstall (package)
  8342. "Run 'apt-get remove' shell command on PACKAGE."
  8343. (anything-c-apt-generic-action :action 'uninstall))
  8344. (defun anything-c-apt-purge (package)
  8345. "Run 'apt-get purge' shell command on PACKAGE."
  8346. (anything-c-apt-generic-action :action 'purge))
  8347. (defun* anything-c-apt-generic-action (&key action)
  8348. "Run 'apt-get ACTION'.
  8349. Support install, remove and purge actions."
  8350. (ansi-term (getenv "SHELL") "anything apt")
  8351. (term-line-mode)
  8352. (let ((command (case action
  8353. ('install "sudo apt-get install ")
  8354. ('reinstall "sudo apt-get install --reinstall ")
  8355. ('uninstall "sudo apt-get remove ")
  8356. ('purge "sudo apt-get purge ")
  8357. (t (error "Unknow action"))))
  8358. (beg (point))
  8359. end
  8360. (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
  8361. (anything-marked-candidates) " ")))
  8362. (goto-char (point-max))
  8363. (insert (concat command cand-list))
  8364. (setq end (point))
  8365. (if (y-or-n-p (format "%s package" (symbol-name action)))
  8366. (progn
  8367. (setq anything-c-external-commands-list nil)
  8368. (setq anything-c-apt-installed-packages nil)
  8369. (term-char-mode) (term-send-input))
  8370. (delete-region beg end) (term-send-eof) (kill-buffer))))
  8371. ;; (anything-c-apt-install "jed")
  8372. ;;; Anything UI for gentoo portage.
  8373. ;;
  8374. ;;
  8375. (defvar anything-c-gentoo-use-flags nil)
  8376. (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
  8377. (defvar anything-c-cache-gentoo nil)
  8378. (defvar anything-c-cache-world nil)
  8379. (defvar anything-c-source-gentoo
  8380. '((name . "Portage sources")
  8381. (init . (lambda ()
  8382. (get-buffer-create anything-c-gentoo-buffer)
  8383. (unless anything-c-cache-gentoo
  8384. (anything-c-gentoo-setup-cache))
  8385. (unless anything-c-cache-world
  8386. (setq anything-c-cache-world (anything-c-gentoo-get-world)))
  8387. (anything-c-gentoo-init-list)))
  8388. (candidates-in-buffer)
  8389. (match . identity)
  8390. (candidate-transformer anything-c-highlight-world)
  8391. (action . (("Show package" . (lambda (elm)
  8392. (anything-c-gentoo-eshell-action elm "eix")))
  8393. ("Show history" . (lambda (elm)
  8394. (if (member elm anything-c-cache-world)
  8395. (anything-c-gentoo-eshell-action elm "genlop -qe")
  8396. (message "No infos on packages not yet installed"))))
  8397. ("Copy in kill-ring" . kill-new)
  8398. ("insert at point" . insert)
  8399. ("Browse HomePage" . (lambda (elm)
  8400. (let ((urls (anything-c-gentoo-get-url elm)))
  8401. (browse-url (anything-comp-read "Url: " urls :must-match t)))))
  8402. ("Show extra infos" . (lambda (elm)
  8403. (if (member elm anything-c-cache-world)
  8404. (anything-c-gentoo-eshell-action elm "genlop -qi")
  8405. (message "No infos on packages not yet installed"))))
  8406. ("Show use flags" . (lambda (elm)
  8407. (anything-c-gentoo-default-action elm "equery" "-C" "u")
  8408. (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
  8409. (font-lock-mode 1)))
  8410. ("Run emerge pretend" . (lambda (elm)
  8411. (anything-c-gentoo-eshell-action elm "emerge -p")))
  8412. ("Emerge" . (lambda (elm)
  8413. (anything-gentoo-install elm :action 'install)))
  8414. ("Unmerge" . (lambda (elm)
  8415. (anything-gentoo-install elm :action 'uninstall)))
  8416. ("Show dependencies" . (lambda (elm)
  8417. (anything-c-gentoo-default-action elm "equery" "-C" "d")))
  8418. ("Show related files" . (lambda (elm)
  8419. (anything-c-gentoo-default-action elm "equery" "files")))
  8420. ("Refresh" . (lambda (elm)
  8421. (anything-c-gentoo-setup-cache)
  8422. (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
  8423. (defun* anything-gentoo-install (candidate &key action)
  8424. (setq anything-c-external-commands-list nil)
  8425. (ansi-term (getenv "SHELL") "Gentoo emerge")
  8426. (term-line-mode)
  8427. (let ((command (case action
  8428. ('install "sudo emerge -av ")
  8429. ('uninstall "sudo emerge -avC ")
  8430. (t (error "Unknow action"))))
  8431. (elms (mapconcat 'identity (anything-marked-candidates) " "))
  8432. (beg (point)) end)
  8433. (goto-char (point-max))
  8434. (insert (concat command elms))
  8435. (setq end (point))
  8436. (term-char-mode) (term-send-input)))
  8437. (defun anything-c-gentoo-default-action (elm command &rest args)
  8438. "Gentoo default action that use `anything-c-gentoo-buffer'."
  8439. (if (member elm anything-c-cache-world)
  8440. (progn
  8441. (anything-c-switch-to-buffer anything-c-gentoo-buffer)
  8442. (erase-buffer)
  8443. (let ((com-list (append args (list elm))))
  8444. (apply #'call-process command nil t nil
  8445. com-list)))
  8446. (message "No infos on packages not yet installed")))
  8447. (defvar anything-c-source-use-flags
  8448. '((name . "Use Flags")
  8449. (init . (lambda ()
  8450. (unless anything-c-gentoo-use-flags
  8451. (anything-c-gentoo-setup-use-flags-cache))
  8452. (anything-c-gentoo-get-use)))
  8453. (candidates-in-buffer)
  8454. (match . identity)
  8455. (candidate-transformer anything-c-highlight-local-use)
  8456. (action . (("Description"
  8457. . (lambda (elm)
  8458. (anything-c-switch-to-buffer anything-c-gentoo-buffer)
  8459. (erase-buffer)
  8460. (apply #'call-process "euse" nil t nil
  8461. `("-i"
  8462. ,elm))
  8463. (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
  8464. (font-lock-mode 1)))
  8465. ("Enable"
  8466. . (lambda (elm)
  8467. (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
  8468. ("Disable"
  8469. . (lambda (elm)
  8470. (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
  8471. ("Remove"
  8472. . (lambda (elm)
  8473. (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
  8474. ("Show which dep use this flag"
  8475. . (lambda (elm)
  8476. (anything-c-switch-to-buffer anything-c-gentoo-buffer)
  8477. (erase-buffer)
  8478. (apply #'call-process "equery" nil t nil
  8479. `("-C"
  8480. "h"
  8481. ,elm))))))))
  8482. (defun anything-c-gentoo-init-list ()
  8483. "Initialize buffer with all packages in Portage."
  8484. (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
  8485. (buf (anything-candidate-buffer 'portage-buf)))
  8486. (with-current-buffer buf
  8487. (dolist (i anything-c-cache-gentoo)
  8488. (insert (concat i "\n"))))))
  8489. (defun anything-c-gentoo-setup-cache ()
  8490. "Set up `anything-c-cache-gentoo'"
  8491. (setq anything-c-cache-gentoo
  8492. (split-string (with-temp-buffer
  8493. (call-process "eix" nil t nil
  8494. "--only-names")
  8495. (buffer-string)))))
  8496. (defun anything-c-gentoo-eshell-action (elm command)
  8497. (when (get-buffer "*EShell Command Output*")
  8498. (kill-buffer "*EShell Command Output*"))
  8499. (message "Wait searching...")
  8500. (let ((buf-fname (buffer-file-name anything-current-buffer)))
  8501. (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
  8502. (progn
  8503. (save-window-excursion
  8504. (pop-to-buffer "*scratch*")
  8505. (eshell-command (format "%s %s" command elm)))
  8506. (pop-to-buffer "*EShell Command Output*"))
  8507. (eshell-command (format "%s %s" command elm)))))
  8508. (defun anything-c-gentoo-get-use ()
  8509. "Initialize buffer with all use flags."
  8510. (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
  8511. (buf (anything-candidate-buffer 'use-buf)))
  8512. (with-current-buffer buf
  8513. (dolist (i anything-c-gentoo-use-flags)
  8514. (insert (concat i "\n"))))))
  8515. (defun anything-c-gentoo-setup-use-flags-cache ()
  8516. "Setup `anything-c-gentoo-use-flags'"
  8517. (setq anything-c-gentoo-use-flags
  8518. (split-string (with-temp-buffer
  8519. (call-process "eix" nil t nil
  8520. "--print-all-useflags")
  8521. (buffer-string)))))
  8522. (defun anything-c-gentoo-get-url (elm)
  8523. "Return a list of urls from eix output."
  8524. (loop
  8525. with url-list = (split-string
  8526. (with-temp-buffer
  8527. (call-process "eix" nil t nil
  8528. elm "--format" "<homepage>\n")
  8529. (buffer-string)))
  8530. with all
  8531. for i in url-list
  8532. when (and (string-match "^http://.*" i)
  8533. (not (member i all)))
  8534. collect i into all
  8535. finally return all))
  8536. (defun anything-c-gentoo-get-world ()
  8537. "Return list of all installed package on your system."
  8538. (split-string (with-temp-buffer
  8539. (call-process "qlist" nil t nil
  8540. "-I")
  8541. (buffer-string))))
  8542. (defun anything-c-gentoo-get-local-use ()
  8543. (split-string (with-temp-buffer
  8544. (call-process "portageq" nil t nil
  8545. "envvar"
  8546. "USE")
  8547. (buffer-string))))
  8548. (defun anything-c-highlight-world (eix)
  8549. "Highlight all installed package."
  8550. (loop for i in eix
  8551. if (member i anything-c-cache-world)
  8552. collect (propertize i 'face 'anything-gentoo-match-face)
  8553. else
  8554. collect i))
  8555. (defun anything-c-highlight-local-use (use-flags)
  8556. (let ((local-uses (anything-c-gentoo-get-local-use)))
  8557. (loop for i in use-flags
  8558. if (member i local-uses)
  8559. collect (propertize i 'face 'anything-gentoo-match-face)
  8560. else
  8561. collect i)))
  8562. ;;; Anything ratpoison UI
  8563. ;;
  8564. ;;
  8565. (defvar anything-c-source-ratpoison-commands
  8566. '((name . "Ratpoison Commands")
  8567. (init . anything-c-ratpoison-commands-init)
  8568. (candidates-in-buffer)
  8569. (action ("Execute the command" . anything-c-ratpoison-commands-execute))
  8570. (display-to-real . anything-c-ratpoison-commands-display-to-real)
  8571. (candidate-number-limit)))
  8572. (defun anything-c-ratpoison-commands-init ()
  8573. (unless (anything-candidate-buffer)
  8574. (with-current-buffer (anything-candidate-buffer 'global)
  8575. ;; with ratpoison prefix key
  8576. (save-excursion
  8577. (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
  8578. (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
  8579. (replace-match "<ratpoison> \\1: \\2"))
  8580. (goto-char (point-max))
  8581. ;; direct binding
  8582. (save-excursion
  8583. (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
  8584. (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
  8585. (replace-match "\\1: \\2")))))
  8586. (defun anything-c-ratpoison-commands-display-to-real (display)
  8587. (and (string-match ": " display)
  8588. (substring display (match-end 0))))
  8589. (defun anything-c-ratpoison-commands-execute (candidate)
  8590. (call-process "ratpoison" nil nil nil "-ic" candidate))
  8591. ;;; Anything `completing-read' replacement
  8592. ;;
  8593. ;;
  8594. (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
  8595. "Convert COLLECTION to list removing elements that don't match TEST.
  8596. See `anything-comp-read' about supported COLLECTION arguments.
  8597. SORT-FN is a predicate to sort COLLECTION.
  8598. ALISTP when non--nil will not use `all-completions' to collect
  8599. candidates because it doesn't handle alists correctly for anything.
  8600. i.e In `all-completions' the keys \(cars of elements\)
  8601. are the possible completions. In anything we want to use the cdr instead
  8602. like \(display . real\).
  8603. e.g
  8604. \(setq A '((a . 1) (b . 2) (c . 3)))
  8605. ==>((a . 1) (b . 2) (c . 3))
  8606. \(anything-comp-read \"test: \" A :alistp nil
  8607. :exec-when-only-one t
  8608. :initial-input \"a\")
  8609. ==>\"a\"
  8610. \(anything-comp-read \"test: \" A :alistp t
  8611. :exec-when-only-one t
  8612. :initial-input \"1\")
  8613. ==>\"1\"
  8614. See docstring of `all-completions' for more info.
  8615. If COLLECTION is an `obarray', a TEST should be needed. See `obarray'."
  8616. (let ((cands
  8617. (cond ((and (eq collection obarray) test)
  8618. (all-completions "" collection test))
  8619. ((and (vectorp collection) test)
  8620. (loop for i across collection when (funcall test i) collect i))
  8621. ((vectorp collection)
  8622. (loop for i across collection collect i))
  8623. ((and alistp test)
  8624. (loop for i in collection when (funcall test i) collect i))
  8625. ((and (symbolp collection) (boundp collection))
  8626. (symbol-value collection))
  8627. (alistp collection)
  8628. ((and collection test)
  8629. (all-completions "" collection test))
  8630. (t (all-completions "" collection)))))
  8631. (if sort-fn (sort cands sort-fn) cands)))
  8632. (defun anything-cr-default-transformer (candidates source)
  8633. "Default filter candidate function for `anything-comp-read'.
  8634. Do nothing, just return candidate list unmodified."
  8635. candidates)
  8636. (defun* anything-comp-read (prompt collection
  8637. &key
  8638. test
  8639. initial-input
  8640. default
  8641. preselect
  8642. (buffer "*Anything Completions*")
  8643. must-match
  8644. (requires-pattern 0)
  8645. (history nil)
  8646. input-history
  8647. (persistent-action nil)
  8648. (persistent-help "DoNothing")
  8649. (mode-line anything-mode-line-string)
  8650. (keymap anything-map)
  8651. (name "Anything Completions")
  8652. candidates-in-buffer
  8653. exec-when-only-one
  8654. (volatile t)
  8655. sort
  8656. (fc-transformer 'anything-cr-default-transformer)
  8657. (marked-candidates nil)
  8658. (alistp t))
  8659. "Read a string in the minibuffer, with anything completion.
  8660. It is anything `completing-read' equivalent.
  8661. - PROMPT is the prompt name to use.
  8662. - COLLECTION can be a list, vector, obarray or hash-table.
  8663. It can be also a function that receives three arguments:
  8664. the values string, predicate and t. See `all-completions' for more details.
  8665. Keys description:
  8666. - TEST: A predicate called with one arg i.e candidate.
  8667. - INITIAL-INPUT: Same as input arg in `anything'.
  8668. - PRESELECT: See preselect arg of `anything'.
  8669. - DEFAULT: This option is used only for compatibility with regular
  8670. Emacs `completing-read'.
  8671. - BUFFER: Name of anything-buffer.
  8672. - MUST-MATCH: Candidate selected must be one of COLLECTION.
  8673. - REQUIRES-PATTERN: Same as anything attribute, default is 0.
  8674. - HISTORY: A list containing specific history, default is nil.
  8675. When it is non--nil, all elements of HISTORY are displayed in
  8676. a special source before COLLECTION.
  8677. - INPUT-HISTORY: A symbol. the minibuffer input history will be
  8678. stored there, if nil or not provided, `minibuffer-history'
  8679. will be used instead.
  8680. - PERSISTENT-ACTION: A function called with one arg i.e candidate.
  8681. - PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
  8682. - MODE-LINE: A string or list to display in mode line.
  8683. (See `anything-mode-line-string')
  8684. - KEYMAP: A keymap to use in this `anything-comp-read'.
  8685. (The keymap will be shared with history source)
  8686. - NAME: The name related to this local source.
  8687. - EXEC-WHEN-ONLY-ONE: Bound `anything-execute-action-at-once-if-one'
  8688. to non--nil. (possibles values are t or nil).
  8689. - VOLATILE: Use volatile attribute \(enabled by default\).
  8690. - SORT: A predicate to give to `sort' e.g `string-lessp'.
  8691. - FC-TRANSFORMER: A `filtered-candidate-transformer' function.
  8692. - MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
  8693. - ALISTP: \(default is non--nil\) See `anything-comp-read-get-candidates'.
  8694. - CANDIDATES-IN-BUFFER: when non--nil use a source build with
  8695. `anything-candidates-in-buffer' which is much faster.
  8696. Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil.
  8697. Any prefix args passed during `anything-comp-read' invocation will be recorded
  8698. in `anything-current-prefix-arg', otherwise if prefix args were given before
  8699. `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
  8700. That's mean you can pass prefix args before or after calling a command
  8701. that use `anything-comp-read' See `anything-M-x' for example."
  8702. (when (get-buffer anything-action-buffer)
  8703. (kill-buffer anything-action-buffer))
  8704. (flet ((action-fn (candidate)
  8705. (if marked-candidates
  8706. (anything-marked-candidates)
  8707. (identity candidate))))
  8708. ;; Assume completion have been already required,
  8709. ;; so always use 'confirm.
  8710. (when (eq must-match 'confirm-after-completion)
  8711. (setq must-match 'confirm))
  8712. (let* ((minibuffer-completion-confirm must-match)
  8713. (must-match-map (when must-match
  8714. (let ((map (make-sparse-keymap)))
  8715. (define-key map (kbd "RET")
  8716. 'anything-confirm-and-exit-minibuffer)
  8717. map)))
  8718. (anything-map (if must-match-map
  8719. (make-composed-keymap
  8720. must-match-map (or keymap anything-map))
  8721. (or keymap anything-map)))
  8722. (src-hist `((name . ,(format "%s History" name))
  8723. (candidates
  8724. . (lambda ()
  8725. (let ((all (anything-comp-read-get-candidates
  8726. history nil nil ,alistp)))
  8727. (delete
  8728. ""
  8729. (anything-fast-remove-dups
  8730. (if (and default (not (string= default "")))
  8731. (delq nil (cons default
  8732. (delete default all)))
  8733. all)
  8734. :test 'equal)))))
  8735. (filtered-candidate-transformer
  8736. . (lambda (candidates sources)
  8737. (loop for i in candidates
  8738. do (set-text-properties 0 (length i) nil i)
  8739. collect i)))
  8740. (persistent-action . ,persistent-action)
  8741. (persistent-help . ,persistent-help)
  8742. (mode-line . ,mode-line)
  8743. (action . ,'action-fn)))
  8744. (src `((name . ,name)
  8745. (candidates
  8746. . (lambda ()
  8747. (let ((cands (anything-comp-read-get-candidates
  8748. collection test sort alistp)))
  8749. (unless (or must-match (string= anything-pattern ""))
  8750. (setq cands (append (list anything-pattern) cands)))
  8751. (if (and default (not (string= default "")))
  8752. (delq nil (cons default (delete default cands)))
  8753. cands))))
  8754. (filtered-candidate-transformer ,fc-transformer)
  8755. (requires-pattern . ,requires-pattern)
  8756. (persistent-action . ,persistent-action)
  8757. (persistent-help . ,persistent-help)
  8758. (mode-line . ,mode-line)
  8759. (action . ,'action-fn)))
  8760. (src-1 `((name . ,name)
  8761. (init
  8762. . (lambda ()
  8763. (let ((cands (anything-comp-read-get-candidates
  8764. collection test sort alistp)))
  8765. (unless (or must-match (string= anything-pattern ""))
  8766. (setq cands (append (list anything-pattern) cands)))
  8767. (with-current-buffer (anything-candidate-buffer 'global)
  8768. (loop for i in
  8769. (if (and default (not (string= default "")))
  8770. (delq nil (cons default (delete default cands)))
  8771. cands)
  8772. do (insert (concat i "\n")))))))
  8773. (candidates-in-buffer)
  8774. (filtered-candidate-transformer ,fc-transformer)
  8775. (requires-pattern . ,requires-pattern)
  8776. (persistent-action . ,persistent-action)
  8777. (persistent-help . ,persistent-help)
  8778. (mode-line . ,mode-line)
  8779. (action . ,'action-fn)))
  8780. (src-list (list src-hist
  8781. (if candidates-in-buffer
  8782. src-1
  8783. (if volatile
  8784. (append src '((volatile)))
  8785. src))))
  8786. (anything-execute-action-at-once-if-one exec-when-only-one))
  8787. (or
  8788. (anything
  8789. :sources src-list
  8790. :input initial-input
  8791. :default default
  8792. :preselect preselect
  8793. :prompt prompt
  8794. :resume 'noresume
  8795. :keymap anything-map
  8796. :history (and (symbolp input-history) input-history)
  8797. :buffer buffer)
  8798. (when (and (eq anything-exit-status 0)
  8799. (eq must-match 'confirm))
  8800. ;; Return empty string only if it is the DEFAULT
  8801. ;; value and anything-pattern is empty.
  8802. ;; otherwise return anything-pattern
  8803. (if (and (string= anything-pattern "") default)
  8804. default (identity anything-pattern)))
  8805. (unless (or (eq anything-exit-status 1)
  8806. must-match) ; FIXME this should not be needed now.
  8807. default)
  8808. (keyboard-quit)))))
  8809. ;; Generic completing-read
  8810. ;;
  8811. ;; Support also function as collection.
  8812. ;; e.g M-x man is supported.
  8813. ;; Support hash-table and vectors as collection.
  8814. ;; NOTE:
  8815. ;; Some crap emacs functions may not be supported
  8816. ;; like ffap-alternate-file (bad use of completing-read)
  8817. ;; and maybe others.
  8818. ;; Provide a mode `anything-completion-mode' which turn on
  8819. ;; anything in all `completing-read' and `read-file-name' in Emacs.
  8820. ;;
  8821. (defvar anything-completion-mode-string " AC")
  8822. (defvar anything-completion-mode-quit-message
  8823. "Anything completion disabled")
  8824. (defvar anything-completion-mode-start-message
  8825. "Anything completion enabled")
  8826. ;;; Specialized handlers
  8827. ;;
  8828. ;;
  8829. (defun anything-completing-read-symbols
  8830. (prompt collection test require-match init
  8831. hist default inherit-input-method name buffer)
  8832. "Specialized function for fast symbols completion in `ac-mode'."
  8833. (or
  8834. (anything
  8835. :sources `((name . ,name)
  8836. (init . (lambda ()
  8837. (with-current-buffer (anything-candidate-buffer 'global)
  8838. (goto-char (point-min))
  8839. (when (and default (stringp default)
  8840. ;; Some defaults args result as
  8841. ;; (symbol-name nil) == "nil".
  8842. ;; e.g debug-on-entry.
  8843. (not (string= default "nil"))
  8844. (not (string= default "")))
  8845. (insert (concat default "\n")))
  8846. (loop with all = (all-completions "" collection test)
  8847. for sym in all
  8848. unless (and default (eq sym default))
  8849. do (insert (concat sym "\n"))))))
  8850. (persistent-action . anything-lisp-completion-persistent-action)
  8851. (persistent-help . "Show brief doc in mode-line")
  8852. (candidates-in-buffer)
  8853. (action . identity))
  8854. :prompt prompt
  8855. :buffer buffer
  8856. :input init
  8857. :history hist
  8858. :resume 'noresume
  8859. :default (or default ""))
  8860. (keyboard-quit)))
  8861. ;;; Generic completing read
  8862. ;;
  8863. ;;
  8864. (defun anything-completing-read-default-1
  8865. (prompt collection test require-match
  8866. init hist default inherit-input-method
  8867. name buffer &optional cands-in-buffer exec-when-only-one)
  8868. "Call `anything-comp-read' with same args as `completing-read'.
  8869. Extra optional arg CANDS-IN-BUFFER mean use `candidates-in-buffer'
  8870. method which is faster.
  8871. It should be used when candidate list don't need to rebuild dynamically."
  8872. (let ((history (or (car-safe hist) hist)))
  8873. (anything-comp-read
  8874. prompt collection
  8875. :test test
  8876. :history history
  8877. :input-history history
  8878. :must-match require-match
  8879. :alistp nil ; Be sure `all-completions' is used.
  8880. :name name
  8881. :requires-pattern (if (and (string= default "")
  8882. (or (eq require-match 'confirm)
  8883. (eq require-match
  8884. 'confirm-after-completion)))
  8885. 1 0)
  8886. :candidates-in-buffer cands-in-buffer
  8887. :exec-when-only-one exec-when-only-one
  8888. :buffer buffer
  8889. ;; If DEF is not provided, fallback to empty string
  8890. ;; to avoid `thing-at-point' to be appended on top of list
  8891. :default (or default "")
  8892. ;; Use `regexp-quote' to fix initial input
  8893. ;; with special characters (e.g nnimap+gmail:)
  8894. :initial-input (and (stringp init) (regexp-quote init)))))
  8895. (defun anything-completing-read-with-cands-in-buffer
  8896. (prompt collection test require-match
  8897. init hist default inherit-input-method
  8898. name buffer)
  8899. "Same as `anything-completing-read-default-1' but use candidates-in-buffer."
  8900. ;; Some commands like find-tag may use `read-file-name' from inside
  8901. ;; the calculation of collection. in this case it clash with
  8902. ;; candidates-in-buffer that reuse precedent data (files) which is wrong.
  8903. ;; So (re)calculate collection outside of main anything-session.
  8904. (let ((cands (all-completions "" collection)))
  8905. (anything-completing-read-default-1 prompt cands test require-match
  8906. init hist default inherit-input-method
  8907. name buffer t)))
  8908. (defun* anything-completing-read-default
  8909. (prompt collection &optional
  8910. predicate require-match
  8911. initial-input hist def
  8912. inherit-input-method)
  8913. "An anything replacement of `completing-read'.
  8914. This function should be used only as a `completing-read-function'.
  8915. Don't use it directly, use instead `anything-comp-read' in your programs.
  8916. See documentation of `completing-read' and `all-completions' for details."
  8917. (declare (special anything-completion-mode))
  8918. (let* ((current-command this-command)
  8919. (str-command (symbol-name current-command))
  8920. (buf-name (format "*ac-mode-%s*" str-command))
  8921. (entry (assq current-command
  8922. anything-completing-read-handlers-alist))
  8923. (def-com (cdr-safe entry))
  8924. (str-defcom (and def-com (symbol-name def-com)))
  8925. (def-args (list prompt collection predicate require-match
  8926. initial-input hist def inherit-input-method))
  8927. ;; Append the two extra args needed to set the buffer and source name
  8928. ;; in anything specialized functions.
  8929. (any-args (append def-args (list str-command buf-name)))
  8930. anything-completion-mode-start-message ; Be quiet
  8931. anything-completion-mode-quit-message
  8932. (minibuffer-completion-table collection)
  8933. (minibuffer-completion-predicate predicate)
  8934. ;; Be sure this pesty *completion* buffer doesn't popup.
  8935. (minibuffer-setup-hook (remove 'minibuffer-completion-help
  8936. minibuffer-setup-hook)))
  8937. (when (eq def-com 'ido) (setq def-com 'ido-completing-read))
  8938. (unless (or (not entry) def-com)
  8939. ;; An entry in *read-handlers-alist exists but have
  8940. ;; a nil value, so we exit from here, disable `ac-mode'
  8941. ;; and run the command again with it original behavior.
  8942. ;; `ac-mode' will be restored on exit.
  8943. (return-from anything-completing-read-default
  8944. (unwind-protect
  8945. (progn
  8946. (ac-mode -1)
  8947. (apply completing-read-function def-args))
  8948. (ac-mode 1))))
  8949. ;; If we use now `completing-read' we MUST turn off `ac-mode'
  8950. ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
  8951. (when (or (eq def-com 'completing-read)
  8952. ;; All specialized functions are prefixed by "anything"
  8953. (and (stringp str-defcom)
  8954. (not (string-match "^anything" str-defcom))))
  8955. (ac-mode -1))
  8956. (unwind-protect
  8957. (cond (;; An anything specialized function exists, run it.
  8958. (and def-com anything-completion-mode)
  8959. (apply def-com any-args))
  8960. (;; Try to handle `ido-completing-read' everywhere.
  8961. (and def-com (eq def-com 'ido-completing-read))
  8962. (setcar (memq collection def-args)
  8963. (all-completions "" collection predicate))
  8964. (apply def-com def-args))
  8965. (;; User set explicitely `completing-read' or something similar
  8966. ;; in *read-handlers-alist, use this with exactly the same
  8967. ;; args as in `completing-read'.
  8968. ;; If we are here `anything-completion-mode' is now disabled.
  8969. def-com
  8970. (apply def-com def-args))
  8971. (t ; Fall back to classic `anything-comp-read'.
  8972. (anything-completing-read-default-1
  8973. prompt collection predicate require-match
  8974. initial-input hist def inherit-input-method
  8975. str-command buf-name)))
  8976. (ac-mode 1)
  8977. ;; When exiting minibuffer, `this-command' is set to
  8978. ;; `anything-exit-minibuffer', which is unwanted when starting
  8979. ;; on another `completing-read', so restore `this-command' to
  8980. ;; initial value when exiting.
  8981. (setq this-command current-command))))
  8982. (defun* anything-generic-read-file-name
  8983. (prompt &optional dir default-filename mustmatch initial predicate)
  8984. "An anything replacement of `read-file-name'."
  8985. (declare (special anything-completion-mode))
  8986. (let* ((default (and default-filename
  8987. (if (listp default-filename)
  8988. (car default-filename)
  8989. default-filename)))
  8990. (init (or default initial dir default-directory))
  8991. (ini-input (and init (expand-file-name init)))
  8992. (current-command this-command)
  8993. (str-command (symbol-name current-command))
  8994. (anything-file-completion-sources
  8995. (cons str-command
  8996. (remove str-command anything-file-completion-sources)))
  8997. (buf-name (format "*ac-mode-%s*" str-command))
  8998. (entry (assq current-command
  8999. anything-completing-read-handlers-alist))
  9000. (def-com (cdr-safe entry))
  9001. (str-defcom (symbol-name def-com))
  9002. (def-args (list prompt dir default-filename mustmatch initial predicate))
  9003. ;; Append the two extra args needed to set the buffer and source name
  9004. ;; in anything specialized functions.
  9005. (any-args (append def-args (list str-command buf-name)))
  9006. (ido-state ido-mode)
  9007. anything-completion-mode-start-message ; Be quiet
  9008. anything-completion-mode-quit-message ; Same here
  9009. fname)
  9010. ;; Some functions that normally call `completing-read' can switch
  9011. ;; brutally to `read-file-name' (e.g find-tag), in this case
  9012. ;; the anything specialized function will fail because it is build
  9013. ;; for `completing-read', so set it to 'incompatible to be sure
  9014. ;; we switch to `anything-c-read-file-name' and don't try to call it
  9015. ;; with wrong number of args.
  9016. (when (and def-com (> (length (help-function-arglist def-com)) 8))
  9017. (setq def-com 'incompatible))
  9018. (when (eq def-com 'ido) (setq def-com 'ido-read-file-name))
  9019. (unless (or (not entry) def-com)
  9020. (return-from anything-generic-read-file-name
  9021. (unwind-protect
  9022. (progn
  9023. (ac-mode -1)
  9024. (apply read-file-name-function def-args))
  9025. (ac-mode 1))))
  9026. ;; If we use now `read-file-name' we MUST turn off `ac-mode'
  9027. ;; to avoid infinite recursion and CRASH. It will be reenabled on exit.
  9028. (when (or (eq def-com 'read-file-name)
  9029. (eq def-com 'ido-read-file-name)
  9030. (and (stringp str-defcom)
  9031. (not (string-match "^anything" str-defcom))))
  9032. (ac-mode -1))
  9033. (unwind-protect
  9034. (setq fname
  9035. (cond (;; A specialized function exists, run it
  9036. ;; with the two extra args specific to anything..
  9037. (and def-com anything-completion-mode
  9038. (not (eq def-com 'ido-read-file-name))
  9039. (not (eq def-com 'incompatible)))
  9040. (apply def-com any-args))
  9041. (;; Def-com value is `ido-read-file-name'
  9042. ;; run it with default args.
  9043. (and def-com (eq def-com 'ido-read-file-name))
  9044. (ido-mode 1)
  9045. (apply def-com def-args))
  9046. (;; Def-com value is `read-file-name'
  9047. ;; run it with default args.
  9048. (eq def-com 'read-file-name)
  9049. (apply def-com def-args))
  9050. (t ; Fall back to classic `anything-c-read-file-name'.
  9051. (anything-c-read-file-name
  9052. prompt
  9053. :name str-command
  9054. :buffer buf-name
  9055. :initial-input (expand-file-name init dir)
  9056. :alistp nil
  9057. :must-match mustmatch
  9058. :test predicate))))
  9059. (ac-mode 1)
  9060. (ido-mode (if ido-state 1 -1))
  9061. ;; Same comment as in `anything-completing-read-default'.
  9062. (setq this-command current-command))
  9063. (if (and mustmatch (not (file-exists-p fname)))
  9064. (if (y-or-n-p "File does not exists, create buffer?")
  9065. fname (error "Abort file does not exists"))
  9066. fname)))
  9067. ;;;###autoload
  9068. (define-minor-mode anything-completion-mode
  9069. "Toggle generic anything completion.
  9070. All functions in Emacs that use `completing-read'
  9071. or `read-file-name' and friends will use anything interface
  9072. when this mode is turned on.
  9073. However you can modify this behavior for functions of your choice
  9074. with `anything-completing-read-handlers-alist'.
  9075. Called with a positive arg, turn on unconditionally, with a
  9076. negative arg turn off.
  9077. You can turn it on with `ac-mode'.
  9078. Some crap emacs functions may not be supported,
  9079. e.g `ffap-alternate-file' and maybe others
  9080. You can add such functions to `anything-completing-read-handlers-alist'
  9081. with a nil value.
  9082. Note: This mode will work only partially on Emacs23."
  9083. :group 'anything
  9084. :global t
  9085. :lighter anything-completion-mode-string
  9086. (declare (special completing-read-function))
  9087. (if anything-completion-mode
  9088. (progn
  9089. (setq completing-read-function 'anything-completing-read-default
  9090. read-file-name-function 'anything-generic-read-file-name)
  9091. (message anything-completion-mode-start-message))
  9092. (setq completing-read-function (and (fboundp 'completing-read-default)
  9093. 'completing-read-default)
  9094. read-file-name-function (and (fboundp 'read-file-name-default)
  9095. 'read-file-name-default))
  9096. (message anything-completion-mode-quit-message)))
  9097. (defalias 'ac-mode 'anything-completion-mode)
  9098. ;;; Eshell completion.
  9099. ;;
  9100. ;; Enable like this in .emacs:
  9101. ;;
  9102. ;; (add-hook 'eshell-mode-hook
  9103. ;; #'(lambda ()
  9104. ;; (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
  9105. ;;
  9106. (defvar anything-c-source-esh
  9107. '((name . "Eshell completions")
  9108. (init . (lambda ()
  9109. (setq pcomplete-current-completions nil
  9110. pcomplete-last-completion-raw nil)
  9111. ;; Eshell-command add this hook in all minibuffers
  9112. ;; Remove it for the anything one. (Fixed in Emacs24)
  9113. (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
  9114. (candidates . anything-esh-get-candidates)
  9115. (action . anything-ec-insert))
  9116. "Anything source for Eshell completion.")
  9117. ;; Internal.
  9118. (defvar anything-ec-target "")
  9119. (defun anything-ec-insert (candidate)
  9120. "Replace text at point with CANDIDATE.
  9121. The function that call this should set `anything-ec-target' to thing at point.
  9122. This is the same as `ac-insert', just inlined here for compatibility."
  9123. (let ((pt (point)))
  9124. (when (and anything-ec-target
  9125. (search-backward anything-ec-target nil t)
  9126. (string= (buffer-substring (point) pt) anything-ec-target))
  9127. (delete-region (point) pt)))
  9128. (insert (anything-quote-whitespace candidate)))
  9129. (defun anything-esh-get-candidates ()
  9130. "Get candidates for eshell completion using `pcomplete'."
  9131. (catch 'pcompleted
  9132. (let* ((pcomplete-stub)
  9133. pcomplete-seen pcomplete-norm-func
  9134. pcomplete-args pcomplete-last pcomplete-index
  9135. (pcomplete-autolist pcomplete-autolist)
  9136. (pcomplete-suffix-list pcomplete-suffix-list))
  9137. (with-anything-current-buffer
  9138. (loop with table = (pcomplete-completions)
  9139. with entry = (condition-case nil
  9140. ;; On Emacs24 `try-completion' return
  9141. ;; pattern when more than one result.
  9142. ;; Otherwise Emacs23 return nil, which
  9143. ;; is wrong, in this case use pattern
  9144. ;; to behave like Emacs24.
  9145. (or (try-completion anything-pattern
  9146. (pcomplete-entries))
  9147. anything-pattern)
  9148. ;; In Emacs23 `pcomplete-entries' may fail
  9149. ;; with error, so try this instead.
  9150. (error
  9151. nil
  9152. (let ((fc (car (last
  9153. (pcomplete-parse-arguments)))))
  9154. ;; Check if last arg require fname completion.
  9155. (and (file-name-directory fc) fc))))
  9156. for i in (all-completions pcomplete-stub table)
  9157. for file-cand = (and entry
  9158. (if (file-remote-p i) i
  9159. (expand-file-name
  9160. i (file-name-directory entry))))
  9161. if (and file-cand (or (file-remote-p file-cand)
  9162. (file-exists-p file-cand)))
  9163. collect file-cand into ls
  9164. else collect i into ls
  9165. finally return
  9166. (if (and entry (not (string= entry "")) (file-exists-p entry))
  9167. (append (list (expand-file-name entry default-directory)) ls)
  9168. ls))))))
  9169. ;;; Eshell history.
  9170. ;;
  9171. ;;
  9172. (defvar anything-c-source-eshell-history
  9173. `((name . "Eshell history")
  9174. (init . (lambda ()
  9175. (let (eshell-hist-ignoredups)
  9176. ;; Write the content's of ring to file.
  9177. (eshell-write-history eshell-history-file-name t)
  9178. (with-current-buffer (anything-candidate-buffer 'global)
  9179. (insert-file-contents eshell-history-file-name)))
  9180. ;; Same comment as in `anything-c-source-esh'
  9181. (remove-hook 'minibuffer-setup-hook 'eshell-mode)))
  9182. (candidates-in-buffer)
  9183. (keymap . ,anything-eshell-history-map)
  9184. (filtered-candidate-transformer . (lambda (candidates sources)
  9185. (reverse candidates)))
  9186. (candidate-number-limit . 9999)
  9187. (action . (lambda (candidate)
  9188. (eshell-kill-input)
  9189. (insert candidate))))
  9190. "Anything source for Eshell history.")
  9191. ;;; Show completion - an alternative of anything-show-completion.el.
  9192. ;;
  9193. ;; Provide show completion with macro `with-anything-show-completion'.
  9194. ;; Called each time cursor move in anything-buffer.
  9195. (defun anything-c-show-completion ()
  9196. (with-anything-current-buffer
  9197. (overlay-put anything-c-show-completion-overlay
  9198. 'display (anything-get-selection))))
  9199. (defun anything-c-show-completion-init-overlay (beg end)
  9200. (and anything-c-turn-on-show-completion
  9201. (setq anything-c-show-completion-overlay (make-overlay beg end))
  9202. (overlay-put anything-c-show-completion-overlay
  9203. 'face 'anything-lisp-show-completion)))
  9204. (defun anything-c-show-completion-display-function (buffer)
  9205. "A special resized anything window is used depending on position in BUFFER."
  9206. (with-selected-window (selected-window)
  9207. (let* ((screen-size (+ (count-screen-lines (window-start) (point) t)
  9208. 1 ; mode-line
  9209. (if header-line-format 1 0))) ; header-line
  9210. (def-size (- (window-height)
  9211. anything-c-show-completion-min-window-height))
  9212. (upper-height (max window-min-height (min screen-size def-size)))
  9213. split-window-keep-point)
  9214. (recenter -1)
  9215. (set-window-buffer (if (active-minibuffer-window)
  9216. (minibuffer-selected-window)
  9217. (split-window nil upper-height))
  9218. buffer))))
  9219. (defmacro with-anything-show-completion (beg end &rest body)
  9220. "Show anything candidate in an overlay at point.
  9221. BEG and END are the beginning and end position of the current completion
  9222. in `anything-current-buffer'.
  9223. BODY is an anything call where we want to enable show completion.
  9224. If `anything-c-turn-on-show-completion' is nil just do nothing."
  9225. (declare (indent 2) (debug t))
  9226. `(let ((anything-move-selection-after-hook
  9227. (and anything-c-turn-on-show-completion
  9228. (append (list 'anything-c-show-completion)
  9229. anything-move-selection-after-hook))))
  9230. (unwind-protect
  9231. (progn
  9232. (anything-c-show-completion-init-overlay ,beg ,end)
  9233. (let ((anything-display-function
  9234. (if anything-c-show-completion-use-special-display
  9235. 'anything-c-show-completion-display-function
  9236. 'anything-default-display-buffer)))
  9237. ,@body))
  9238. (and anything-c-turn-on-show-completion
  9239. (delete-overlay anything-c-show-completion-overlay)))))
  9240. ;;; Lisp symbol completion.
  9241. ;;
  9242. ;;
  9243. ;;;###autoload
  9244. (defun anything-lisp-completion-at-point ()
  9245. "Anything lisp symbol completion at point."
  9246. (interactive)
  9247. (let* ((data (lisp-completion-at-point))
  9248. (beg (car data))
  9249. (end (point)) ; 'cadr data' is wrong when no space after point.
  9250. (plist (nthcdr 3 data))
  9251. (pred (plist-get plist :predicate))
  9252. (lgst-len 0)
  9253. (target (and beg end (buffer-substring-no-properties beg end)))
  9254. (candidates (all-completions target (nth 2 data) pred))
  9255. (anything-quit-if-no-candidate t)
  9256. (anything-execute-action-at-once-if-one t)
  9257. (anything-match-plugin-enabled
  9258. (member 'anything-compile-source--match-plugin
  9259. anything-compile-source-functions)))
  9260. (if candidates
  9261. (with-anything-show-completion beg end
  9262. ;; Overlay is initialized now in anything-current-buffer.
  9263. (anything
  9264. :sources
  9265. '((name . "Lisp completion")
  9266. (init . (lambda ()
  9267. (with-current-buffer (anything-candidate-buffer 'global)
  9268. (loop for sym in candidates
  9269. for len = (length sym)
  9270. when (> len lgst-len) do (setq lgst-len len)
  9271. do (insert (concat sym "\n"))))))
  9272. (candidates-in-buffer)
  9273. (persistent-action . anything-lisp-completion-persistent-action)
  9274. (persistent-help . "Show brief doc in mode-line")
  9275. (filtered-candidate-transformer anything-lisp-completion-transformer)
  9276. (action . (lambda (candidate)
  9277. (delete-region beg end)
  9278. (insert candidate))))
  9279. :input (if anything-match-plugin-enabled (concat target " ") target)))
  9280. (message "[No Match]"))))
  9281. (defun anything-lisp-completion-persistent-action (candidate)
  9282. (let ((cursor-in-echo-area t)
  9283. mode-line-in-non-selected-windows)
  9284. (anything-c-show-info-in-mode-line
  9285. (propertize
  9286. (anything-c-get-first-line-documentation
  9287. (intern candidate))
  9288. 'face 'anything-lisp-completion-info))))
  9289. (defun anything-lisp-completion-transformer (candidates source)
  9290. "Anything candidates transformer for lisp completion."
  9291. (declare (special lgst-len))
  9292. (loop for c in candidates
  9293. for sym = (intern c)
  9294. for annot = (cond ((commandp sym) " (Com)")
  9295. ((fboundp sym) " (Fun)")
  9296. ((boundp sym) " (Var)")
  9297. ((facep sym) " (Face)"))
  9298. for spaces = (make-string (- lgst-len (length c)) ? )
  9299. collect (cons (concat c spaces annot) c)))
  9300. (defun anything-c-get-first-line-documentation (sym)
  9301. "Return first line documentation of symbol SYM.
  9302. If SYM is not documented, return \"Not documented\"."
  9303. (let ((doc (cond ((fboundp sym)
  9304. (documentation sym t))
  9305. ((boundp sym)
  9306. (documentation-property sym 'variable-documentation t))
  9307. ((facep sym)
  9308. (face-documentation sym))
  9309. (t nil))))
  9310. (if (and doc (not (string= doc ""))
  9311. ;; `documentation' return "\n\n(args...)"
  9312. ;; for CL-style functions.
  9313. (not (string-match-p "^\n\n" doc)))
  9314. (car (split-string doc "\n"))
  9315. "Not documented")))
  9316. ;;; File completion.
  9317. ;;
  9318. ;; Complete file name at point.
  9319. (defun anything-c-thing-before-point ()
  9320. "Get symbol name before point.
  9321. Borrowed from anything-complete.el, inlined here for compatibility."
  9322. (save-excursion
  9323. (let ((beg (point)))
  9324. ;; older regexp "\(\\|\\s-\\|^\\|\\_<\\|\r\\|'\\|#'"
  9325. (when (re-search-backward
  9326. "\\_<" (field-beginning nil nil (point-at-bol)) t)
  9327. (buffer-substring-no-properties beg (match-end 0))))))
  9328. ;;;###autoload
  9329. (defun anything-c-complete-file-name-at-point ()
  9330. "Complete file name at point."
  9331. (interactive)
  9332. (let* ((init (substring-no-properties (thing-at-point 'filename)))
  9333. (end (point))
  9334. (beg (- (point) (length init)))
  9335. (anything-quit-if-no-candidate t)
  9336. (anything-execute-action-at-once-if-one t)
  9337. completion)
  9338. (with-anything-show-completion beg end
  9339. (setq completion (anything-c-read-file-name "FileName: "
  9340. :initial-input init)))
  9341. (anything-c-insert-file-name-completion-at-point completion)))
  9342. ;; Internal
  9343. (defvar anything-lisp-completion-counter 0)
  9344. ;;;###autoload
  9345. (defun anything-lisp-completion-at-point-or-indent (arg)
  9346. "First call indent and second call complete lisp symbol.
  9347. The second call should happen before `anything-lisp-completion-or-indent-delay',
  9348. after this delay, next call will indent again.
  9349. After completion, next call is always indent.
  9350. See that like click and double mouse click.
  9351. One hit indent, two quick hits maybe indent and complete."
  9352. (interactive "P")
  9353. ;; Be sure `indent-for-tab-command' will not try
  9354. ;; to use `completion-at-point'.
  9355. (let ((tab-always-indent (if (eq tab-always-indent 'complete)
  9356. t tab-always-indent)))
  9357. (incf anything-lisp-completion-counter)
  9358. (unwind-protect
  9359. (if (> anything-lisp-completion-counter 1)
  9360. (anything-lisp-completion-or-file-name-at-point)
  9361. (indent-for-tab-command arg))
  9362. ;; After `anything-lisp-completion-or-indent-delay' seconds
  9363. ;; reset to 0.
  9364. (run-with-timer anything-lisp-completion-or-indent-delay nil
  9365. #'(lambda ()
  9366. (setq anything-lisp-completion-counter 0)))
  9367. ;; Always reset to 0 at second hit.
  9368. (when (eq anything-lisp-completion-counter 2)
  9369. (setq anything-lisp-completion-counter 0)))))
  9370. ;;;###autoload
  9371. (defun anything-lisp-completion-or-file-name-at-point ()
  9372. "Complete lisp symbol or filename at point.
  9373. Filename completion happen if filename is started in
  9374. or between double quotes."
  9375. (interactive)
  9376. (let ((tap (substring-no-properties (thing-at-point 'filename))))
  9377. (if (and tap (string-match "^\\(~/\\|/\\|[a-zA-Z]\:/\\).*" tap)
  9378. (save-excursion (search-backward "\"" (point-at-bol) t)))
  9379. (anything-c-complete-file-name-at-point)
  9380. (anything-lisp-completion-at-point))))
  9381. (defun anything-c-apropos-init (test default)
  9382. "Init candidates buffer for `anything-c-apropos' sources."
  9383. (with-current-buffer (anything-candidate-buffer 'global)
  9384. (goto-char (point-min))
  9385. (when (and default (stringp default)
  9386. ;; Some defaults args result as
  9387. ;; (symbol-name nil) == "nil".
  9388. ;; e.g debug-on-entry.
  9389. (not (string= default "nil"))
  9390. (funcall test (intern default)))
  9391. (insert (concat default "\n")))
  9392. (loop with all = (all-completions "" obarray test)
  9393. for sym in all
  9394. unless (and default (eq sym default))
  9395. do (insert (concat sym "\n")))))
  9396. ;;; Run Externals commands within Emacs with anything completion
  9397. ;;
  9398. ;;
  9399. (defvar anything-external-command-history nil)
  9400. (defun anything-c-external-commands-list-1 (&optional sort)
  9401. "Returns a list of all external commands the user can execute.
  9402. If `anything-c-external-commands-list' is non-nil it will
  9403. return its contents. Else it calculates all external commands
  9404. and sets `anything-c-external-commands-list'."
  9405. (if anything-c-external-commands-list
  9406. anything-c-external-commands-list
  9407. (setq anything-c-external-commands-list
  9408. (loop
  9409. with paths = (split-string (getenv "PATH") path-separator)
  9410. with completions = ()
  9411. for dir in paths
  9412. when (and (file-exists-p dir) (file-accessible-directory-p dir))
  9413. for lsdir = (loop for i in (directory-files dir t)
  9414. for bn = (file-name-nondirectory i)
  9415. when (and (not (member bn completions))
  9416. (not (file-directory-p i))
  9417. (file-executable-p i))
  9418. collect bn)
  9419. append lsdir into completions
  9420. finally return (if sort (sort completions 'string-lessp) completions)))))
  9421. (defun anything-run-or-raise (exe &optional file)
  9422. "Generic command that run asynchronously EXE.
  9423. If EXE is already running just jump to his window if `anything-raise-command'
  9424. is non--nil.
  9425. When FILE argument is provided run EXE with FILE.
  9426. In this case EXE must be provided as \"EXE %s\"."
  9427. (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
  9428. "%s" "" exe))))
  9429. (proc (if file (concat real-com " " file) real-com)))
  9430. (if (get-process proc)
  9431. (if anything-raise-command
  9432. (shell-command (format anything-raise-command real-com))
  9433. (error "Error: %s is already running" real-com))
  9434. (when (loop for i in anything-c-external-commands-list thereis real-com)
  9435. (message "Starting %s..." real-com)
  9436. (if file
  9437. (start-process-shell-command
  9438. proc nil (format exe (shell-quote-argument
  9439. (if (eq system-type 'windows-nt)
  9440. (anything-w32-prepare-filename file)
  9441. file))))
  9442. (start-process-shell-command proc nil real-com))
  9443. (set-process-sentinel
  9444. (get-process proc)
  9445. #'(lambda (process event)
  9446. (when (and (string= event "finished\n")
  9447. anything-raise-command
  9448. (not (anything-c-get-pid-from-process-name real-com)))
  9449. (shell-command (format anything-raise-command "emacs")))
  9450. (message "%s process...Finished." process))))
  9451. (setq anything-c-external-commands-list
  9452. (cons real-com
  9453. (delete real-com anything-c-external-commands-list))))))
  9454. ;;; Generic action functions
  9455. ;;
  9456. ;;
  9457. (defun anything-c-file-buffers (filename)
  9458. "Returns a list of buffer names corresponding to FILENAME."
  9459. (let ((name (expand-file-name filename))
  9460. (buf-list ()))
  9461. (dolist (buf (buffer-list) buf-list)
  9462. (let ((bfn (buffer-file-name buf)))
  9463. (when (and bfn (string= name bfn))
  9464. (push (buffer-name buf) buf-list))))))
  9465. (defun anything-revert-buffer (candidate)
  9466. (with-current-buffer candidate
  9467. (when (or (buffer-modified-p)
  9468. (not (verify-visited-file-modtime
  9469. (get-buffer candidate))))
  9470. (revert-buffer t t))))
  9471. (defun anything-revert-marked-buffers (ignore)
  9472. (mapc 'anything-revert-buffer (anything-marked-candidates)))
  9473. (defun anything-kill-marked-buffers (ignore)
  9474. (mapc 'kill-buffer (anything-marked-candidates)))
  9475. (defun anything-c-delete-file (file &optional error-if-dot-file-p)
  9476. "Delete the given file after querying the user.
  9477. Ask to kill buffers associated with that file, too."
  9478. (when (and error-if-dot-file-p
  9479. (anything-ff-dot-file-p file))
  9480. (error "Error: Cannot operate on `.' or `..'"))
  9481. (let ((buffers (anything-c-file-buffers file)))
  9482. (if (< emacs-major-version 24)
  9483. ;; `dired-delete-file' in Emacs versions < 24
  9484. ;; doesn't support delete-by-moving-to-trash
  9485. ;; so use `delete-directory' and `delete-file'
  9486. ;; that handle it.
  9487. (cond ((and (not (file-symlink-p file))
  9488. (file-directory-p file)
  9489. (directory-files file t dired-re-no-dot))
  9490. (when (y-or-n-p (format "Recursive delete of `%s'? " file))
  9491. (delete-directory file 'recursive)))
  9492. ((and (not (file-symlink-p file))
  9493. (file-directory-p file))
  9494. (delete-directory file))
  9495. (t (delete-file file)))
  9496. (dired-delete-file
  9497. file 'dired-recursive-deletes delete-by-moving-to-trash))
  9498. (when buffers
  9499. (dolist (buf buffers)
  9500. (when (y-or-n-p (format "Kill buffer %s, too? " buf))
  9501. (kill-buffer buf))))))
  9502. (defun anything-get-mailcap-for-file (filename)
  9503. "Get the command to use for FILENAME from mailcap files.
  9504. The command is like <command %s> and is meant to use with `format'."
  9505. (mailcap-parse-mailcaps)
  9506. (let* ((ext (file-name-extension filename))
  9507. (mime (when ext (mailcap-extension-to-mime ext)))
  9508. (result (when mime (mailcap-mime-info mime))))
  9509. ;; If elisp file have no associations in .mailcap
  9510. ;; `mailcap-maybe-eval' is returned, in this case just return nil.
  9511. (when (stringp result) result)))
  9512. (defun anything-get-default-program-for-file (filename)
  9513. "Try to find a default program to open FILENAME.
  9514. Try first in `anything-c-external-programs-associations' and then in mailcap file
  9515. if nothing found return nil."
  9516. (let* ((ext (file-name-extension filename))
  9517. (def-prog (assoc-default ext anything-c-external-programs-associations)))
  9518. (cond ((and def-prog (not (string= def-prog "")))
  9519. (concat def-prog " %s"))
  9520. ((and anything-c-default-external-file-browser
  9521. (file-directory-p filename))
  9522. (concat anything-c-default-external-file-browser " %s"))
  9523. (t (anything-get-mailcap-for-file filename)))))
  9524. (defun anything-c-open-file-externally (file)
  9525. "Open FILE with an external program.
  9526. Try to guess which program to use with `anything-get-default-program-for-file'.
  9527. If not found or a prefix arg is given query the user which tool to use."
  9528. (let* ((fname (expand-file-name file))
  9529. (collection (anything-c-external-commands-list-1 'sort))
  9530. (def-prog (anything-get-default-program-for-file fname))
  9531. (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
  9532. ;; Prefix arg or no default program.
  9533. (prog1
  9534. (anything-comp-read
  9535. "Program: " collection
  9536. :must-match t
  9537. :name "Open file Externally"
  9538. :history anything-external-command-history)
  9539. ;; Always prompt to set this program as default.
  9540. (setq def-prog nil))
  9541. ;; No prefix arg or default program exists.
  9542. (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
  9543. (program (concat real-prog-name " %s")))
  9544. (unless (or def-prog ; Association exists, no need to record it.
  9545. ;; Don't try to record non--filenames associations (e.g urls).
  9546. (not (file-exists-p fname)))
  9547. (when
  9548. (y-or-n-p
  9549. (format
  9550. "Do you want to make `%s' the default program for this kind of files? "
  9551. real-prog-name))
  9552. (anything-aif (assoc (file-name-extension fname)
  9553. anything-c-external-programs-associations)
  9554. (setq anything-c-external-programs-associations
  9555. (delete it anything-c-external-programs-associations)))
  9556. (push (cons (file-name-extension fname)
  9557. (read-string
  9558. "Program (Add args maybe and confirm): " real-prog-name))
  9559. anything-c-external-programs-associations)
  9560. (customize-save-variable 'anything-c-external-programs-associations
  9561. anything-c-external-programs-associations)))
  9562. (anything-run-or-raise program file)
  9563. (setq anything-external-command-history
  9564. (cons real-prog-name
  9565. (delete real-prog-name
  9566. (loop for i in anything-external-command-history
  9567. when (executable-find i) collect i))))))
  9568. (defun anything-c-find-file-or-marked (candidate)
  9569. "Open file CANDIDATE or open anything marked files in background."
  9570. (let ((marked (anything-marked-candidates))
  9571. (ffap-newfile-prompt anything-ff-newfile-prompt-p)
  9572. (find-file-wildcards nil))
  9573. (if (> (length marked) 1)
  9574. ;; Open all marked files in background and display
  9575. ;; the first one.
  9576. (progn (mapc 'find-file-noselect (cdr marked))
  9577. (find-file (car marked)))
  9578. (if (and (not (file-exists-p candidate))
  9579. (and ffap-url-regexp
  9580. (not (string-match ffap-url-regexp candidate)))
  9581. (string-match "/$" candidate))
  9582. ;; A a non--existing filename ending with /
  9583. ;; Create a directory and jump to it.
  9584. (when (y-or-n-p (format "Create directory `%s'? " candidate))
  9585. (let ((dirfname (directory-file-name candidate)))
  9586. (if (file-exists-p dirfname)
  9587. (error "Mkdir: Unable to create directory `%s': file exists."
  9588. (anything-c-basename dirfname))
  9589. (make-directory candidate 'parent)))
  9590. (anything-find-files-1 candidate))
  9591. ;; A non--existing filename NOT ending with / or
  9592. ;; an existing filename, create or jump to it.
  9593. (find-file-at-point (car marked))))))
  9594. (defun anything-delete-marked-files (ignore)
  9595. (let* ((files (anything-marked-candidates))
  9596. (len (length files)))
  9597. (if (not (y-or-n-p
  9598. (format "Delete *%s File(s):\n%s"
  9599. len
  9600. (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
  9601. (message "(No deletions performed)")
  9602. (dolist (i files)
  9603. (set-text-properties 0 (length i) nil i)
  9604. (anything-c-delete-file i anything-ff-signal-error-on-dot-files))
  9605. (message "%s File(s) deleted" len))))
  9606. (defun anything-ediff-marked-buffers (candidate &optional merge)
  9607. "Ediff 2 marked buffers or CANDIDATE and `anything-current-buffer'.
  9608. With optional arg MERGE call `ediff-merge-buffers'."
  9609. (let ((lg-lst (length (anything-marked-candidates)))
  9610. buf1 buf2)
  9611. (case lg-lst
  9612. (0
  9613. (error "Error:You have to mark at least 1 buffer"))
  9614. (1
  9615. (setq buf1 anything-current-buffer
  9616. buf2 (first (anything-marked-candidates))))
  9617. (2
  9618. (setq buf1 (first (anything-marked-candidates))
  9619. buf2 (second (anything-marked-candidates))))
  9620. (t
  9621. (error "Error:To much buffers marked!")))
  9622. (if merge
  9623. (ediff-merge-buffers buf1 buf2)
  9624. (ediff-buffers buf1 buf2))))
  9625. (defun anything-ediff-marked-buffers-merge (candidate)
  9626. "Ediff merge `anything-current-buffer' with CANDIDATE.
  9627. See `anything-ediff-marked-buffers'."
  9628. (anything-ediff-marked-buffers candidate t))
  9629. (defun anything-bookmark-get-bookmark-from-name (bmk)
  9630. "Return bookmark name even if it is a bookmark with annotation.
  9631. e.g prepended with *.
  9632. Return nil if bmk is not a valid bookmark."
  9633. (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
  9634. (if (assoc bookmark bookmark-alist)
  9635. bookmark
  9636. (when (assoc bmk bookmark-alist)
  9637. bmk))))
  9638. (defun anything-delete-marked-bookmarks (ignore)
  9639. "Delete this bookmark or all marked bookmarks."
  9640. (dolist (i (anything-marked-candidates))
  9641. (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
  9642. 'batch)))
  9643. (defun anything-require-or-error (feature function)
  9644. (or (require feature nil t)
  9645. (error "Need %s to use `%s'." feature function)))
  9646. (defun anything-find-buffer-on-elscreen (candidate)
  9647. "Open buffer in new screen, if marked buffers open all in elscreens."
  9648. (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
  9649. (anything-aif (anything-marked-candidates)
  9650. (dolist (i it)
  9651. (let ((target-screen (elscreen-find-screen-by-buffer
  9652. (get-buffer i) 'create)))
  9653. (elscreen-goto target-screen)))
  9654. (let ((target-screen (elscreen-find-screen-by-buffer
  9655. (get-buffer candidate) 'create)))
  9656. (elscreen-goto target-screen))))
  9657. (defun anything-elscreen-find-file (file)
  9658. (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
  9659. (elscreen-find-file file))
  9660. (defun anything-w32-prepare-filename (file)
  9661. "Convert filename FILE to something usable by external w32 executables."
  9662. (replace-regexp-in-string ; For UNC paths
  9663. "/" "\\"
  9664. (replace-regexp-in-string ; Strip cygdrive paths
  9665. "/cygdrive/\\(.\\)" "\\1:"
  9666. file nil nil) nil t))
  9667. ;;;###autoload
  9668. (defun anything-w32-shell-execute-open-file (file)
  9669. (interactive "fOpen file:")
  9670. (with-no-warnings
  9671. (w32-shell-execute "open" (anything-w32-prepare-filename file))))
  9672. (defun anything-c-open-file-with-default-tool (file)
  9673. "Open FILE with the default tool on this platform."
  9674. (if (eq system-type 'windows-nt)
  9675. (anything-w32-shell-execute-open-file file)
  9676. (start-process "anything-c-open-file-with-default-tool"
  9677. nil
  9678. (cond ((eq system-type 'gnu/linux)
  9679. "xdg-open")
  9680. ((or (eq system-type 'darwin) ;; Mac OS X
  9681. (eq system-type 'macos)) ;; Mac OS 9
  9682. "open"))
  9683. file)))
  9684. (defun anything-c-open-dired (file)
  9685. "Opens a dired buffer in FILE's directory. If FILE is a
  9686. directory, open this directory."
  9687. (if (file-directory-p file)
  9688. (dired file)
  9689. (dired (file-name-directory file))
  9690. (dired-goto-file file)))
  9691. (defun anything-c-display-to-real-line (candidate)
  9692. (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
  9693. (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
  9694. (error "Line number not found")))
  9695. (defun anything-c-action-line-goto (lineno-and-content)
  9696. (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
  9697. (append lineno-and-content
  9698. (list (if (and (anything-attr-defined 'target-file)
  9699. (not anything-in-persistent-action))
  9700. 'find-file-other-window
  9701. 'find-file)))))
  9702. (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
  9703. (apply #'anything-goto-file-line
  9704. (if (stringp file-line-content)
  9705. ;; Case: filtered-candidate-transformer is skipped
  9706. (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
  9707. file-line-content)))
  9708. (require 'compile)
  9709. (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
  9710. (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
  9711. (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
  9712. (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
  9713. (let ((filename (match-string 1 candidate))
  9714. (lineno (match-string 2 candidate))
  9715. (content (match-string 3 candidate)))
  9716. (cons (format "%s:%s\n %s"
  9717. (propertize filename 'face compilation-info-face)
  9718. (propertize lineno 'face compilation-line-face)
  9719. content)
  9720. (list (expand-file-name
  9721. filename
  9722. (or (anything-interpret-value (anything-attr 'default-directory))
  9723. (and (anything-candidate-buffer)
  9724. (buffer-local-value
  9725. 'default-directory (anything-candidate-buffer)))))
  9726. (string-to-number lineno) content)))))
  9727. (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
  9728. (anything-aif (anything-attr 'before-jump-hook)
  9729. (funcall it))
  9730. (when file (funcall find-file-function file))
  9731. (if (anything-attr-defined 'adjust)
  9732. (anything-c-goto-line-with-adjustment lineno content)
  9733. (anything-goto-line lineno))
  9734. (unless (anything-attr-defined 'recenter)
  9735. (set-window-start (get-buffer-window anything-current-buffer) (point)))
  9736. (anything-aif (anything-attr 'after-jump-hook)
  9737. (funcall it))
  9738. (when anything-in-persistent-action
  9739. (anything-match-line-color-current-line)))
  9740. (defun anything-find-file-as-root (candidate)
  9741. (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
  9742. (defun anything-find-many-files (ignore)
  9743. (mapc 'find-file (anything-marked-candidates)))
  9744. ;; borrowed from etags.el
  9745. ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
  9746. (defun anything-c-goto-line-with-adjustment (line line-content)
  9747. (let ((startpos)
  9748. offset found pat)
  9749. ;; This constant is 1/2 the initial search window.
  9750. ;; There is no sense in making it too small,
  9751. ;; since just going around the loop once probably
  9752. ;; costs about as much as searching 2000 chars.
  9753. (setq offset 1000
  9754. found nil
  9755. pat (concat (if (eq selective-display t)
  9756. "\\(^\\|\^m\\) *" "^ *") ;allow indent
  9757. (regexp-quote line-content)))
  9758. ;; If no char pos was given, try the given line number.
  9759. (setq startpos (progn (anything-goto-line line) (point)))
  9760. (or startpos (setq startpos (point-min)))
  9761. ;; First see if the tag is right at the specified location.
  9762. (goto-char startpos)
  9763. (setq found (looking-at pat))
  9764. (while (and (not found)
  9765. (progn
  9766. (goto-char (- startpos offset))
  9767. (not (bobp))))
  9768. (setq found
  9769. (re-search-forward pat (+ startpos offset) t)
  9770. offset (* 3 offset))) ; expand search window
  9771. (or found
  9772. (re-search-forward pat nil t)
  9773. (error "not found")))
  9774. ;; Position point at the right place
  9775. ;; if the search string matched an extra Ctrl-m at the beginning.
  9776. (and (eq selective-display t)
  9777. (looking-at "\^m")
  9778. (forward-char 1))
  9779. (beginning-of-line))
  9780. (anything-document-attribute 'default-directory "type . file-line"
  9781. "`default-directory' to interpret file.")
  9782. (anything-document-attribute 'before-jump-hook "type . file-line / line"
  9783. "Function to call before jumping to the target location.")
  9784. (anything-document-attribute 'after-jump-hook "type . file-line / line"
  9785. "Function to call after jumping to the target location.")
  9786. (anything-document-attribute 'adjust "type . file-line"
  9787. "Search around line matching line contents.")
  9788. (anything-document-attribute 'recenter "type . file-line / line"
  9789. "`recenter' after jumping.")
  9790. (anything-document-attribute 'target-file "type . line"
  9791. "Goto line of target-file.")
  9792. ;;;###autoload
  9793. (defun anything-c-call-interactively (cmd-or-name)
  9794. "Execute CMD-OR-NAME as Emacs command.
  9795. It is added to `extended-command-history'.
  9796. `anything-current-prefix-arg' is used as the command's prefix argument."
  9797. (setq extended-command-history
  9798. (cons (anything-c-stringify cmd-or-name)
  9799. (delete (anything-c-stringify cmd-or-name) extended-command-history)))
  9800. (let ((current-prefix-arg anything-current-prefix-arg)
  9801. (cmd (anything-c-symbolify cmd-or-name)))
  9802. (if (stringp (symbol-function cmd))
  9803. (execute-kbd-macro (symbol-function cmd))
  9804. (setq this-command cmd)
  9805. (call-interactively cmd))))
  9806. ;;;###autoload
  9807. (defun anything-c-set-variable (var)
  9808. "Set value to VAR interactively."
  9809. (interactive)
  9810. (let ((sym (anything-c-symbolify var)))
  9811. (set sym (eval-minibuffer (format "Set %s: " var)
  9812. (prin1-to-string (symbol-value sym))))))
  9813. ;; (setq hh 12)
  9814. ;; (anything-c-set-variable 'hh)
  9815. ;;; Persistent Action Helpers
  9816. ;;
  9817. ;;
  9818. (defvar anything-match-line-overlay-face nil)
  9819. (defvar anything-match-line-overlay nil)
  9820. (defun anything-match-line-color-current-line (&optional start end buf face rec)
  9821. "Highlight and underline current position"
  9822. (let ((args (list (or start (line-beginning-position))
  9823. (or end (1+ (line-end-position)))
  9824. buf)))
  9825. (if (not anything-match-line-overlay)
  9826. (setq anything-match-line-overlay (apply 'make-overlay args))
  9827. (apply 'move-overlay anything-match-line-overlay args)))
  9828. (overlay-put anything-match-line-overlay
  9829. 'face (or face anything-match-line-overlay-face))
  9830. (when rec
  9831. (goto-char start)
  9832. (recenter)))
  9833. (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
  9834. (setq anything-match-line-overlay-face 'anything-overlay-line-face)
  9835. (defun anything-match-line-cleanup ()
  9836. (when anything-match-line-overlay
  9837. (delete-overlay anything-match-line-overlay)
  9838. (setq anything-match-line-overlay nil)))
  9839. (defun anything-match-line-update ()
  9840. (when anything-match-line-overlay
  9841. (delete-overlay anything-match-line-overlay)
  9842. (anything-match-line-color-current-line)))
  9843. (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
  9844. (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
  9845. ;;; Actions Transformers
  9846. ;;
  9847. ;;
  9848. ;;; Files
  9849. (defun anything-c-transform-file-load-el (actions candidate)
  9850. "Add action to load the file CANDIDATE if it is an emacs lisp
  9851. file. Else return ACTIONS unmodified."
  9852. (if (member (file-name-extension candidate) '("el" "elc"))
  9853. (append actions '(("Load Emacs Lisp File" . load-file)))
  9854. actions))
  9855. (defun anything-c-transform-file-browse-url (actions candidate)
  9856. "Add an action to browse the file CANDIDATE if it in a html
  9857. file or URL. Else return ACTIONS unmodified."
  9858. (let ((browse-action '("Browse with Browser" . browse-url)))
  9859. (cond ((string-match "^http\\|^ftp" candidate)
  9860. (cons browse-action actions))
  9861. ((string-match "\\.html?$" candidate)
  9862. (append actions (list browse-action)))
  9863. (t actions))))
  9864. ;;; Function
  9865. (defun anything-c-transform-function-call-interactively (actions candidate)
  9866. "Add an action to call the function CANDIDATE interactively if
  9867. it is a command. Else return ACTIONS unmodified."
  9868. (if (commandp (intern-soft candidate))
  9869. (append actions '(("Call Interactively"
  9870. .
  9871. anything-c-call-interactively)))
  9872. actions))
  9873. ;;;; S-Expressions
  9874. (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
  9875. "If CANDIDATE's `car' is a command, then add an action to
  9876. evaluate it and put it onto the `command-history'."
  9877. (if (commandp (car (read candidate)))
  9878. ;; Make it first entry
  9879. (cons '("Eval and put onto command-history" .
  9880. (lambda (sexp)
  9881. (let ((sym (read sexp)))
  9882. (eval sym)
  9883. (setq command-history
  9884. (cons sym command-history)))))
  9885. actions)
  9886. actions))
  9887. ;;; Candidate Transformers
  9888. ;;
  9889. ;;
  9890. ;;; Buffers
  9891. (defun anything-c-skip-boring-buffers (buffers)
  9892. (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
  9893. (defun anything-c-skip-current-buffer (buffers)
  9894. "[DEPRECATED] Skip current buffer in buffer lists.
  9895. This transformer should not be used as this is now handled directly
  9896. in `anything-c-buffer-list' and `anything-c-highlight-buffers'."
  9897. (if anything-allow-skipping-current-buffer
  9898. (remove (buffer-name anything-current-buffer) buffers)
  9899. buffers))
  9900. (defun anything-c-shadow-boring-buffers (buffers)
  9901. "Buffers matching `anything-c-boring-buffer-regexp' will be
  9902. displayed with the `file-name-shadow' face if available."
  9903. (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
  9904. (defvar anything-c-buffer-display-string-functions
  9905. '(anything-c-buffer-display-string--compilation
  9906. anything-c-buffer-display-string--shell
  9907. anything-c-buffer-display-string--eshell)
  9908. "Functions to setup display string for buffer.
  9909. Function has one argument, buffer name.
  9910. If it returns string, use it.
  9911. If it returns nil, display buffer name.
  9912. See `anything-c-buffer-display-string--compilation' for example.")
  9913. (defun anything-c-transform-buffer-display-string (buffers)
  9914. "Setup display string for buffer candidates
  9915. using `anything-c-buffer-display-string-functions'."
  9916. (loop for buf in buffers
  9917. if (consp buf)
  9918. collect buf
  9919. else
  9920. for disp = (progn (set-buffer buf)
  9921. (run-hook-with-args-until-success
  9922. 'anything-c-buffer-display-string-functions buf))
  9923. collect (if disp (cons disp buf) buf)))
  9924. (defun anything-c-buffer-display-string--compilation (buf)
  9925. (anything-aif (car compilation-arguments)
  9926. (format "%s: %s [%s]" buf it default-directory)))
  9927. (defun anything-c-buffer-display-string--eshell (buf)
  9928. (declare (special eshell-history-ring))
  9929. (when (eq major-mode 'eshell-mode)
  9930. (format "%s: %s [%s]" buf
  9931. (ignore-errors (ring-ref eshell-history-ring 0))
  9932. default-directory)))
  9933. (defun anything-c-buffer-display-string--shell (buf)
  9934. (when (eq major-mode 'shell-mode)
  9935. (format "%s: %s [%s]" buf
  9936. (ignore-errors (ring-ref comint-input-ring 0))
  9937. default-directory)))
  9938. ;;; Files
  9939. (defun anything-c-shadow-boring-files (files)
  9940. "Files matching `anything-c-boring-file-regexp' will be
  9941. displayed with the `file-name-shadow' face if available."
  9942. (anything-c-shadow-entries files anything-c-boring-file-regexp))
  9943. (defun anything-c-skip-boring-files (files)
  9944. "Files matching `anything-c-boring-file-regexp' will be skipped."
  9945. (anything-c-skip-entries files anything-c-boring-file-regexp))
  9946. ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
  9947. (defun anything-c-skip-current-file (files)
  9948. "Current file will be skipped."
  9949. (remove (buffer-file-name anything-current-buffer) files))
  9950. (defun anything-c-w32-pathname-transformer (args)
  9951. "Change undesirable features of windows pathnames to ones more acceptable to
  9952. other candidate transformers."
  9953. (if (eq system-type 'windows-nt)
  9954. (anything-transform-mapcar
  9955. (lambda (x)
  9956. (replace-regexp-in-string
  9957. "/cygdrive/\\(.\\)" "\\1:"
  9958. (replace-regexp-in-string "\\\\" "/" x)))
  9959. args)
  9960. args))
  9961. (defun anything-c-shorten-home-path (files)
  9962. "Replaces /home/user with ~."
  9963. (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
  9964. (getenv "HOME"))))
  9965. (anything-transform-mapcar
  9966. (lambda (file)
  9967. (if (and (stringp file) (string-match home file))
  9968. (cons (replace-match "~" nil nil file) file)
  9969. file))
  9970. files)))
  9971. ;;; Functions
  9972. (defun anything-c-mark-interactive-functions (functions)
  9973. "Mark interactive functions (commands) with (i) after the function name."
  9974. (let (list)
  9975. (loop for function in functions
  9976. do (push (cons (concat function
  9977. (when (commandp (intern-soft function)) " (i)"))
  9978. function)
  9979. list)
  9980. finally (return (nreverse list)))))
  9981. ;;; Adaptive Sorting of Candidates
  9982. ;;
  9983. ;;
  9984. ;; Internal
  9985. (defvar anything-c-adaptive-done nil
  9986. "nil if history information is not yet stored for the current
  9987. selection.")
  9988. (defvar anything-c-adaptive-history nil
  9989. "Contains the stored history information.
  9990. Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
  9991. ;; Should run at beginning of `anything-initial-setup'.
  9992. (add-hook 'anything-before-initialize-hook #'(lambda ()
  9993. (when anything-c-use-adaptative-sorting
  9994. (setq anything-c-adaptive-done nil))))
  9995. ;; Should run at beginning of `anything-exit-minibuffer'.
  9996. (add-hook 'anything-before-action-hook #'(lambda ()
  9997. (when anything-c-use-adaptative-sorting
  9998. (anything-c-adaptive-store-selection))))
  9999. ;; Should run at beginning of `anything-select-action'.
  10000. (add-hook 'anything-select-action-hook #'(lambda ()
  10001. (when anything-c-use-adaptative-sorting
  10002. (anything-c-adaptive-store-selection))))
  10003. (defun anything-c-source-use-adaptative-p (&optional source-name)
  10004. "Return current source only if it use adaptative history, nil otherwise."
  10005. (when anything-c-use-adaptative-sorting
  10006. (let* ((source (or source-name (anything-get-current-source)))
  10007. (adapt-source (or (assoc-default 'filtered-candidate-transformer
  10008. (assoc (assoc-default 'type source)
  10009. anything-type-attributes))
  10010. (assoc-default 'candidate-transformer
  10011. (assoc (assoc-default 'type source)
  10012. anything-type-attributes))
  10013. (assoc-default 'filtered-candidate-transformer source)
  10014. (assoc-default 'candidate-transformer source))))
  10015. (if (listp adapt-source)
  10016. (when (member 'anything-c-adaptive-sort adapt-source) source)
  10017. (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
  10018. (defun anything-c-adaptive-store-selection ()
  10019. "Store history information for the selected candidate."
  10020. (unless anything-c-adaptive-done
  10021. (setq anything-c-adaptive-done t)
  10022. (let ((source (anything-c-source-use-adaptative-p)))
  10023. (when source
  10024. (let* ((source-name (or (assoc-default 'type source)
  10025. (assoc-default 'name source)))
  10026. (source-info (or (assoc source-name anything-c-adaptive-history)
  10027. (progn
  10028. (push (list source-name) anything-c-adaptive-history)
  10029. (car anything-c-adaptive-history))))
  10030. (selection (anything-get-selection))
  10031. (selection-info (progn
  10032. (setcdr source-info
  10033. (cons
  10034. (let ((found (assoc selection (cdr source-info))))
  10035. (if (not found)
  10036. ;; new entry
  10037. (list selection)
  10038. ;; move entry to the beginning of the
  10039. ;; list, so that it doesn't get
  10040. ;; trimmed when the history is
  10041. ;; truncated
  10042. (setcdr source-info
  10043. (delete found (cdr source-info)))
  10044. found))
  10045. (cdr source-info)))
  10046. (cadr source-info)))
  10047. (pattern-info (progn
  10048. (setcdr selection-info
  10049. (cons
  10050. (let ((found (assoc anything-pattern (cdr selection-info))))
  10051. (if (not found)
  10052. ;; new entry
  10053. (cons anything-pattern 0)
  10054. ;; move entry to the beginning of the
  10055. ;; list, so if two patterns used the
  10056. ;; same number of times then the one
  10057. ;; used last appears first in the list
  10058. (setcdr selection-info
  10059. (delete found (cdr selection-info)))
  10060. found))
  10061. (cdr selection-info)))
  10062. (cadr selection-info))))
  10063. ;; increase usage count
  10064. (setcdr pattern-info (1+ (cdr pattern-info)))
  10065. ;; truncate history if needed
  10066. (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
  10067. (setcdr selection-info
  10068. (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
  10069. (defun anything-c-adaptative-maybe-load-history ()
  10070. (when (and anything-c-use-adaptative-sorting
  10071. (file-readable-p anything-c-adaptive-history-file))
  10072. (load-file anything-c-adaptive-history-file)))
  10073. (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
  10074. (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
  10075. (defun anything-c-adaptive-save-history (&optional arg)
  10076. "Save history information to file given by `anything-c-adaptive-history-file'."
  10077. (interactive "p")
  10078. (when anything-c-use-adaptative-sorting
  10079. (with-temp-buffer
  10080. (insert
  10081. ";; -*- mode: emacs-lisp -*-\n"
  10082. ";; History entries used for anything adaptive display.\n")
  10083. (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
  10084. (current-buffer))
  10085. (insert ?\n)
  10086. (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
  10087. (unless arg 'quiet)))))
  10088. (defun anything-c-adaptive-sort (candidates source)
  10089. "Sort the CANDIDATES for SOURCE by usage frequency.
  10090. This is a filtered candidate transformer you can use for the
  10091. attribute `filtered-candidate-transformer' of a source in
  10092. `anything-sources' or a type in `anything-type-attributes'."
  10093. (let* ((source-name (or (assoc-default 'type source)
  10094. (assoc-default 'name source)))
  10095. (source-info (assoc source-name anything-c-adaptive-history)))
  10096. (if source-info
  10097. (let ((usage
  10098. ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
  10099. ;; pairs
  10100. (mapcar (lambda (candidate-info)
  10101. (let ((count 0))
  10102. (dolist (pattern-info (cdr candidate-info))
  10103. (if (not (equal (car pattern-info)
  10104. anything-pattern))
  10105. (incf count (cdr pattern-info))
  10106. ;; if current pattern is equal to the previously
  10107. ;; used one then this candidate has priority
  10108. ;; (that's why its count is boosted by 10000) and
  10109. ;; it only has to compete with other candidates
  10110. ;; which were also selected with the same pattern
  10111. (setq count (+ 10000 (cdr pattern-info)))
  10112. (return)))
  10113. (cons (car candidate-info) count)))
  10114. (cdr source-info)))
  10115. sorted)
  10116. (if (and usage (consp usage))
  10117. ;; sort the list in descending order, so candidates with highest
  10118. ;; priorty come first
  10119. (progn
  10120. (setq usage (sort usage (lambda (first second)
  10121. (> (cdr first) (cdr second)))))
  10122. ;; put those candidates first which have the highest usage count
  10123. (dolist (info usage)
  10124. (when (member* (car info) candidates
  10125. :test 'anything-c-adaptive-compare)
  10126. (push (car info) sorted)
  10127. (setq candidates (remove* (car info) candidates
  10128. :test 'anything-c-adaptive-compare))))
  10129. ;; and append the rest
  10130. (append (reverse sorted) candidates nil))
  10131. (message "Your `%s' is maybe corrupted or too old, \
  10132. you should reinitialize it with `anything-c-reset-adaptative-history'"
  10133. anything-c-adaptive-history-file)
  10134. (sit-for 1)
  10135. candidates))
  10136. ;; if there is no information stored for this source then do nothing
  10137. candidates)))
  10138. ;;;###autoload
  10139. (defun anything-c-reset-adaptative-history ()
  10140. "Delete all `anything-c-adaptive-history' and his file.
  10141. Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
  10142. (interactive)
  10143. (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
  10144. (setq anything-c-adaptive-history nil)
  10145. (delete-file anything-c-adaptive-history-file)))
  10146. (defun anything-c-adaptive-compare (x y)
  10147. "Compare candidates X and Y taking into account that the
  10148. candidate can be in (DISPLAY . REAL) format."
  10149. (equal (if (listp x)
  10150. (cdr x)
  10151. x)
  10152. (if (listp y)
  10153. (cdr y)
  10154. y)))
  10155. ;;; Outliner
  10156. ;;
  10157. ;;
  10158. (defvar anything-outline-goto-near-line-flag t)
  10159. (defvar anything-outline-using nil)
  10160. (defun anything-after-update-hook--outline ()
  10161. (if (and (eq anything-outline-using t)
  10162. (eq anything-outline-goto-near-line-flag t))
  10163. (anything-outline-goto-near-line)))
  10164. (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
  10165. (defun anything-outline-goto-near-line ()
  10166. (with-anything-window
  10167. ;; TODO need consideration whether to update position by every input.
  10168. (when t ; (equal anything-pattern "")
  10169. (anything-goto-line 2)
  10170. (let ((lineno (with-anything-current-buffer
  10171. (line-number-at-pos (car anything-current-position)))))
  10172. (block exit
  10173. (while (<= (progn (skip-chars-forward " ")
  10174. (or (number-at-point) lineno))
  10175. lineno)
  10176. (forward-line 1)
  10177. (when (eobp)
  10178. (forward-line -1)
  10179. (return-from exit))))
  10180. (forward-line -1)
  10181. (and (bobp) (forward-line 1))
  10182. (and (anything-pos-header-line-p) (forward-line -2))
  10183. (anything-mark-current-line)))))
  10184. ;;; Plug-in
  10185. ;;
  10186. ;;
  10187. ;; Plug-in: info-index
  10188. (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
  10189. (let (result)
  10190. (unless (anything-candidate-buffer)
  10191. (save-window-excursion
  10192. (info file)
  10193. (let (Info-history
  10194. (tobuf (anything-candidate-buffer 'global))
  10195. (infobuf (current-buffer))
  10196. s e)
  10197. (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
  10198. (Info-goto-node node)
  10199. (goto-char (point-min))
  10200. (while (search-forward "\n* " nil t)
  10201. (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
  10202. '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
  10203. (setq s (point-at-bol)
  10204. e (point-at-eol))
  10205. (with-current-buffer tobuf
  10206. (insert-buffer-substring infobuf s e)
  10207. (insert "\n"))))))))))
  10208. (defun anything-c-info-goto (node-line)
  10209. (Info-goto-node (car node-line))
  10210. (anything-goto-line (cdr node-line)))
  10211. (defun anything-c-info-display-to-real (line)
  10212. (and (string-match
  10213. ;; This regexp is stolen from Info-apropos-matches
  10214. "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
  10215. (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
  10216. (string-to-number (or (match-string 3 line) "1")))))
  10217. (defun anything-c-make-info-source (source file)
  10218. `(,@source
  10219. (name . ,(concat "Info Index: " file))
  10220. (info-file . ,file)
  10221. (init . anything-c-info-init)
  10222. (display-to-real . anything-c-info-display-to-real)
  10223. (get-line . buffer-substring)
  10224. (candidates-in-buffer)
  10225. (action ("Goto node" . anything-c-info-goto))))
  10226. (defun anything-compile-source--info-index (source)
  10227. (anything-aif (anything-interpret-value (assoc-default 'info-index source))
  10228. (anything-c-make-info-source source it)
  10229. source))
  10230. (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
  10231. (anything-document-attribute 'info-index "info-index plugin"
  10232. "Create a source of info index very easily.
  10233. ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
  10234. (anything-document-attribute 'index-nodes "info-index plugin (optional)"
  10235. "Index nodes of info file.
  10236. If it is omitted, `Info-index-nodes' is used to collect index nodes.
  10237. Some info files are missing index specification.
  10238. ex. See `anything-c-source-info-screen'.")
  10239. ;; Plug-in: candidates-file
  10240. (defun anything-compile-source--candidates-file (source)
  10241. (if (assoc-default 'candidates-file source)
  10242. `((init anything-p-candidats-file-init
  10243. ,@(let ((orig-init (assoc-default 'init source)))
  10244. (cond ((null orig-init) nil)
  10245. ((functionp orig-init) (list orig-init))
  10246. (t orig-init))))
  10247. (candidates-in-buffer)
  10248. ,@source)
  10249. source))
  10250. (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
  10251. (defun anything-p-candidats-file-init ()
  10252. (destructuring-bind (file &optional updating)
  10253. (anything-mklist (anything-attr 'candidates-file))
  10254. (setq file (anything-interpret-value file))
  10255. (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
  10256. (when updating
  10257. (buffer-disable-undo)
  10258. (font-lock-mode -1)
  10259. (auto-revert-mode 1)))))
  10260. (anything-document-attribute 'candidates-file "candidates-file plugin"
  10261. "Use a file as the candidates buffer.
  10262. 1st argument is a filename, string or function name or variable name.
  10263. If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
  10264. ;; Plug-in: headline
  10265. (defun anything-compile-source--anything-headline (source)
  10266. (if (assoc-default 'headline source)
  10267. (append '((init . anything-headline-init)
  10268. (get-line . buffer-substring)
  10269. (type . line))
  10270. source
  10271. '((candidates-in-buffer)
  10272. (persistent-help . "Show this line")))
  10273. source))
  10274. (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
  10275. (defun anything-headline-init ()
  10276. (when (and (anything-current-buffer-is-modified)
  10277. (with-anything-current-buffer
  10278. (eval (or (anything-attr 'condition) t))))
  10279. (anything-headline-make-candidate-buffer
  10280. (anything-interpret-value (anything-attr 'headline))
  10281. (anything-interpret-value (anything-attr 'subexp)))))
  10282. (anything-document-attribute 'headline "Headline plug-in"
  10283. "Regexp string for anything-headline to scan.")
  10284. (anything-document-attribute 'condition "Headline plug-in"
  10285. "A sexp representing the condition to use anything-headline.")
  10286. (anything-document-attribute 'subexp "Headline plug-in"
  10287. "Display (match-string-no-properties subexp).")
  10288. ;; Le Wang: Note on how `anything-head-line-get-candidates' works with a list
  10289. ;; of regexps.
  10290. ;;
  10291. ;; 1. Create list of ((title . start-of-match) . hiearchy)
  10292. ;; 2. Sort this list by start-of-match.
  10293. ;; 3. Go through sorted list and return titles that reflect full hiearchy.
  10294. ;;
  10295. ;; It's quite brilliantly written.
  10296. ;;
  10297. (defun anything-headline-get-candidates (regexp subexp)
  10298. (with-anything-current-buffer
  10299. (save-excursion
  10300. (goto-char (point-min))
  10301. (if (functionp regexp) (setq regexp (funcall regexp)))
  10302. (let (hierarchy curhead)
  10303. (flet ((matched ()
  10304. (if (numberp subexp)
  10305. (cons (match-string-no-properties subexp) (match-beginning subexp))
  10306. (cons (buffer-substring (point-at-bol) (point-at-eol))
  10307. (point-at-bol))))
  10308. (hierarchies (headlines)
  10309. (1+ (loop for (_ . hierarchy) in headlines
  10310. maximize hierarchy)))
  10311. (vector-0-n (v n)
  10312. (loop for i from 0 to hierarchy
  10313. collecting (aref curhead i)))
  10314. (arrange (headlines)
  10315. (unless (null headlines) ; FIX headlines empty bug!
  10316. (loop with curhead = (make-vector (hierarchies headlines) "")
  10317. for ((str . pt) . hierarchy) in headlines
  10318. do (aset curhead hierarchy str)
  10319. collecting
  10320. (cons
  10321. (format "H%d:%s" (1+ hierarchy)
  10322. (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
  10323. pt)))))
  10324. (if (listp regexp)
  10325. (arrange
  10326. (sort
  10327. (loop for re in regexp
  10328. for hierarchy from 0
  10329. do (goto-char (point-min))
  10330. appending
  10331. (loop
  10332. while (re-search-forward re nil t)
  10333. collect (cons (matched) hierarchy)))
  10334. (lambda (a b) (> (cdar b) (cdar a)))))
  10335. (loop while (re-search-forward regexp nil t)
  10336. collect (matched))))))))
  10337. (defun anything-headline-make-candidate-buffer (regexp subexp)
  10338. (with-current-buffer (anything-candidate-buffer 'local)
  10339. (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
  10340. do (insert
  10341. (format "%5d:%s\n"
  10342. (with-anything-current-buffer
  10343. (line-number-at-pos pos))
  10344. content)))))
  10345. (defun anything-headline-goto-position (pos recenter)
  10346. (goto-char pos)
  10347. (unless recenter
  10348. (set-window-start (get-buffer-window anything-current-buffer) (point))))
  10349. ;; Plug-in: persistent-help
  10350. (defun anything-compile-source--persistent-help (source)
  10351. (append source '((header-line . anything-persistent-help-string))))
  10352. (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
  10353. (defun anything-persistent-help-string ()
  10354. (substitute-command-keys
  10355. (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
  10356. (or (anything-interpret-value (anything-attr 'persistent-help))
  10357. (anything-aif (or (assoc-default 'persistent-action
  10358. (anything-get-current-source))
  10359. (assoc-default 'action
  10360. (anything-get-current-source)))
  10361. (cond ((symbolp it) (symbol-name it))
  10362. ((listp it) (or (ignore-errors (caar it)) ""))))
  10363. "")
  10364. " (keeping session)")))
  10365. (anything-document-attribute 'persistent-help "persistent-help plug-in"
  10366. "A string to explain persistent-action of this source.
  10367. It also accepts a function or a variable name.")
  10368. ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
  10369. ;; Plug-in: Type customize
  10370. (defun anything-c-uniq-list (lst)
  10371. "Like `remove-duplicates' in CL.
  10372. But cut deeper duplicates and test by `equal'. "
  10373. (reverse (remove-duplicates (reverse lst) :test 'equal)))
  10374. (defvar anything-additional-type-attributes nil)
  10375. (defun anything-c-arrange-type-attribute (type spec)
  10376. "Override type attributes by `define-anything-type-attribute'.
  10377. The SPEC is like source. The symbol `REST' is replaced
  10378. with original attribute value.
  10379. Example: Set `play-sound-file' as default action
  10380. (anything-c-arrange-type-attribute 'file
  10381. '((action (\"Play sound\" . play-sound-file)
  10382. REST ;; Rest of actions (find-file, find-file-other-window, etc...)."
  10383. (add-to-list 'anything-additional-type-attributes
  10384. (cons type
  10385. (loop with typeattr = (assoc-default
  10386. type anything-type-attributes)
  10387. for (attr . value) in spec
  10388. if (listp value)
  10389. collect (cons attr
  10390. (anything-c-uniq-list
  10391. (loop for v in value
  10392. if (eq v 'REST)
  10393. append
  10394. (assoc-default attr typeattr)
  10395. else
  10396. collect v)))
  10397. else
  10398. collect (cons attr value)))))
  10399. (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
  10400. (defun anything-compile-source--type-customize (source)
  10401. (anything-aif (assoc-default (assoc-default 'type source)
  10402. anything-additional-type-attributes)
  10403. (append it source)
  10404. source))
  10405. (add-to-list 'anything-compile-source-functions
  10406. 'anything-compile-source--type-customize t)
  10407. ;; Plug-in: default-action
  10408. (defun anything-compile-source--default-action (source)
  10409. (anything-aif (assoc-default 'default-action source)
  10410. (append `((action ,it ,@(remove it (assoc-default 'action source))))
  10411. source)
  10412. source))
  10413. (add-to-list 'anything-compile-source-functions
  10414. 'anything-compile-source--default-action t)
  10415. (anything-document-attribute 'default-action "default-action plug-in"
  10416. "Default action.")
  10417. ;;; Type Attributes
  10418. ;;
  10419. ;;
  10420. (define-anything-type-attribute 'buffer
  10421. `((action
  10422. ("Switch to buffer" . anything-c-switch-to-buffer)
  10423. ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
  10424. ("Switch to buffer other window" . switch-to-buffer-other-window)
  10425. ("Switch to buffer other frame" . switch-to-buffer-other-frame)
  10426. ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
  10427. ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
  10428. ("Query replace" . anything-c-buffer-query-replace)
  10429. ("View buffer" . view-buffer)
  10430. ("Display buffer" . display-buffer)
  10431. ("Grep buffers (C-u grep all buffers)" . anything-c-zgrep-buffers)
  10432. ("Revert buffer(s)" . anything-revert-marked-buffers)
  10433. ("Insert buffer" . insert-buffer)
  10434. ("Kill buffer(s)" . anything-kill-marked-buffers)
  10435. ("Diff with file" . diff-buffer-with-file)
  10436. ("Ediff Marked buffers" . anything-ediff-marked-buffers)
  10437. ("Ediff Merge marked buffers" . (lambda (candidate)
  10438. (anything-ediff-marked-buffers candidate t))))
  10439. (persistent-help . "Show this buffer")
  10440. (candidate-transformer anything-c-skip-boring-buffers
  10441. anything-c-transform-buffer-display-string))
  10442. "Buffer or buffer name.")
  10443. (define-anything-type-attribute 'file
  10444. `((action
  10445. ("Find file" . anything-find-many-files)
  10446. ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
  10447. ("Find file as root" . anything-find-file-as-root)
  10448. ("Find file other window" . find-file-other-window)
  10449. ("Find file other frame" . find-file-other-frame)
  10450. ("Open dired in file's directory" . anything-c-open-dired)
  10451. ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
  10452. ("Zgrep File(s) `C-u Recurse'" . anything-ff-zgrep)
  10453. ("Pdfgrep File(s)" . anything-ff-pdfgrep)
  10454. ("Checksum File" . anything-ff-checksum)
  10455. ("Ediff File" . anything-find-files-ediff-files)
  10456. ("Ediff Merge File" . anything-find-files-ediff-merge-files)
  10457. ("View file" . view-file)
  10458. ("Insert file" . insert-file)
  10459. ("Delete file(s)" . anything-delete-marked-files)
  10460. ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
  10461. ("Open file with default tool" . anything-c-open-file-with-default-tool)
  10462. ("Find file in hex dump" . hexl-find-file))
  10463. (persistent-help . "Show this file")
  10464. (action-transformer anything-c-transform-file-load-el
  10465. anything-c-transform-file-browse-url)
  10466. (candidate-transformer anything-c-w32-pathname-transformer
  10467. anything-c-skip-current-file
  10468. anything-c-skip-boring-files
  10469. anything-c-shorten-home-path))
  10470. "File name.")
  10471. (let ((actions '(("Describe command" . describe-function)
  10472. ("Add command to kill ring" . anything-c-kill-new)
  10473. ("Go to command's definition" . find-function)
  10474. ("Debug on entry" . debug-on-entry)
  10475. ("Cancel debug on entry" . cancel-debug-on-entry)
  10476. ("Trace function" . trace-function)
  10477. ("Trace function (background)" . trace-function-background)
  10478. ("Untrace function" . untrace-function))))
  10479. (define-anything-type-attribute 'command
  10480. `((action ("Call interactively" . anything-c-call-interactively)
  10481. ,@actions)
  10482. (coerce . anything-c-symbolify)
  10483. (persistent-action . describe-function))
  10484. "Command. (string or symbol)")
  10485. (define-anything-type-attribute 'function
  10486. `((action . ,actions)
  10487. (action-transformer anything-c-transform-function-call-interactively)
  10488. (candidate-transformer anything-c-mark-interactive-functions)
  10489. (coerce . anything-c-symbolify))
  10490. "Function. (string or symbol)"))
  10491. (define-anything-type-attribute 'variable
  10492. '((action ("Describe variable" . describe-variable)
  10493. ("Add variable to kill ring" . anything-c-kill-new)
  10494. ("Go to variable's definition" . find-variable)
  10495. ("Set variable" . anything-c-set-variable))
  10496. (coerce . anything-c-symbolify))
  10497. "Variable.")
  10498. (define-anything-type-attribute 'sexp
  10499. '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
  10500. ("Add s-expression to kill ring" . kill-new))
  10501. (action-transformer anything-c-transform-sexp-eval-command-sexp))
  10502. "String representing S-Expressions.")
  10503. (define-anything-type-attribute 'bookmark
  10504. `((coerce . anything-bookmark-get-bookmark-from-name)
  10505. (action
  10506. ("Jump to bookmark" . anything-c-bookmark-jump)
  10507. ("Jump to BM other window" . bookmark-jump-other-window)
  10508. ("Bookmark edit annotation" . bookmark-edit-annotation)
  10509. ("Bookmark show annotation" . bookmark-show-annotation)
  10510. ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
  10511. ,@(and (locate-library "bookmark-extensions")
  10512. `(("Edit Bookmark" . bmkext-edit-bookmark)))
  10513. ("Rename bookmark" . bookmark-rename)
  10514. ("Relocate bookmark" . bookmark-relocate))
  10515. (keymap . ,anything-c-bookmark-map)
  10516. (mode-line . anything-bookmark-mode-line-string))
  10517. "Bookmark name.")
  10518. (define-anything-type-attribute 'line
  10519. '((display-to-real . anything-c-display-to-real-line)
  10520. (action ("Go to Line" . anything-c-action-line-goto)))
  10521. "LINENO:CONTENT string, eg. \" 16:foo\".
  10522. Optional `target-file' attribute is a name of target file.
  10523. Optional `before-jump-hook' attribute is a function with no
  10524. arguments which is called before jumping to position.
  10525. Optional `after-jump-hook' attribute is a function with no
  10526. arguments which is called after jumping to position.
  10527. If `adjust' attribute is specified, searches the line whose
  10528. content is CONTENT near the LINENO.
  10529. If `recenter' attribute is specified, the line is displayed at
  10530. the center of window, otherwise at the top of window.
  10531. ")
  10532. (define-anything-type-attribute 'file-line
  10533. `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
  10534. (multiline)
  10535. (action ("Go to" . anything-c-action-file-line-goto)))
  10536. "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
  10537. Optional `default-directory' attribute is a default-directory
  10538. FILENAME is interpreted.
  10539. Optional `before-jump-hook' attribute is a function with no
  10540. arguments which is called before jumping to position.
  10541. Optional `after-jump-hook' attribute is a function with no
  10542. arguments which is called after jumping to position.
  10543. If `adjust' attribute is specified, searches the line whose
  10544. content is CONTENT near the LINENO.
  10545. If `recenter' attribute is specified, the line is displayed at
  10546. the center of window, otherwise at the top of window.
  10547. ")
  10548. (define-anything-type-attribute 'timer
  10549. '((real-to-display . anything-c-timer-real-to-display)
  10550. (action ("Cancel Timer" . cancel-timer)
  10551. ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
  10552. ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
  10553. (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
  10554. (persistent-help . "Describe Function"))
  10555. "Timer.")
  10556. ;;; Default `anything-sources'
  10557. ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
  10558. ;; tend to invoke M-x anything directly. So I offer default setting.
  10559. (setq anything-sources
  10560. '(anything-c-source-buffers-list
  10561. anything-c-source-recentf
  10562. anything-c-source-files-in-current-dir+))
  10563. ;;; Preconfigured Anything
  10564. ;;
  10565. ;;
  10566. ;;;###autoload
  10567. (defun anything-mini ()
  10568. "Preconfigured `anything' lightweight version \(buffer -> recentf\)."
  10569. (interactive)
  10570. (anything-other-buffer '(anything-c-source-buffers-list
  10571. anything-c-source-recentf
  10572. anything-c-source-buffer-not-found)
  10573. "*anything mini*"))
  10574. ;;;###autoload
  10575. (defun anything-for-files ()
  10576. "Preconfigured `anything' for opening files.
  10577. ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate."
  10578. (interactive)
  10579. (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
  10580. ;;;###autoload
  10581. (defun anything-recentf ()
  10582. "Preconfigured `anything' for `recentf'."
  10583. (interactive)
  10584. (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
  10585. ;;;###autoload
  10586. (defun anything-info-at-point (arg)
  10587. "Preconfigured `anything' for searching info at point.
  10588. With a prefix-arg insert symbol at point."
  10589. (interactive "P")
  10590. (let ((anything-c-google-suggest-default-function
  10591. 'anything-c-google-suggest-emacs-lisp))
  10592. (anything :sources '(anything-c-source-info-elisp
  10593. anything-c-source-info-cl
  10594. anything-c-source-info-pages
  10595. anything-c-source-google-suggest)
  10596. :input (and arg (thing-at-point 'symbol))
  10597. :buffer "*anything info*")))
  10598. ;;;###autoload
  10599. (defun anything-show-kill-ring ()
  10600. "Preconfigured `anything' for `kill-ring'.
  10601. It is drop-in replacement of `yank-pop'.
  10602. You may bind this command to M-y.
  10603. First call open the kill-ring browser, next calls move to next line."
  10604. (interactive)
  10605. (anything :sources 'anything-c-source-kill-ring
  10606. :buffer "*anything kill-ring*"))
  10607. ;;;###autoload
  10608. (defun anything-minibuffer-history ()
  10609. "Preconfigured `anything' for `minibuffer-history'."
  10610. (interactive)
  10611. (let ((enable-recursive-minibuffers t))
  10612. (anything-other-buffer 'anything-c-source-minibuffer-history
  10613. "*anything minibuffer-history*")))
  10614. ;;;###autoload
  10615. (defun anything-gentoo ()
  10616. "Preconfigured `anything' for gentoo linux."
  10617. (interactive)
  10618. (anything-other-buffer '(anything-c-source-gentoo
  10619. anything-c-source-use-flags)
  10620. "*anything gentoo*"))
  10621. ;;;###autoload
  10622. (defun anything-imenu ()
  10623. "Preconfigured `anything' for `imenu'."
  10624. (interactive)
  10625. (anything :sources 'anything-c-source-imenu
  10626. :buffer "*anything imenu*"))
  10627. ;;;###autoload
  10628. (defun anything-google-suggest ()
  10629. "Preconfigured `anything' for google search with google suggest."
  10630. (interactive)
  10631. (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
  10632. ;;;###autoload
  10633. (defun anything-yahoo-suggest ()
  10634. "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
  10635. (interactive)
  10636. (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
  10637. ;;; Converted from anything-show-*-only
  10638. ;;;###autoload
  10639. (defun anything-for-buffers ()
  10640. "Preconfigured `anything' for buffers."
  10641. (interactive)
  10642. (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
  10643. ;;;###autoload
  10644. (defun anything-buffers-list ()
  10645. "Preconfigured `anything' to list buffers.
  10646. It is an enhanced version of `anything-for-buffers'."
  10647. (interactive)
  10648. (anything :sources '(anything-c-source-buffers-list
  10649. anything-c-source-buffer-not-found)
  10650. :buffer "*anything buffers*" :keymap anything-c-buffer-map))
  10651. (defalias 'anything-buffers+ 'anything-buffers-list
  10652. "Preconfigured `anything' to list buffers.
  10653. It is an alias of `anything-buffers-list'.")
  10654. ;;;###autoload
  10655. (defun anything-bbdb ()
  10656. "Preconfigured `anything' for BBDB.
  10657. Needs BBDB.
  10658. http://bbdb.sourceforge.net/"
  10659. (interactive)
  10660. (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
  10661. ;;;###autoload
  10662. (defun anything-locate (arg)
  10663. "Preconfigured `anything' for Locate.
  10664. Note: you can add locate options after entering pattern.
  10665. See 'man locate' for valid options.
  10666. You can specify a specific database with prefix argument ARG \(C-u\).
  10667. Many databases can be used: navigate and mark them.
  10668. See also `anything-locate-with-db'.
  10669. To create a user specific db, use
  10670. \"updatedb -l 0 -o db_path -U directory\".
  10671. Where db_path is a filename matched by
  10672. `anything-locate-db-file-regexp'."
  10673. (interactive "P")
  10674. (setq anything-ff-default-directory default-directory)
  10675. (anything-locate-1 arg))
  10676. ;;;###autoload
  10677. (defun anything-w3m-bookmarks ()
  10678. "Preconfigured `anything' for w3m bookmark.
  10679. Needs w3m and emacs-w3m.
  10680. http://w3m.sourceforge.net/
  10681. http://emacs-w3m.namazu.org/"
  10682. (interactive)
  10683. (anything-other-buffer 'anything-c-source-w3m-bookmarks
  10684. "*anything w3m bookmarks*"))
  10685. ;;;###autoload
  10686. (defun anything-firefox-bookmarks ()
  10687. "Preconfigured `anything' for firefox bookmark.
  10688. You will have to enable html bookmarks in firefox:
  10689. open about:config in firefox and double click on this line to enable value \
  10690. to true:
  10691. user_pref(\"browser.bookmarks.autoExportHTML\", false);
  10692. You should have now:
  10693. user_pref(\"browser.bookmarks.autoExportHTML\", true);
  10694. After closing firefox, you will be able to browse you bookmarks.
  10695. "
  10696. (interactive)
  10697. (anything-other-buffer 'anything-c-source-firefox-bookmarks
  10698. "*Anything Firefox*"))
  10699. ;;;###autoload
  10700. (defun anything-colors ()
  10701. "Preconfigured `anything' for color."
  10702. (interactive)
  10703. (anything-other-buffer
  10704. '(anything-c-source-colors anything-c-source-customize-face)
  10705. "*anything colors*"))
  10706. ;;;###autoload
  10707. (defun anything-bookmarks ()
  10708. "Preconfigured `anything' for bookmarks."
  10709. (interactive)
  10710. (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
  10711. ;;;###autoload
  10712. (defun anything-c-pp-bookmarks ()
  10713. "Preconfigured `anything' for bookmarks (pretty-printed)."
  10714. (interactive)
  10715. (anything-other-buffer '(anything-c-source-bookmarks-local
  10716. anything-c-source-bookmarks-su
  10717. anything-c-source-bookmarks-ssh)
  10718. "*anything pp bookmarks*"))
  10719. ;;;###autoload
  10720. (defun anything-c-insert-latex-math ()
  10721. "Preconfigured anything for latex math symbols completion."
  10722. (interactive)
  10723. (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
  10724. ;;;###autoload
  10725. (defun anything-register ()
  10726. "Preconfigured `anything' for Emacs registers."
  10727. (interactive)
  10728. (anything-other-buffer 'anything-c-source-register "*anything register*"))
  10729. ;;;###autoload
  10730. (defun anything-man-woman ()
  10731. "Preconfigured `anything' for Man and Woman pages."
  10732. (interactive)
  10733. (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
  10734. ;;;###autoload
  10735. (defun anything-org-keywords ()
  10736. "Preconfigured `anything' for org keywords."
  10737. (interactive)
  10738. (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
  10739. ;;;###autoload
  10740. (defun anything-emms ()
  10741. "Preconfigured `anything' for emms sources."
  10742. (interactive)
  10743. (anything :sources '(anything-c-source-emms-streams
  10744. anything-c-source-emms-files
  10745. anything-c-source-emms-dired)
  10746. :buffer "*Anything Emms*"))
  10747. ;;;###autoload
  10748. (defun anything-eev-anchors ()
  10749. "Preconfigured `anything' for eev anchors."
  10750. (interactive)
  10751. (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
  10752. ;;;###autoload
  10753. (defun anything-bm-list ()
  10754. "Preconfigured `anything' for visible bookmarks.
  10755. Needs bm.el
  10756. http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
  10757. (interactive)
  10758. (let ((anything-outline-using t))
  10759. (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
  10760. ;;;###autoload
  10761. (defun anything-timers ()
  10762. "Preconfigured `anything' for timers."
  10763. (interactive)
  10764. (anything-other-buffer '(anything-c-source-absolute-time-timers
  10765. anything-c-source-idle-time-timers)
  10766. "*anything timers*"))
  10767. ;;;###autoload
  10768. (defun anything-list-emacs-process ()
  10769. "Preconfigured `anything' for emacs process."
  10770. (interactive)
  10771. (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
  10772. ;;;###autoload
  10773. (defun anything-occur ()
  10774. "Preconfigured Anything for Occur source.
  10775. If region is active, search only in region,
  10776. otherwise search in whole buffer."
  10777. (interactive)
  10778. (let ((anything-compile-source-functions
  10779. ;; rule out anything-match-plugin because the input is one regexp.
  10780. (delq 'anything-compile-source--match-plugin
  10781. (copy-sequence anything-compile-source-functions))))
  10782. (anything :sources 'anything-c-source-occur
  10783. :buffer "*Anything Occur*"
  10784. :history 'anything-c-grep-history)))
  10785. ;;;###autoload
  10786. (defun anything-browse-code ()
  10787. "Preconfigured anything to browse code."
  10788. (interactive)
  10789. (anything :sources 'anything-c-source-browse-code
  10790. :buffer "*anything browse code*"
  10791. :default (thing-at-point 'symbol)))
  10792. ;;;###autoload
  10793. (defun anything-org-headlines ()
  10794. "Preconfigured anything to show org headlines."
  10795. (interactive)
  10796. (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
  10797. ;;;###autoload
  10798. (defun anything-regexp ()
  10799. "Preconfigured anything to build regexps.
  10800. `query-replace-regexp' can be run from there against found regexp."
  10801. (interactive)
  10802. (save-restriction
  10803. (let ((anything-compile-source-functions
  10804. ;; rule out anything-match-plugin because the input is one regexp.
  10805. (delq 'anything-compile-source--match-plugin
  10806. (copy-sequence anything-compile-source-functions))))
  10807. (when (and (anything-region-active-p)
  10808. ;; Don't narrow to region if buffer is already narrowed.
  10809. (not (anything-current-buffer-narrowed-p)))
  10810. (narrow-to-region (region-beginning) (region-end)))
  10811. (anything :sources anything-c-source-regexp
  10812. :buffer "*anything regexp*"
  10813. :prompt "Regexp: "
  10814. :history 'anything-build-regexp-history))))
  10815. ;;;###autoload
  10816. (defun anything-c-copy-files-async ()
  10817. "Preconfigured anything to copy file list FLIST to DEST asynchronously."
  10818. (interactive)
  10819. (let* ((flist (anything-c-read-file-name
  10820. "Copy File async: "
  10821. :marked-candidates t))
  10822. (dest (anything-c-read-file-name
  10823. "Copy File async To: "
  10824. :preselect (car flist)
  10825. :initial-input (car anything-ff-history)
  10826. :history (anything-find-files-history :comp-read nil))))
  10827. (anything-c-copy-async-with-log flist dest)))
  10828. ;;;###autoload
  10829. (defun anything-find-files (arg)
  10830. "Preconfigured `anything' for anything implementation of `find-file'.
  10831. Called with a prefix arg show history if some.
  10832. Don't call it from programs, use `anything-find-files-1' instead.
  10833. This is the starting point for nearly all actions you can do on files."
  10834. (interactive "P")
  10835. (let ((any-input (if (and arg anything-ff-history)
  10836. (anything-find-files-history)
  10837. (anything-find-files-initial-input)))
  10838. (presel (buffer-file-name (current-buffer))))
  10839. (when (and (eq major-mode 'org-agenda-mode)
  10840. org-directory
  10841. (not any-input))
  10842. (setq any-input (expand-file-name org-directory)))
  10843. (set-text-properties 0 (length any-input) nil any-input)
  10844. (if any-input
  10845. (anything-find-files-1 any-input)
  10846. (setq any-input (expand-file-name (anything-c-current-directory)))
  10847. (anything-find-files-1
  10848. any-input (if anything-ff-transformer-show-only-basename
  10849. (and presel (anything-c-basename presel))
  10850. presel)))))
  10851. ;;;###autoload
  10852. (defun anything-write-file ()
  10853. "Preconfigured `anything' providing completion for `write-file'."
  10854. (interactive)
  10855. (let ((anything-mp-highlight-delay nil))
  10856. (anything :sources 'anything-c-source-write-file
  10857. :input (expand-file-name default-directory)
  10858. :prompt "Write buffer to file: "
  10859. :buffer "*Anything write file*")))
  10860. ;;;###autoload
  10861. (defun anything-insert-file ()
  10862. "Preconfigured `anything' providing completion for `insert-file'."
  10863. (interactive)
  10864. (let ((anything-mp-highlight-delay nil))
  10865. (anything :sources 'anything-c-source-insert-file
  10866. :input (expand-file-name default-directory)
  10867. :prompt "Insert file: "
  10868. :buffer "*Anything insert file*")))
  10869. ;;;###autoload
  10870. (defun anything-dired-rename-file ()
  10871. "Preconfigured `anything' to rename files from dired."
  10872. (interactive)
  10873. (anything-dired-do-action-on-file :action 'rename))
  10874. ;;;###autoload
  10875. (defun anything-dired-copy-file ()
  10876. "Preconfigured `anything' to copy files from dired."
  10877. (interactive)
  10878. (anything-dired-do-action-on-file :action 'copy))
  10879. ;;;###autoload
  10880. (defun anything-dired-symlink-file ()
  10881. "Preconfigured `anything' to symlink files from dired."
  10882. (interactive)
  10883. (anything-dired-do-action-on-file :action 'symlink))
  10884. ;;;###autoload
  10885. (defun anything-dired-hardlink-file ()
  10886. "Preconfigured `anything' to hardlink files from dired."
  10887. (interactive)
  10888. (anything-dired-do-action-on-file :action 'hardlink))
  10889. ;;;###autoload
  10890. (defun anything-do-grep ()
  10891. "Preconfigured anything for grep.
  10892. Contrarily to Emacs `grep' no default directory is given, but
  10893. the full path of candidates in ONLY.
  10894. That allow to grep different files not only in `default-directory' but anywhere
  10895. by marking them (C-<SPACE>). If one or more directory is selected
  10896. grep will search in all files of these directories.
  10897. You can use also wildcard in the base name of candidate.
  10898. If a prefix arg is given use the -r option of grep.
  10899. The prefix arg can be passed before or after start.
  10900. See also `anything-do-grep-1'."
  10901. (interactive)
  10902. (let ((only (anything-c-read-file-name
  10903. "Search in file(s): "
  10904. :marked-candidates t
  10905. :preselect (or (dired-get-filename nil t)
  10906. (buffer-file-name (current-buffer)))))
  10907. (prefarg (or current-prefix-arg anything-current-prefix-arg)))
  10908. (anything-do-grep-1 only prefarg)))
  10909. ;;;###autoload
  10910. (defun anything-do-zgrep ()
  10911. "Preconfigured anything for zgrep."
  10912. (interactive)
  10913. (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
  10914. (ls (anything-c-read-file-name
  10915. "Search in file(s): "
  10916. :marked-candidates t
  10917. :preselect (or (dired-get-filename nil t)
  10918. (buffer-file-name (current-buffer))))))
  10919. (anything-ff-zgrep-1 ls prefarg)))
  10920. ;;;###autoload
  10921. (defun anything-do-pdfgrep ()
  10922. "Preconfigured anything for pdfgrep."
  10923. (interactive)
  10924. (let ((only (anything-c-read-file-name
  10925. "Search in file(s): "
  10926. :marked-candidates t
  10927. :test #'(lambda (file)
  10928. (or (string= (file-name-extension file) "pdf")
  10929. (string= (file-name-extension file) "PDF")
  10930. (file-directory-p file)))
  10931. :preselect (or (dired-get-filename nil t)
  10932. (buffer-file-name (current-buffer)))))
  10933. (anything-c-grep-default-function 'anything-c-pdfgrep-init))
  10934. (anything-do-pdfgrep-1 only)))
  10935. ;;;###autoload
  10936. (defun anything-c-etags-select (arg)
  10937. "Preconfigured anything for etags.
  10938. Called with one prefix arg use symbol at point as initial input.
  10939. Called with two prefix arg reinitialize cache.
  10940. If tag file have been modified reinitialize cache."
  10941. (interactive "P")
  10942. (let ((tag (anything-c-etags-get-tag-file))
  10943. (init (and (equal arg '(4)) (thing-at-point 'symbol)))
  10944. (anything-quit-if-no-candidate t)
  10945. (anything-execute-action-at-once-if-one t)
  10946. (anything-compile-source-functions
  10947. (if anything-c-etags-use-regexp-search
  10948. ;; rule out anything-match-plugin because the input is one regexp.
  10949. (delq 'anything-compile-source--match-plugin
  10950. (copy-sequence anything-compile-source-functions))
  10951. anything-compile-source-functions)))
  10952. (when (or (equal arg '(16))
  10953. (and anything-c-etags-mtime-alist
  10954. (anything-c-etags-file-modified-p tag)))
  10955. (remhash tag anything-c-etags-cache))
  10956. (if (and tag (file-exists-p tag))
  10957. (anything :sources 'anything-c-source-etags-select
  10958. :keymap anything-c-etags-map
  10959. :input init
  10960. :buffer "*anything etags*")
  10961. (message "Error: No tag file found, please create one with etags shell command."))))
  10962. ;;;###autoload
  10963. (defun anything-filelist ()
  10964. "Preconfigured `anything' to open files instantly.
  10965. See `anything-c-filelist-file-name' docstring for usage."
  10966. (interactive)
  10967. (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
  10968. ;;;###autoload
  10969. (defun anything-filelist+ ()
  10970. "Preconfigured `anything' to open files/buffers/bookmarks instantly.
  10971. This is a replacement for `anything-for-files'.
  10972. See `anything-c-filelist-file-name' docstring for usage."
  10973. (interactive)
  10974. (anything-other-buffer
  10975. '(anything-c-source-ffap-line
  10976. anything-c-source-ffap-guesser
  10977. anything-c-source-buffers-list
  10978. anything-c-source-recentf
  10979. anything-c-source-bookmarks
  10980. anything-c-source-file-cache
  10981. anything-c-source-filelist)
  10982. "*anything file list*"))
  10983. ;;;###autoload
  10984. (defun anything-M-x ()
  10985. "Preconfigured `anything' for Emacs commands.
  10986. It is `anything' replacement of regular `M-x' `execute-extended-command'."
  10987. (interactive)
  10988. (let* (in-help
  10989. help-cand
  10990. special-display-buffer-names
  10991. special-display-regexps
  10992. anything-persistent-action-use-special-display
  10993. (history (loop with hist
  10994. for i in extended-command-history
  10995. for com = (intern i)
  10996. when (fboundp com)
  10997. collect i into hist finally return hist)))
  10998. (flet ((pers-help (candidate)
  10999. (let ((hbuf (get-buffer (help-buffer))))
  11000. (if (and in-help (string= candidate help-cand))
  11001. (progn
  11002. ;; When M-x is started from a help buffer,
  11003. ;; Don't kill it as it is anything-current-buffer.
  11004. (unless (equal hbuf anything-current-buffer)
  11005. (kill-buffer hbuf))
  11006. (setq in-help nil))
  11007. ;; Be sure anything-current-buffer
  11008. ;; have not a dedicated window.
  11009. (set-window-dedicated-p
  11010. (get-buffer-window anything-current-buffer) nil)
  11011. (describe-function (intern candidate))
  11012. (message nil) ; Erase the new stupid message Type "q"[...]
  11013. (setq in-help t))
  11014. (setq help-cand candidate))))
  11015. (let* ((command (anything-comp-read
  11016. "M-x " obarray
  11017. :test 'commandp
  11018. :requires-pattern anything-M-x-requires-pattern
  11019. :name "Emacs Commands"
  11020. :buffer "*anything M-x*"
  11021. :persistent-action 'pers-help
  11022. :persistent-help "Describe this command"
  11023. :history history
  11024. :must-match t
  11025. :candidates-in-buffer t
  11026. :fc-transformer 'anything-M-x-transformer))
  11027. (sym-com (intern command)))
  11028. (unless current-prefix-arg
  11029. (setq current-prefix-arg anything-current-prefix-arg))
  11030. ;; Avoid having `this-command' set to *exit-minibuffer.
  11031. (setq this-command sym-com)
  11032. (call-interactively sym-com)
  11033. (setq extended-command-history
  11034. (cons command (delete command history)))))))
  11035. ;;;###autoload
  11036. (defun anything-manage-advice ()
  11037. "Preconfigured `anything' to disable/enable function advices."
  11038. (interactive)
  11039. (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
  11040. ;;;###autoload
  11041. (defun anything-bookmark-ext ()
  11042. "Preconfigured `anything' for bookmark-extensions sources.
  11043. Needs bookmark-ext.el:
  11044. <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
  11045. Contain also `anything-c-source-google-suggest'."
  11046. (interactive)
  11047. (anything
  11048. :sources
  11049. '(anything-c-source-bookmark-files&dirs
  11050. anything-c-source-bookmark-w3m
  11051. anything-c-source-google-suggest
  11052. anything-c-source-bmkext-addressbook
  11053. anything-c-source-bookmark-gnus
  11054. anything-c-source-bookmark-info
  11055. anything-c-source-bookmark-man
  11056. anything-c-source-bookmark-images
  11057. anything-c-source-bookmark-su-files&dirs
  11058. anything-c-source-bookmark-ssh-files&dirs)
  11059. :prompt "SearchBookmark: "
  11060. :buffer "*anything bmkext*"))
  11061. ;;;###autoload
  11062. (defun anything-simple-call-tree ()
  11063. "Preconfigured `anything' for simple-call-tree. List function relationships.
  11064. Needs simple-call-tree.el.
  11065. http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
  11066. (interactive)
  11067. (anything-other-buffer
  11068. '(anything-c-source-simple-call-tree-functions-callers
  11069. anything-c-source-simple-call-tree-callers-functions)
  11070. "*anything simple-call-tree*"))
  11071. ;;;###autoload
  11072. (defun anything-mark-ring ()
  11073. "Preconfigured `anything' for `anything-c-source-mark-ring'."
  11074. (interactive)
  11075. (anything :sources 'anything-c-source-mark-ring))
  11076. ;;;###autoload
  11077. (defun anything-global-mark-ring ()
  11078. "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
  11079. (interactive)
  11080. (anything :sources 'anything-c-source-global-mark-ring))
  11081. ;;;###autoload
  11082. (defun anything-all-mark-rings ()
  11083. "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
  11084. `anything-c-source-mark-ring'."
  11085. (interactive)
  11086. (anything :sources '(anything-c-source-mark-ring
  11087. anything-c-source-global-mark-ring)))
  11088. ;;;###autoload
  11089. (defun anything-yaoddmuse-emacswiki-edit-or-view ()
  11090. "Preconfigured `anything' to edit or view EmacsWiki page.
  11091. Needs yaoddmuse.el.
  11092. http://www.emacswiki.org/emacs/download/yaoddmuse.el"
  11093. (interactive)
  11094. (anything :sources 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
  11095. ;;;###autoload
  11096. (defun anything-yaoddmuse-emacswiki-post-library ()
  11097. "Preconfigured `anything' to post library to EmacsWiki.
  11098. Needs yaoddmuse.el.
  11099. http://www.emacswiki.org/emacs/download/yaoddmuse.el"
  11100. (interactive)
  11101. (anything :sources 'anything-c-source-yaoddmuse-emacswiki-post-library))
  11102. ;;;###autoload
  11103. (defun anything-eval-expression (arg)
  11104. "Preconfigured anything for `anything-c-source-evaluation-result'."
  11105. (interactive "P")
  11106. (anything :sources 'anything-c-source-evaluation-result
  11107. :input (when arg (thing-at-point 'sexp))
  11108. :buffer "*anything eval*"
  11109. :history 'anything-eval-expression-input-history
  11110. :keymap anything-eval-expression-map))
  11111. ;;;###autoload
  11112. (defun anything-eval-expression-with-eldoc ()
  11113. "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
  11114. (interactive)
  11115. (declare (special eldoc-idle-delay))
  11116. (let ((timer (run-with-idle-timer eldoc-idle-delay
  11117. 'repeat 'anything-eldoc-show-in-eval))
  11118. (minibuffer-completing-symbol t) ; Enable lisp completion.
  11119. (completion-cycle-threshold t)) ; Always cycle, no pesty completion buffer (emacs24 only).
  11120. (unwind-protect
  11121. (minibuffer-with-setup-hook
  11122. 'anything-eldoc-store-minibuffer
  11123. (call-interactively 'anything-eval-expression))
  11124. (and timer (cancel-timer timer))
  11125. (setq anything-eldoc-active-minibuffers-list
  11126. (cdr anything-eldoc-active-minibuffers-list)))))
  11127. ;;;###autoload
  11128. (defun anything-calcul-expression ()
  11129. "Preconfigured anything for `anything-c-source-calculation-result'."
  11130. (interactive)
  11131. (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
  11132. ;;;###autoload
  11133. (defun anything-surfraw (pattern engine)
  11134. "Preconfigured `anything' to search PATTERN with search ENGINE."
  11135. (interactive (list (read-string "SearchFor: "
  11136. nil 'anything-surfraw-input-history)
  11137. (anything-comp-read
  11138. "Engine: "
  11139. (anything-c-build-elvi-list)
  11140. :must-match t
  11141. :name "Surfraw Search Engines"
  11142. :history anything-surfraw-engines-history)))
  11143. (let* ((engine-nodesc (car (split-string engine)))
  11144. (url (with-temp-buffer
  11145. (apply 'call-process "surfraw" nil t nil
  11146. ;;JAVE
  11147. (append (list engine-nodesc "-p") (split-string pattern)))
  11148. (replace-regexp-in-string
  11149. "\n" "" (buffer-string))))
  11150. (browse-url-browser-function (or anything-surfraw-default-browser-function
  11151. browse-url-browser-function)))
  11152. (if (string= engine-nodesc "W")
  11153. (anything-c-browse-url anything-c-home-url)
  11154. (anything-c-browse-url url)
  11155. (setq anything-surfraw-engines-history
  11156. (cons engine (delete engine anything-surfraw-engines-history))))))
  11157. ;;;###autoload
  11158. (defun anything-call-source ()
  11159. "Preconfigured `anything' to call anything source."
  11160. (interactive)
  11161. (anything :sources 'anything-c-source-call-source
  11162. :buffer anything-source-select-buffer))
  11163. ;;;###autoload
  11164. (defun anything-execute-anything-command ()
  11165. "Preconfigured `anything' to execute preconfigured `anything'."
  11166. (interactive)
  11167. (anything-other-buffer 'anything-c-source-anything-commands
  11168. "*anything commands*"))
  11169. ;;;###autoload
  11170. (defun anything-create (&optional string initial-input)
  11171. "Preconfigured `anything' to do many create actions from STRING.
  11172. See also `anything-create--actions'."
  11173. (interactive)
  11174. (setq string (or string (read-string "Create Anything: " initial-input)))
  11175. (anything :sources '(((name . "Anything Create")
  11176. (header-name . (lambda (_) (format "Action for \"%s\"" string)))
  11177. (candidates . anything-create--actions)
  11178. (candidate-number-limit)
  11179. (action . (lambda (func) (funcall func string)))))))
  11180. ;;;###autoload
  11181. (defun anything-top ()
  11182. "Preconfigured `anything' for top command."
  11183. (interactive)
  11184. (let ((anything-samewindow t)
  11185. (anything-enable-shortcuts)
  11186. (anything-display-function 'anything-default-display-buffer)
  11187. (anything-candidate-number-limit 9999))
  11188. (save-window-excursion
  11189. (delete-other-windows)
  11190. (anything-other-buffer 'anything-c-source-top "*anything top*"))))
  11191. ;;;###autoload
  11192. (defun anything-select-xfont ()
  11193. "Preconfigured `anything' to select Xfont."
  11194. (interactive)
  11195. (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
  11196. ;;;###autoload
  11197. (defun anything-world-time ()
  11198. "Preconfigured `anything' to show world time."
  11199. (interactive)
  11200. (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
  11201. ;;;###autoload
  11202. (defun anything-apt (arg)
  11203. "Preconfigured `anything' : frontend of APT package manager.
  11204. With a prefix arg reload cache."
  11205. (interactive "P")
  11206. (let ((query (read-string "Search Package: " nil 'anything-c-apt-input-history)))
  11207. (when arg (anything-c-apt-refresh))
  11208. (anything :sources 'anything-c-source-apt
  11209. :prompt "Search Package: "
  11210. :input query
  11211. :history 'anything-c-apt-input-history)))
  11212. ;;;###autoload
  11213. (defun anything-esh-pcomplete ()
  11214. "Preconfigured anything to provide anything completion in eshell."
  11215. (interactive)
  11216. (let* ((anything-quit-if-no-candidate t)
  11217. (anything-execute-action-at-once-if-one t)
  11218. (target (thing-at-point 'symbol))
  11219. (end (point))
  11220. (beg (or (and target (- end (length target)))
  11221. ;; Nothing at point.
  11222. (progn (insert " ") (point)))))
  11223. (setq anything-ec-target (or target " "))
  11224. (with-anything-show-completion beg end
  11225. (anything :sources 'anything-c-source-esh
  11226. :buffer "*anything pcomplete*"
  11227. :input (anything-ff-set-pattern ; Handle tramp filenames.
  11228. (car (last (ignore-errors ; Needed in lisp symbols completion.
  11229. (pcomplete-parse-arguments)))))))))
  11230. ;;;###autoload
  11231. (defun anything-eshell-history ()
  11232. "Preconfigured anything for eshell history."
  11233. (interactive)
  11234. (let* ((end (point))
  11235. (beg (save-excursion (eshell-bol) (point)))
  11236. (input (buffer-substring beg end))
  11237. flag-empty)
  11238. (when (eq beg end)
  11239. (insert " ")
  11240. (setq flag-empty t)
  11241. (setq end (point)))
  11242. (unwind-protect
  11243. (with-anything-show-completion beg end
  11244. (anything :sources 'anything-c-source-eshell-history
  11245. :buffer "*Eshell history*"
  11246. :input input))
  11247. (when (and flag-empty
  11248. (looking-back " "))
  11249. (delete-char -1)))))
  11250. ;;;###autoload
  11251. (defun anything-c-run-external-command (program)
  11252. "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
  11253. If program is already running exit with error.
  11254. You can set your own list of commands with
  11255. `anything-c-external-commands-list'."
  11256. (interactive (list
  11257. (anything-comp-read
  11258. "RunProgram: "
  11259. (anything-c-external-commands-list-1 'sort)
  11260. :must-match t
  11261. :name "External Commands"
  11262. :history anything-external-command-history)))
  11263. (anything-run-or-raise program)
  11264. (setq anything-external-command-history
  11265. (cons program (delete program
  11266. (loop for i in anything-external-command-history
  11267. when (executable-find i) collect i)))))
  11268. ;;;###autoload
  11269. (defun anything-ratpoison-commands ()
  11270. "Preconfigured `anything' to execute ratpoison commands."
  11271. (interactive)
  11272. (anything-other-buffer 'anything-c-source-ratpoison-commands
  11273. "*anything ratpoison commands*"))
  11274. ;;;###autoload
  11275. (defun anything-ucs ()
  11276. "Preconfigured anything for `ucs-names' math symbols."
  11277. (interactive)
  11278. (anything :sources 'anything-c-source-ucs
  11279. :keymap anything-c-ucs-map))
  11280. ;;;###autoload
  11281. (defun anything-c-apropos ()
  11282. "Preconfigured anything to describe commands, functions, variables and faces."
  11283. (interactive)
  11284. (let ((default (thing-at-point 'symbol)))
  11285. (anything :sources
  11286. `(((name . "Commands")
  11287. (init . (lambda ()
  11288. (anything-c-apropos-init 'commandp ,default)))
  11289. (persistent-action . anything-lisp-completion-persistent-action)
  11290. (persistent-help . "Show brief doc in mode-line")
  11291. (candidates-in-buffer)
  11292. (action . (lambda (candidate)
  11293. (describe-function (intern candidate)))))
  11294. ((name . "Functions")
  11295. (init . (lambda ()
  11296. (anything-c-apropos-init #'(lambda (x) (and (fboundp x)
  11297. (not (commandp x))))
  11298. ,default)))
  11299. (persistent-action . anything-lisp-completion-persistent-action)
  11300. (persistent-help . "Show brief doc in mode-line")
  11301. (candidates-in-buffer)
  11302. (action . (lambda (candidate)
  11303. (describe-function (intern candidate)))))
  11304. ((name . "Variables")
  11305. (init . (lambda ()
  11306. (anything-c-apropos-init 'boundp ,default)))
  11307. (persistent-action . anything-lisp-completion-persistent-action)
  11308. (persistent-help . "Show brief doc in mode-line")
  11309. (candidates-in-buffer)
  11310. (action . (lambda (candidate)
  11311. (describe-variable (intern candidate)))))
  11312. ((name . "Faces")
  11313. (init . (lambda ()
  11314. (anything-c-apropos-init 'facep ,default)))
  11315. (persistent-action . anything-lisp-completion-persistent-action)
  11316. (persistent-help . "Show brief doc in mode-line")
  11317. (candidates-in-buffer)
  11318. (filtered-candidate-transformer . (lambda (candidates source)
  11319. (loop for c in candidates
  11320. collect (propertize c 'face (intern c)))))
  11321. (action . (lambda (candidate)
  11322. (describe-face (intern candidate)))))
  11323. ((name . "Anything attributes")
  11324. (candidates . (lambda ()
  11325. (mapcar 'symbol-name anything-additional-attributes)))
  11326. (action . (lambda (candidate)
  11327. (with-output-to-temp-buffer "*Help*"
  11328. (princ (get (intern candidate) 'anything-attrdoc))))))))))
  11329. ;;;###autoload
  11330. (defun anything-xrandr-set ()
  11331. (interactive)
  11332. (anything :sources 'anything-c-source-xrandr-change-resolution
  11333. :buffer "*anything xrandr*"))
  11334. ;;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
  11335. (provide 'anything-config)
  11336. ;; Local Variables:
  11337. ;; coding: utf-8
  11338. ;; End:
  11339. ;;; anything-config.el ends here