[
  {
    "path": "README.md",
    "content": "[![MELPA](https://melpa.org/packages/define-word-badge.svg)](https://melpa.org/#/define-word)\n[![MELPA Stable](https://stable.melpa.org/packages/define-word-badge.svg)](https://stable.melpa.org/#/define-word)\n\n## Introduction\n\n`define-word` is a GNU Emacs package that lets you see the definition\nof a word or a phrase at point, without having to switch to a browser:\n\n![demo](https://raw.githubusercontent.com/wiki/abo-abo/define-word/images/define-word.png)\n"
  },
  {
    "path": "define-word.el",
    "content": ";;; define-word.el --- display the definition of word at point. -*- lexical-binding: t -*-\n\n;; Copyright (C) 2015 Oleh Krehel\n\n;; Author: Oleh Krehel <ohwoeowho@gmail.com>\n;; URL: https://github.com/abo-abo/define-word\n;; Version: 0.1.0\n;; Package-Requires: ((emacs \"24.3\"))\n;; Keywords: dictionary, convenience\n\n;; This file is not part of GNU Emacs\n\n;; This file is free software; you can redistribute it and/or modify\n;; it under the terms of the GNU General Public License as published by\n;; the Free Software Foundation; either version 3, or (at your option)\n;; any later version.\n\n;; This program is distributed in the hope that it will be useful,\n;; but WITHOUT ANY WARRANTY; without even the implied warranty of\n;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n;; GNU General Public License for more details.\n\n;; For a full copy of the GNU General Public License\n;; see <http://www.gnu.org/licenses/>.\n\n;;; Commentary:\n;;\n;; This package will send an anonymous request to https://wordnik.com/\n;; to get the definition of word or phrase at point, parse the resulting HTML\n;; page, and display it with `message'.\n;;\n;; Extra services can be added by customizing `define-word-services'\n;; where an url, a parsing function, and an (optional) function other\n;; than `message' to display the results can be defined.\n;;\n;; The HTML page is retrieved asynchronously, using `url-retrieve-link'.\n;;\n;;; Code:\n\n(require 'url-parse)\n(require 'url-http)\n(require 'nxml-mode)\n\n(defgroup define-word nil\n  \"Define word at point using an online dictionary.\"\n  :group 'convenience\n  :prefix \"define-word-\")\n\n(defvar define-word-limit 10\n  \"Maximum amount of results to display.\")\n\n(defcustom define-word-displayfn-alist nil\n  \"Alist for display functions per service.\nBy default, `message' is used.\"\n  :type '(alist\n          :key-type (symbol :tag \"Name of service\")\n          :value-type (function :tag \"Display function\")))\n\n(defun define-word-displayfn (service)\n  \"Return the display function for SERVICE.\"\n  (or (cdr (assoc service define-word-displayfn-alist))\n      #'message))\n\n(defcustom define-word-services\n  '((wordnik \"http://wordnik.com/words/%s\" define-word--parse-wordnik)\n    (openthesaurus \"https://www.openthesaurus.de/synonyme/%s\" define-word--parse-openthesaurus)\n    (webster \"http://webstersdictionary1828.com/Dictionary/%s\" define-word--parse-webster)\n    (offline-wikitionary define-word--get-offline-wikitionary nil))\n  \"Services for define-word, A list of lists of the\n  format (symbol url function-for-parsing).\nInstead of an url string, url can be a custom function for retrieving results.\"\n  :type '(alist\n          :key-type (symbol :tag \"Name of service\")\n          :value-type (group\n                       (string :tag \"Url (%s denotes search word)\")\n                       (function :tag \"Parsing function\"))))\n\n(defcustom define-word-default-service 'wordnik\n  \"The default service for define-word commands. Must be one of\n  `define-word-services'\"\n  :type '(choice\n          (const wordnik)\n          (const openthesaurus)\n          (const webster)\n          (const offline-wikitionary)\n          symbol))\n\n(defvar define-word-offline-dict-directory nil\n  \"Path to the directory which contains \\\"en-en-withforms-enwiktionary.txt\\\".\")\n\n(defun define-word--get-offline-wikitionary (word)\n  (unless define-word-offline-dict-directory\n    (let ((url \"https://en.wiktionary.org/wiki/User:Matthias_Buchmeier/download\"))\n      (user-error \"Please download the ding (text-format) zip from %s and configure `%S'.\" url\n                  'define-word-offline-dict-directory)))\n  (let* ((regex (concat \"^\" word \" \"))\n         (default-directory define-word-offline-dict-directory)\n         (res (shell-command-to-string\n               (concat \"rg --no-filename --color never '\" regex \"'\"))))\n    (unless (= 0 (length res))\n      res)))\n\n(defun define-word--to-string (word service)\n  \"Get definition of WORD from SERVICE.\"\n  (let* ((servicedata (assoc service define-word-services))\n         (retriever (nth 1 servicedata))\n         (parser (nth 2 servicedata))\n         (url-user-agent\n          (if (eq (nth 0 servicedata) 'wordnik)\n              \"Mozilla/5.0 (Macintosh; Intel Mac OS X 11_5_2) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/93.0.4577.63 Safari/537.36\"\n            url-user-agent)))\n    (if (functionp retriever)\n        (funcall retriever word)\n      ;; adapted `url-insert-file-contents'\n      (let* ((url (format retriever (downcase word)))\n             (buffer (url-retrieve-synchronously url t t)))\n        (with-temp-buffer\n          (url-insert-buffer-contents buffer url)\n          (funcall parser))))))\n\n(defun define-word--expand (regex definition service)\n  (let ((case-fold-search nil))\n    (when (string-match regex definition)\n      (concat\n       definition\n       \"\\n\" (match-string 1 definition) \":\\n\"\n       (mapconcat (lambda (s) (concat \"  \" s))\n                  (split-string\n                   (define-word--to-string (match-string 1 definition) service)\n                   \"\\n\")\n                  \"\\n\")))))\n\n;;;###autoload\n(defun define-word (word service &optional choose-service)\n  \"Define WORD using various services.\n\nBy default uses `define-word-default-service', but a prefix arg\nlets the user choose service.\"\n  (interactive \"MWord: \\ni\\nP\")\n  (let* ((service (or service\n                      (if choose-service\n                          (intern\n                           (completing-read\n                            \"Service: \" define-word-services))\n                        define-word-default-service)))\n         (results (define-word--to-string word service)))\n\n    (funcall\n     (define-word-displayfn service)\n     (cond ((not results)\n            \"0 definitions found\")\n           ((define-word--expand \"Plural form of \\\\(.*\\\\)\\\\.$\" results service))\n           ((define-word--expand \"Past participle of \\\\(.*\\\\)\\\\.$\" results service))\n           ((define-word--expand \"Present participle of \\\\(.*\\\\)\\\\.$\" results service))\n           (t\n            results)))))\n\n(declare-function pdf-view-active-region-text \"ext:pdf-view\")\n\n;;;###autoload\n(defun define-word-at-point (arg &optional service)\n  \"Use `define-word' to define word at point.\nWhen the region is active, define the marked phrase.\nPrefix ARG lets you choose service.\n\nIn a non-interactive call SERVICE can be passed.\"\n  (interactive \"P\")\n  (let ((word\n         (cond\n          ((eq major-mode 'pdf-view-mode)\n           (car (pdf-view-active-region-text)))\n          ((use-region-p)\n           (buffer-substring-no-properties\n            (region-beginning)\n            (region-end)))\n          (t\n           (substring-no-properties\n            (thing-at-point 'word))))))\n    (define-word word service arg)))\n\n(defface define-word-face-1\n  '((t :inherit font-lock-keyword-face))\n  \"Face for the part of speech of the definition.\")\n\n(defface define-word-face-2\n  '((t :inherit default))\n  \"Face for the body of the definition\")\n\n(defun define-word--join-results (results)\n  (mapconcat\n   #'identity\n   (if (> (length results) define-word-limit)\n       (cl-subseq results 0 define-word-limit)\n     results)\n   \"\\n\"))\n\n(defun define-word--regexp-to-face (regexp face)\n  (goto-char (point-min))\n  (while (re-search-forward regexp nil t)\n    (let ((match (match-string 1)))\n      (replace-match\n       (propertize match 'face face)))))\n\n(defconst define-word--tag-faces\n  '((\"<\\\\(?:em\\\\|i\\\\)>\\\\(.*?\\\\)</\\\\(?:em\\\\|i\\\\)>\" italic)\n    (\"<xref>\\\\(.*?\\\\)</xref>\" link)\n    (\"<strong>\\\\(.*?\\\\)</strong>\" bold)\n    (\"<internalXref.*?>\\\\(.*?\\\\)</internalXref>\" default)))\n\n(defun define-word--convert-html-tag-to-face (str)\n  \"Replace semantical HTML markup in STR with the relevant faces.\"\n  (with-temp-buffer\n    (insert str)\n    (cl-loop for (regexp face) in define-word--tag-faces do\n         (define-word--regexp-to-face regexp face))\n    (buffer-string)))\n\n(defun define-word--parse-wordnik ()\n  \"Parse output from wordnik site and return formatted list\"\n  (save-match-data\n    (let (results beg part)\n      (while (re-search-forward \"<li><abbr[^>]*>\\\\([^<]*\\\\)</abbr>\" nil t)\n        (setq part (match-string 1))\n        (unless (= 0 (length part))\n          (setq part (concat part \" \")))\n        (skip-chars-forward \" \")\n        (setq beg (point))\n        (when (re-search-forward \"</li>\")\n          (push (concat (propertize part 'face 'define-word-face-1)\n                        (propertize\n                         (buffer-substring-no-properties beg (match-beginning 0))\n                         'face 'define-word-face-2))\n                results)))\n      (when (setq results (nreverse results))\n        (define-word--convert-html-tag-to-face (define-word--join-results results))))))\n\n(defun define-word--parse-webster ()\n  \"Parse definition from webstersdictionary1828.com.\"\n  (save-match-data\n    (goto-char (point-min))\n    (let (results def-type)\n      (while (re-search-forward \"<p><strong>\\\\(?:[[:digit:]]\\\\.\\\\)?.*</strong>\\\\(.*?\\\\)</p>\" nil t)\n        (save-match-data\n          (save-excursion\n            (re-search-backward \"<p><strong>[A-Z'.]*</strong>, <em>\\\\(.*?\\\\)</em>\")\n            (let ((match (match-string 1)))\n              (setq def-type\n                    (cond\n                      ((equal match \"adjective\") \"adj.\")\n                      ((equal match \"noun\") \"n.\")\n                      ((equal match \"verb intransitive\") \"v.\")\n                      ((equal match \"verb transitive\") \"vt.\")\n                      (t \"\"))))))\n        (push\n         (concat\n          (propertize def-type 'face 'bold)\n          (define-word--convert-html-tag-to-face (match-string 1)))\n         results))\n      (when (setq results (nreverse results))\n        (define-word--join-results results)))))\n\n(defun define-word--parse-openthesaurus ()\n  \"Parse output from openthesaurus site and return formatted list\"\n  (save-match-data\n    (let (results part beg)\n      (goto-char (point-min))\n      (nxml-mode)\n      (while (re-search-forward \"<sup>\" nil t)\n        (goto-char (match-beginning 0))\n        (setq beg (point))\n        (nxml-forward-element)\n        (delete-region beg (point)))\n      (goto-char (point-min))\n      (while (re-search-forward\n              \"<span class='wiktionaryItem'> [0-9]+.</span>\\\\([^<]+\\\\)<\" nil t)\n        (setq part (match-string 1))\n        (backward-char)\n        (push (string-trim part) results))\n      (when (setq results (nreverse results))\n        (define-word--join-results results)))))\n\n(provide 'define-word)\n\n;;; define-word.el ends here\n"
  }
]