PageRenderTime 52ms CodeModel.GetById 23ms RepoModel.GetById 1ms app.codeStats 0ms

/emacs.d/elpa/helm-20150628.2150/helm-net.el

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