mirror of https://github.com/Chizi123/.emacs.d.git

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