PageRenderTime 43ms CodeModel.GetById 16ms RepoModel.GetById 1ms app.codeStats 0ms

/elpa/helm-1.7.8/helm-net.el

https://gitlab.com/lattenwald-archives/yet-another-emacs.d
Emacs Lisp | 503 lines | 391 code | 62 blank | 50 comment | 17 complexity | 41904c74e0217b02967949cab0e2533a MD5 | raw file
Possible License(s): GPL-3.0
  1. ;;; helm-net.el --- helm browse url and search web. -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto <thierry.volpiatto@gmail.com>
  3. ;; This program is free software; you can redistribute it and/or modify
  4. ;; it under the terms of the GNU General Public License as published by
  5. ;; the Free Software Foundation, either version 3 of the License, or
  6. ;; (at your option) any later version.
  7. ;; This program is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  10. ;; GNU General Public License for more details.
  11. ;; You should have received a copy of the GNU General Public License
  12. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  13. ;;; Code:
  14. (require 'cl-lib)
  15. (require 'helm)
  16. (require 'helm-help)
  17. (require 'url)
  18. (require 'xml)
  19. (require 'browse-url)
  20. (defgroup helm-net nil
  21. "Net related applications and libraries for Helm."
  22. :group 'helm)
  23. (defcustom helm-google-suggest-default-browser-function nil
  24. "The browse url function you prefer to use with google suggest.
  25. When nil, use the first browser function available
  26. See `helm-browse-url-default-browser-alist'."
  27. :group 'helm-net
  28. :type 'symbol)
  29. (defcustom helm-home-url "http://www.google.fr"
  30. "Default url to use as home url."
  31. :group 'helm-net
  32. :type 'string)
  33. (defcustom helm-surfraw-default-browser-function nil
  34. "The browse url function you prefer to use with surfraw.
  35. When nil, fallback to `browse-url-browser-function'."
  36. :group 'helm-net
  37. :type 'symbol)
  38. (defcustom helm-google-suggest-url
  39. "http://google.com/complete/search?output=toolbar&q="
  40. "URL used for looking up Google suggestions."
  41. :type 'string
  42. :group 'helm-net)
  43. (defcustom helm-google-suggest-search-url
  44. "http://www.google.com/search?ie=utf-8&oe=utf-8&q=%s"
  45. "URL used for Google searching."
  46. :type 'string
  47. :group 'helm-net)
  48. (defcustom helm-net-prefer-curl nil
  49. "When non--nil use CURL external program to fetch data.
  50. Otherwise `url-retrieve-synchronously' is used."
  51. :type 'boolean
  52. :group 'helm-net)
  53. (defvaralias 'helm-google-suggest-use-curl-p 'helm-net-prefer-curl)
  54. (make-obsolete-variable 'helm-google-suggest-use-curl-p 'helm-net-prefer-curl "1.7.7")
  55. (defcustom helm-surfraw-duckduckgo-url
  56. "https://duckduckgo.com/lite/?q=%s&kp=1"
  57. "The duckduckgo url.
  58. This is a format string, don't forget the `%s'.
  59. If you have personal settings saved on duckduckgo you should have
  60. a personal url, see your settings on duckduckgo."
  61. :type 'string
  62. :group 'helm-net)
  63. (defcustom helm-wikipedia-suggest-url
  64. "https://en.wikipedia.org/w/api.php?action=opensearch&search="
  65. "Url used for looking up Wikipedia suggestions."
  66. :type 'string
  67. :group 'helm-net)
  68. (defcustom helm-search-suggest-action-wikipedia-url
  69. "https://en.wikipedia.org/wiki/Special:Search?search=%s"
  70. "The Wikipedia search url.
  71. This is a format string, don't forget the `%s'."
  72. :type 'string
  73. :group 'helm-net)
  74. (defcustom helm-wikipedia-summary-url
  75. "http://en.wikipedia.org/w/api.php?action=parse&format=json&prop=text&section=0&page="
  76. "URL for getting the summary of a Wikipedia topic."
  77. :type 'string
  78. :group 'helm-net)
  79. (defcustom helm-wikipedia-follow-delay 2
  80. "Delay before wikipedia summary popup."
  81. :type 'number
  82. :group 'helm-net)
  83. (defcustom helm-search-suggest-action-youtube-url
  84. "http://www.youtube.com/results?aq=f&search_query=%s"
  85. "The Youtube search url.
  86. This is a format string, don't forget the `%s'."
  87. :type 'string
  88. :group 'helm-net)
  89. (defcustom helm-search-suggest-action-imdb-url
  90. "http://www.imdb.com/find?s=all&q=%s"
  91. "The IMDb search url.
  92. This is a format string, don't forget the `%s'."
  93. :type 'string
  94. :group 'helm-net)
  95. (defcustom helm-search-suggest-action-google-maps-url
  96. "http://maps.google.com/maps?f=q&source=s_q&q=%s"
  97. "The Google Maps search url.
  98. This is a format string, don't forget the `%s'."
  99. :type 'string
  100. :group 'helm-net)
  101. (defcustom helm-search-suggest-action-google-news-url
  102. "http://www.google.com/search?safe=off&prmd=nvlifd&source=lnms&tbs=nws:1&q=%s"
  103. "The Google News search url.
  104. This is a format string, don't forget the `%s'."
  105. :type 'string
  106. :group 'helm-net)
  107. (defcustom helm-google-suggest-actions
  108. '(("Google Search" . helm-google-suggest-action)
  109. ("Wikipedia" . (lambda (candidate)
  110. (helm-search-suggest-perform-additional-action
  111. helm-search-suggest-action-wikipedia-url
  112. candidate)))
  113. ("Youtube" . (lambda (candidate)
  114. (helm-search-suggest-perform-additional-action
  115. helm-search-suggest-action-youtube-url
  116. candidate)))
  117. ("IMDb" . (lambda (candidate)
  118. (helm-search-suggest-perform-additional-action
  119. helm-search-suggest-action-imdb-url
  120. candidate)))
  121. ("Google Maps" . (lambda (candidate)
  122. (helm-search-suggest-perform-additional-action
  123. helm-search-suggest-action-google-maps-url
  124. candidate)))
  125. ("Google News" . (lambda (candidate)
  126. (helm-search-suggest-perform-additional-action
  127. helm-search-suggest-action-google-news-url
  128. candidate))))
  129. "List of actions for google suggest sources."
  130. :group 'helm-net
  131. :type '(alist :key-type string :value-type function))
  132. ;;; Additional actions for search suggestions
  133. ;;
  134. ;;
  135. ;; Internal
  136. (defun helm-search-suggest-perform-additional-action (url query)
  137. "Perform the search via URL using QUERY as input."
  138. (browse-url (format url (url-hexify-string query))))
  139. (defun helm-net--url-retrieve-sync (request parser)
  140. (if helm-net-prefer-curl
  141. (with-temp-buffer
  142. (call-process "curl" nil t nil request)
  143. (funcall parser))
  144. (with-current-buffer (url-retrieve-synchronously request)
  145. (funcall parser))))
  146. ;;; Google Suggestions
  147. ;;
  148. ;;
  149. (defun helm-google-suggest-parser ()
  150. (cl-loop
  151. with result-alist = (xml-get-children
  152. (car (xml-parse-region
  153. (point-min) (point-max)))
  154. 'CompleteSuggestion)
  155. for i in result-alist collect
  156. (cdr (cl-caadr (assoc 'suggestion i)))))
  157. (defun helm-google-suggest-fetch (input)
  158. "Fetch suggestions for INPUT from XML buffer."
  159. (let ((request (concat helm-google-suggest-url
  160. (url-hexify-string input))))
  161. (helm-net--url-retrieve-sync
  162. request #'helm-google-suggest-parser)))
  163. (defun helm-google-suggest-set-candidates (&optional request-prefix)
  164. "Set candidates with result and number of google results found."
  165. (let ((suggestions (helm-google-suggest-fetch
  166. (or (and request-prefix
  167. (concat request-prefix
  168. " " helm-pattern))
  169. helm-pattern))))
  170. (if (member helm-pattern suggestions)
  171. suggestions
  172. ;; if there is no suggestion exactly matching the input then
  173. ;; prepend a Search on Google item to the list
  174. (append
  175. suggestions
  176. (list (cons (format "Search for '%s' on Google" helm-input)
  177. helm-input))))))
  178. (defun helm-ggs-set-number-result (num)
  179. (if num
  180. (progn
  181. (and (numberp num) (setq num (number-to-string num)))
  182. (cl-loop for i in (reverse (split-string num "" t))
  183. for count from 1
  184. append (list i) into C
  185. when (= count 3)
  186. append (list ",") into C
  187. and do (setq count 0)
  188. finally return
  189. (replace-regexp-in-string
  190. "^," "" (mapconcat 'identity (reverse C) ""))))
  191. "?"))
  192. (defun helm-google-suggest-action (candidate)
  193. "Default action to jump to a google suggested candidate."
  194. (let ((arg (format helm-google-suggest-search-url
  195. (url-hexify-string candidate))))
  196. (helm-aif helm-google-suggest-default-browser-function
  197. (funcall it arg)
  198. (helm-browse-url arg))))
  199. (defvar helm-google-suggest-default-function
  200. 'helm-google-suggest-set-candidates
  201. "Default function to use in helm google suggest.")
  202. (defvar helm-source-google-suggest
  203. (helm-build-sync-source "Google Suggest"
  204. :candidates (lambda ()
  205. (funcall helm-google-suggest-default-function))
  206. :action 'helm-google-suggest-actions
  207. :volatile t
  208. :keymap helm-map
  209. :requires-pattern 3))
  210. (defun helm-google-suggest-emacs-lisp ()
  211. "Try to emacs lisp complete with google suggestions."
  212. (helm-google-suggest-set-candidates "emacs lisp"))
  213. ;;; Wikipedia suggestions
  214. ;;
  215. ;;
  216. (declare-function json-read-from-string "json" (string))
  217. (defun helm-wikipedia-suggest-fetch ()
  218. "Fetch Wikipedia suggestions and return them as a list."
  219. (require 'json)
  220. (let ((request (concat helm-wikipedia-suggest-url
  221. (url-hexify-string helm-pattern))))
  222. (helm-net--url-retrieve-sync
  223. request #'helm-wikipedia--parse-buffer)))
  224. (defun helm-wikipedia--parse-buffer ()
  225. (goto-char (point-min))
  226. (when (re-search-forward "^\\[.+\\[\\(.*\\)\\]\\]" nil t)
  227. (cl-loop for i across (aref (json-read-from-string (match-string 0)) 1)
  228. collect i into result
  229. finally return (or result
  230. (append
  231. result
  232. (list (cons (format "Search for '%s' on wikipedia"
  233. helm-pattern)
  234. helm-pattern)))))))
  235. (defvar helm-wikipedia--summary-cache (make-hash-table :test 'equal))
  236. (defun helm-wikipedia-persistent-action (candidate)
  237. (unless (string= (format "Search for '%s' on wikipedia"
  238. helm-pattern)
  239. (helm-get-selection nil t))
  240. (message "Fetching summary from Wikipedia...")
  241. (let ((buf (get-buffer-create "*helm wikipedia summary*"))
  242. result mess)
  243. (while (progn
  244. (setq result (or (gethash candidate helm-wikipedia--summary-cache)
  245. (puthash candidate
  246. (prog1
  247. (helm-wikipedia-fetch-summary candidate)
  248. (setq mess "Done"))
  249. helm-wikipedia--summary-cache)))
  250. (when (and result
  251. (listp result))
  252. (setq candidate (cdr result))
  253. (message "Redirected to %s" candidate)
  254. t)))
  255. (if (not result)
  256. (message "Error when getting summary.")
  257. (with-current-buffer buf
  258. (erase-buffer)
  259. (setq cursor-type nil)
  260. (insert result)
  261. (fill-region (point-min) (point-max))
  262. (goto-char (point-min)))
  263. (display-buffer buf)
  264. (message mess)))))
  265. (defun helm-wikipedia-fetch-summary (input)
  266. (let* ((request (concat helm-wikipedia-summary-url
  267. (url-hexify-string input))))
  268. (helm-net--url-retrieve-sync
  269. request #'helm-wikipedia--parse-summary)))
  270. (defun helm-wikipedia--parse-summary ()
  271. (goto-char (point-min))
  272. (when (search-forward "{" nil t)
  273. (let ((result (cdr (assoc '*
  274. (assoc 'text
  275. (assoc 'parse
  276. (json-read-from-string
  277. (buffer-substring-no-properties
  278. (1- (point)) (point-max)))))))))
  279. (when result
  280. (if (string-match "<span class=\"redirectText\"><a href=[^>]+>\\([^<]+\\)" result)
  281. (cons 'redirect (match-string 1 result))
  282. ;; find the beginning of the summary text in the result
  283. ;; check if there is a table before the summary and skip that
  284. (when (or (string-match "</table>\\(\n<div.*?</div>\\)?\n<p>" result)
  285. ;; otherwise just find the first paragraph
  286. (string-match "<p>" result))
  287. ;; remove cruft and do a simple formatting
  288. (replace-regexp-in-string
  289. "Cite error: .*" ""
  290. (replace-regexp-in-string
  291. "&#160;" ""
  292. (replace-regexp-in-string
  293. "\\[[^\]]+\\]" ""
  294. (replace-regexp-in-string
  295. "<[^>]*>" ""
  296. (replace-regexp-in-string
  297. "</p>\n<p>" "\n\n"
  298. (substring result (match-end 0)))))))))))))
  299. (defvar helm-source-wikipedia-suggest
  300. (helm-build-sync-source "Wikipedia Suggest"
  301. :candidates #'helm-wikipedia-suggest-fetch
  302. :action '(("Wikipedia" . (lambda (candidate)
  303. (helm-search-suggest-perform-additional-action
  304. helm-search-suggest-action-wikipedia-url
  305. candidate))))
  306. :persistent-action #'helm-wikipedia-persistent-action
  307. :volatile t
  308. :keymap helm-map
  309. :follow 1
  310. :follow-delay helm-wikipedia-follow-delay
  311. :requires-pattern 3))
  312. ;;; Web browser functions.
  313. ;;
  314. ;;
  315. ;; If default setting of `w3m-command' is not
  316. ;; what you want and you modify it, you will have to reeval
  317. ;; also `helm-browse-url-default-browser-alist'.
  318. (defvar helm-browse-url-chromium-program "chromium-browser")
  319. (defvar helm-browse-url-uzbl-program "uzbl-browser")
  320. (defvar helm-browse-url-conkeror-program "conkeror")
  321. (defvar helm-browse-url-default-browser-alist
  322. `((,(or (and (boundp 'w3m-command) w3m-command)
  323. "/usr/bin/w3m") . w3m-browse-url)
  324. (,browse-url-firefox-program . browse-url-firefox)
  325. (,helm-browse-url-chromium-program . helm-browse-url-chromium)
  326. (,helm-browse-url-conkeror-program . helm-browse-url-conkeror)
  327. (,helm-browse-url-uzbl-program . helm-browse-url-uzbl)
  328. (,browse-url-kde-program . browse-url-kde)
  329. (,browse-url-gnome-moz-program . browse-url-gnome-moz)
  330. (,browse-url-mozilla-program . browse-url-mozilla)
  331. (,browse-url-galeon-program . browse-url-galeon)
  332. (,browse-url-netscape-program . browse-url-netscape)
  333. (,browse-url-mosaic-program . browse-url-mosaic)
  334. (,browse-url-xterm-program . browse-url-text-xterm)
  335. ("emacs" . eww-browse-url))
  336. "*Alist of \(executable . function\) to try to find a suitable url browser.")
  337. (cl-defun helm-generic-browser (url cmd-name &rest args)
  338. "Browse URL with NAME browser."
  339. (let ((proc (concat cmd-name " " url)))
  340. (message "Starting %s..." cmd-name)
  341. (apply 'start-process proc nil cmd-name
  342. (append args (list url)))
  343. (set-process-sentinel
  344. (get-process proc)
  345. #'(lambda (process event)
  346. (when (string= event "finished\n")
  347. (message "%s process %s" process event))))))
  348. (defun helm-browse-url-chromium (url &optional _ignore)
  349. "Browse URL with google chrome browser."
  350. (interactive "sURL: ")
  351. (helm-generic-browser
  352. url helm-browse-url-chromium-program))
  353. (defun helm-browse-url-uzbl (url &optional _ignore)
  354. "Browse URL with uzbl browser."
  355. (interactive "sURL: ")
  356. (helm-generic-browser url helm-browse-url-uzbl-program "-u"))
  357. (defun helm-browse-url-conkeror (url &optional _ignore)
  358. "Browse URL with conkeror browser."
  359. (interactive "sURL: ")
  360. (helm-generic-browser url helm-browse-url-conkeror-program))
  361. (defun helm-browse-url-default-browser (url &rest args)
  362. "Find the first available browser and ask it to load URL."
  363. (let ((default-browser-fn
  364. (cl-loop for (exe . fn) in helm-browse-url-default-browser-alist
  365. thereis (and exe (executable-find exe) (fboundp fn) fn))))
  366. (if default-browser-fn
  367. (apply default-browser-fn url args)
  368. (error "No usable browser found"))))
  369. (defun helm-browse-url (url &rest args)
  370. "Default command to browse URL."
  371. (if browse-url-browser-function
  372. (browse-url url args)
  373. (helm-browse-url-default-browser url args)))
  374. ;;; Surfraw
  375. ;;
  376. ;; Need external program surfraw.
  377. ;; <http://surfraw.alioth.debian.org/>
  378. ;; Internal
  379. (defvar helm-surfraw-engines-history nil)
  380. (defvar helm-surfraw-input-history nil)
  381. (defvar helm-surfraw--elvi-cache nil)
  382. (defun helm-build-elvi-list ()
  383. "Return list of all engines and descriptions handled by surfraw."
  384. (or helm-surfraw--elvi-cache
  385. (setq helm-surfraw--elvi-cache
  386. (cdr (with-temp-buffer
  387. (call-process "surfraw" nil t nil "-elvi")
  388. (split-string (buffer-string) "\n"))))))
  389. ;;;###autoload
  390. (defun helm-surfraw (pattern engine)
  391. "Preconfigured `helm' to search PATTERN with search ENGINE."
  392. (interactive (list (read-string "SearchFor: "
  393. nil 'helm-surfraw-input-history
  394. (thing-at-point 'symbol))
  395. (helm-comp-read
  396. "Engine: "
  397. (helm-build-elvi-list)
  398. :must-match t
  399. :name "Surfraw Search Engines"
  400. :del-input nil
  401. :history helm-surfraw-engines-history)))
  402. (let* ((engine-nodesc (car (split-string engine)))
  403. (url (if (string= engine-nodesc "duckduckgo")
  404. ;; "sr duckduckgo -p foo" is broken, workaround.
  405. (format helm-surfraw-duckduckgo-url
  406. (url-hexify-string pattern))
  407. (with-temp-buffer
  408. (apply 'call-process "surfraw" nil t nil
  409. (append (list engine-nodesc "-p") (split-string pattern)))
  410. (replace-regexp-in-string
  411. "\n" "" (buffer-string)))))
  412. (browse-url-browser-function (or helm-surfraw-default-browser-function
  413. browse-url-browser-function)))
  414. (if (string= engine-nodesc "W")
  415. (helm-browse-url helm-home-url)
  416. (helm-browse-url url)
  417. (setq helm-surfraw-engines-history
  418. (cons engine (delete engine helm-surfraw-engines-history))))))
  419. ;;;###autoload
  420. (defun helm-google-suggest ()
  421. "Preconfigured `helm' for google search with google suggest."
  422. (interactive)
  423. (helm-other-buffer 'helm-source-google-suggest "*helm google*"))
  424. ;;;###autoload
  425. (defun helm-wikipedia-suggest ()
  426. "Preconfigured `helm' for Wikipedia lookup with Wikipedia suggest."
  427. (interactive)
  428. (helm :sources 'helm-source-wikipedia-suggest
  429. :buffer "*helm wikipedia*"))
  430. (provide 'helm-net)
  431. ;; Local Variables:
  432. ;; byte-compile-warnings: (not cl-functions obsolete)
  433. ;; coding: utf-8
  434. ;; indent-tabs-mode: nil
  435. ;; End:
  436. ;;; helm-net.el ends here