PageRenderTime 55ms CodeModel.GetById 36ms app.highlight 13ms RepoModel.GetById 2ms app.codeStats 0ms

/lisp/helm/helm-net.el

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