.emacs.d.git - Gitblit

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	" " ""
	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