PageRenderTime 52ms CodeModel.GetById 13ms app.highlight 33ms RepoModel.GetById 1ms app.codeStats 0ms

/plugins/helm/helm-net.el

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