Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
455 lines (376 sloc) 12.1 KB
;;; words.el --- Functions to operate on word at point or region -*- lexical-binding: t -*-
;; Copyright(C) 2014,2015 John Kitchin
;; Author: John Kitchin <jkitchin@andrew.cmu.edu>
;; Version: 0.1.0
;; Package-Requires: ((hydra "0"))
;;; Commentary:
;; These functions mostly provide easy access to web-based searches of the word
;; at point, or the selected words. The following functions are available.
;; - words-dictionary
;; - words-thesaurus
;; - words-atd :: a spell/grammar checker
;; - words-google
;; - words-twitter
;; - words-google-scholar
;; - words-scopus
;; - words-wos :: Search Web of Science
;; - words-crossref
;; - words-pubmed
;; - words-bibtex :: search default bibtex file
;; - words-mdfind :: search local computer with mdfind (Mac)
;; - words-finder :: search local computer with finder (Mac)
;; These functions just open websites for convenience.
;; - wos :: open Web of Science
;; - pubmed :: open pubmed
;; - scopus :: open Scopus
;; - words :: offers a menu of functions for word at point or region
;; - words/body will open a "hydra" menu.
;;; Code:
(require 'hydra)
(require 'url)
(require 'xml)
(setq hydra-is-helpful t)
;;** Dictionary/thesaurus/grammar
(defun words-dictionary ()
"Look up word at point in an online dictionary."
(interactive)
(browse-url
(format
"http://dictionary.reference.com/browse/%s?s=t"
(thing-at-point 'word))))
(defun words-thesaurus ()
"Look up word at point in an online thesaurus."
(interactive)
(browse-url
(format
"http://www.thesaurus.com/browse/%s"
(thing-at-point 'word))))
(defun words-atd ()
"Send paragraph at point to After the deadline for spell and grammar checking."
(interactive)
(let* ((url-request-method "POST")
(url-request-data (format
"key=some-random-text-&data=%s"
(url-hexify-string
(thing-at-point 'paragraph))))
(xml (with-current-buffer
(url-retrieve-synchronously
"http://service.afterthedeadline.com/checkDocument")
(xml-parse-region url-http-end-of-headers (point-max))))
(results (car xml))
(errors (xml-get-children results 'error)))
(switch-to-buffer-other-frame "*ATD*")
(erase-buffer)
(dolist (err errors)
(let* ((children (xml-node-children err))
;; for some reason I could not get the string out, and had to do this.
(s (car (last (nth 1 children))))
;; the last/car stuff doesn't seem right. there is probably
;; a more idiomatic way to get this
(desc (last (car (xml-get-children children 'description))))
(type (last (car (xml-get-children children 'type))))
(suggestions (xml-get-children children 'suggestions))
(options (xml-get-children (xml-node-name suggestions) 'option))
(opt-string (mapconcat
(lambda (el)
(when (listp el)
(car (last el))))
options
" ")))
(insert (format "** %s ** %s
Description: %s
Suggestions: %s
" s type desc opt-string))))))
;;** Web functions
(defun words-google ()
"Google the word at point or selection."
(interactive)
(browse-url
(format
"http://www.google.com/search?q=%s"
(if (region-active-p)
(url-hexify-string (buffer-substring (region-beginning)
(region-end)))
(thing-at-point 'word)))))
(defun words-twitter ()
"Search twitter for word at point or selection."
(interactive)
(browse-url
(format
"https://twitter.com/search?q=%s"
(if (region-active-p)
(url-hexify-string (buffer-substring (region-beginning)
(region-end)))
(thing-at-point 'word)))))
;;** Scientific search functions
(defun words-google-scholar ()
"Google scholar the word at point or selection."
(interactive)
(browse-url
(format
"http://scholar.google.com/scholar?q=%s"
(if (region-active-p)
(url-hexify-string (buffer-substring (region-beginning)
(region-end)))
(thing-at-point 'word)))))
(defun words-wos ()
"Open the word at point or selection in Web of Science."
;; the url was derived from this page: http://wokinfo.com/webtools/searchbox/
(interactive)
(browse-url
(format "http://gateway.webofknowledge.com/gateway/Gateway.cgi?topic=%s&GWVersion=2&SrcApp=WEB&SrcAuth=HSB&DestApp=UA&DestLinkType=GeneralSearchSummary"
(if (region-active-p)
(mapconcat 'identity (split-string
(buffer-substring (region-beginning)
(region-end))) "+")
(thing-at-point 'word)))))
(defun words-scopus ()
"Scopus the word at point or selection."
(interactive)
(browse-url
(format
"http://www.scopus.com//search/submit/basic.url?field1=TITLE-ABS-KEY&searchterm1=%s"
(if (region-active-p)
(mapconcat 'identity (split-string
(buffer-substring (region-beginning)
(region-end))) "+")
(thing-at-point 'word)))))
(defun words-crossref ()
"Search region or word at point in CrossRef."
(interactive)
(browse-url
(format
"http://search.crossref.org/?q=%s"
(if (use-region-p)
(url-hexify-string (buffer-substring
(region-beginning)
(region-end)))
(thing-at-point 'word)))))
(defun words-pubmed ()
"Search region or word at point in pubmed."
(interactive)
(browse-url
(format
"http://www.ncbi.nlm.nih.gov/pubmed/?term=%s"
(if (use-region-p)
(url-hexify-string (buffer-substring
(region-beginning)
(region-end)))
(thing-at-point 'word)))))
(defun words-arxiv ()
"Search region or word at point in arxiv.org."
(interactive)
(browse-url
(format
"http://arxiv.org/find/all/1/all:+AND+%s/0/1/0/all/0/1"
(if (use-region-p)
(url-hexify-string (buffer-substring
(region-beginning)
(region-end)))
(thing-at-point 'word)))))
(defun words-semantic-scholar ()
"Search region or word at point in www.semanticscholar.org."
(interactive)
(browse-url
(format
"https://www.semanticscholar.org/search?q=%s"
(if (use-region-p)
(url-hexify-string (buffer-substring
(region-beginning)
(region-end)))
(thing-at-point 'word)))))
;; #+end_src
;;** Convenience functions for scientific queries
;; These just open websites, with no search queries.
(defun wos ()
"Open Web of Science search page in browser."
(interactive)
(browse-url "http://apps.webofknowledge.com"))
(defun pubmed ()
"Open Pubmed in browser."
(interactive)
(browse-url "http://www.ncbi.nlm.nih.gov/pubmed"))
(defun scopus ()
"Open Scopus in browser."
(interactive)
(browse-url "http://www.scopus.com"))
(defun crossref ()
"Open Crossref in browser."
(interactive)
(browse-url "http://search.crossref.org"))
;;** Bibtex search
(defun words-bibtex ()
"Find selected region or word at point in variable `reftex-default-bibliography'."
(interactive)
(multi-occur
(mapcar (lambda (f) (find-file-noselect f))
reftex-default-bibliography)
(if (use-region-p)
(buffer-substring
(region-beginning)
(region-end))
(thing-at-point 'word))))
;;** Search functions for Mac
(defvar words-voice "Vicki"
"Mac voice to use for speaking.")
(defun words-speak (&optional text)
"Speak word at point or region or TEXT. Mac only."
(interactive)
(unless text
(setq text (if (use-region-p)
(buffer-substring
(region-beginning) (region-end))
(thing-at-point 'word))))
;; escape some special applescript chars
(setq text (replace-regexp-in-string "\\\\" "\\\\\\\\" text))
(setq text (replace-regexp-in-string "\"" "\\\\\"" text))
(do-applescript
(format
"say \"%s\" using \"%s\""
text
words-voice)))
(defvar words-languages
'()
"List of cons cells (language . code).")
(defvar words-speakers
'(("German" . "Anna")
("Chinese" . "Ting-Ting"))
"Speakers for different languages.")
(setq words-languages '(("German" . "de")
("Italian" . "it")
("Chinese" . "zh")
("Spanish" . "es")))
(defun words-translate (to-language)
"Translate word at point or selection TO-LANGUAGE.
http://mymemory.translated.net TO-LANGUAGE is the code, see
http://www.iana.org/assignments/language-subtag-registry/language-subtag-registry.
Assumes selected code is in English."
(interactive
(list
(ido-completing-read
"Language: "
(mapcar 'car words-languages) nil t)))
(let* ((text (if (use-region-p)
(buffer-substring
(region-beginning)
(region-end))
(thing-at-point 'word)))
(url (format "http://mymemory.translated.net/api/get?q=%s!&langpair=en|%s"
text
(cdr (assoc to-language words-languages))))
(json (with-current-buffer
(url-retrieve-synchronously url)
(json-read-from-string
(buffer-substring url-http-end-of-headers (point-max))))))
(let ((words-voice (or (cdr (assoc to-language words-speakers))
"Vicki")))
(words-speak
(cdr (assoc 'translatedText (cdr (assoc 'responseData json))))))
(message "Translation: %s"
(cdr (assoc 'translatedText (cdr (assoc 'responseData json)))))))
(defun words-mdfind ()
"Search for file names matching word or selection at point using mdfind.
Opens an org-buffer with links to results. Mac only."
(interactive)
(let ((query (if (use-region-p)
(buffer-substring
(region-beginning)
(region-end))
(thing-at-point 'word))))
(switch-to-buffer-other-window "*mdfind*")
(erase-buffer)
(insert
(mapconcat
(lambda (x)
(format "[[%s]]" x))
(split-string
(shell-command-to-string
(format "mdfind -name %s"
(shell-quote-argument query)))
"\n")
"\n"))
(org-mode)))
(defun words-finder ()
"Open Mac Finder with search of word at point or selection."
(interactive)
(let* ((query (if (use-region-p)
(buffer-substring
(region-beginning)
(region-end))
(thing-at-point 'word)))
(applescript (concat
"tell application \"Finder\" to activate
tell application \"System Events\"
tell process \"Finder\"
click menu item \"Find\" of menu \"File\" of menu bar 1
keystroke " (format "\"%s\"" query )
"
end tell
end tell")))
(message "%s" applescript)
;; from org-mac-link
(do-applescript applescript)))
;;** words menu
;; A keystroke driven menu to access words functions. I favor the hydra
;; interface now. One advantage of this interface is that it is user extendable,
;; by adding entries to the words-funcs variable. It would take some work to get
;; that to work in hydra.
(defvar words-funcs '()
"Functions to run in `words'. Each entry is a list of (char menu-name function).")
(setq words-funcs
'(("d" "ictionary" words-dictionary)
("t" "hesaurus" words-thesaurus)
("g" "oogle" words-google)
("c" "CrossRef" words-crossref)
("s" "Scopus" words-scopus)
("b" "ibtex" words-bibtex)
("f" "inder" words-finder)
("m" "dfind" words-mdfind)
("G" "google-scholar" words-google-scholar)
("S" "spell/grammar" words-atd)
("w" "twitter" words-twitter)
("T" "alk" words-speak)))
(defun words ()
"Offer menu of functions to run defined in `words-funcs'."
(interactive)
(message
(concat
(mapconcat
(lambda (tup)
(concat "[" (elt tup 0) "]"
(elt tup 1) " "))
words-funcs "") ": "))
(let ((input (read-char-exclusive)))
(funcall
(elt
(assoc
(char-to-string input) words-funcs)
2))))
;;** A hydra interface to words
;; hydra (http://oremacs.com/2015/01/20/introducing-hydra/) is a relatively new
;; menu type interface to select actions with single key strokes. It is a nicer
;; implementation than what I setup in the words function above.
;; https://github.com/abo-abo/hydra
(defhydra words-hydra (:color blue)
"words"
("d" words-dictionary "dictionary")
("t" words-thesaurus "thesaurus")
("S" words-atd "spell/grammar")
("g" words-google "google")
("T" words-twitter "Twitter")
("w" words-wos "Web of Science")
("G" words-google-scholar "Google scholar")
("c" words-crossref "CrossRef")
("s" words-scopus "Scopus")
("o" words-semantic-scholar "Semantic Scholar")
("p" words-pubmed "Pubmed")
("a" words-arxiv "Arxiv")
("b" words-bibtex "bibtex")
("f" words-finder "Mac Finder")
("m" words-mdfind "mdfind")
("k" words-speak "Speak")
("r" words-translate "Translate")
("q" nil "cancel"))
;;; End:
(provide 'words)
;;; words.el ends here
You can’t perform that action at this time.