├── screenshots └── cnr.png ├── package.sh ├── CHANGELOG ├── synosaurus-openthesaurus.el ├── synosaurus-wordnet.el ├── README.org └── synosaurus.el /screenshots/cnr.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hpdeifel/synosaurus/HEAD/screenshots/cnr.png -------------------------------------------------------------------------------- /package.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | if [[ $# -ne 1 ]]; then 4 | echo "Usage: package.sh VERSION" 5 | exit 1 6 | fi 7 | 8 | git archive --prefix synosaurus-$1/ --output synosaurus-$1.tar HEAD^{tree} 9 | -------------------------------------------------------------------------------- /CHANGELOG: -------------------------------------------------------------------------------- 1 | # -*- mode: org -*- 2 | * v0.2.1 [2025-01-13] 3 | ** Packaging 4 | 5 | - Move metadata from synosaurus-pkg.el to synosaurus.el 6 | 7 | * v0.2.0 [2019-11-25] 8 | ** Features 9 | 10 | - New command ~synosaurus-choose-and-insert~ bound to =C-c C-s i=. 11 | 12 | ** Changes 13 | 14 | - Change default prefix from =C-c s= to =C-c C-s=. 15 | - Raise error in ~synosaurus-choose-and-replace~ if the region is not active and 16 | no word is at point. 17 | 18 | ** Bugfixes 19 | 20 | - Respect buffer-local value of ~synosaurus-backend~ in ~synosaurus-lookup~. 21 | - Don't delete text if ~synosaurus-choose~ returns ~nil~. 22 | - Don't offer duplicate completion candidates in ~synosaurus-choose-and-replace~ 23 | and ~synosaurus-choose-and-insert~. 24 | - Use TLS for all HTTP requests 25 | 26 | * v0.1.0 [2015-02-15] 27 | 28 | The initial release featuring: 29 | 30 | - OpenThesaurus and Wordnet backends to choose from 31 | - ~completion-at-point~, ~ivy~ and ~popup.el~ as possible frontends 32 | -------------------------------------------------------------------------------- /synosaurus-openthesaurus.el: -------------------------------------------------------------------------------- 1 | ;;; synosaurus-openthesaurus.el --- OpenThesaurus backend for synosaurus -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2019 Hans-Peter Deifel 4 | 5 | ;; Author: Hans-Peter Deifel 6 | ;; Keywords: wp 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; A german thesaurus 24 | 25 | ;;; Code: 26 | 27 | (require 'synosaurus) 28 | (require 'url) 29 | 30 | (require 'cl-lib) 31 | 32 | (defvar synosaurus-openthesaurus--url 33 | "https://www.openthesaurus.de/synonyme/search?q=%s&format=text/xml") 34 | 35 | (defun synosaurus-openthesaurus--xml-collect (tree path fun) 36 | (when (and path (eq (car path) (car tree))) 37 | (if (null (cdr path)) 38 | (funcall fun tree) 39 | (cl-loop for child in (cddr tree) 40 | for res = (synosaurus-openthesaurus--xml-collect child (cdr path) fun) 41 | when res collect res)))) 42 | 43 | ;;;###autoload 44 | (defun synosaurus-backend-openthesaurus (word) 45 | (let ((buf (url-retrieve-synchronously (format synosaurus-openthesaurus--url 46 | (url-hexify-string word))))) 47 | (if (not buf) 48 | (error "could not retrieve openthesaurus data") 49 | (with-current-buffer buf 50 | (goto-char (point-min)) 51 | (re-search-forward "^$") ;end of headers 52 | (forward-line) 53 | (let ((xml (libxml-parse-xml-region (point) (point-max)))) 54 | (kill-buffer) 55 | (synosaurus-openthesaurus--xml-collect xml '(matches synset term) 56 | (lambda (x) (cdr (assoc 'term (cadr x)))))))))) 57 | 58 | (provide 'synosaurus-openthesaurus) 59 | ;;; synosaurus-openthesaurus.el ends here 60 | -------------------------------------------------------------------------------- /synosaurus-wordnet.el: -------------------------------------------------------------------------------- 1 | ;;; synosaurus-wordnet.el --- Wordnet backend for synosaurus -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2019 Hans-Peter Deifel 4 | 5 | ;; Author: Hans-Peter Deifel 6 | ;; Keywords: wp 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;;; An English thesaurus 24 | ;;; 25 | ;;; You will need to have the wn programm installed 26 | 27 | ;;; Code: 28 | 29 | (require 'synosaurus) 30 | 31 | (defvar synosaurus-wordnet--command "wn") 32 | (defvar synosaurus-wordnet--options '("-synsv" "-synsn" "-synsa" "-synsr")) 33 | 34 | (defun synosaurus-wordnet--chomp (str) 35 | (while (string-match "\\`\n+\\|^\\s-+\\|\\s-+$\\|\n+\\'" 36 | str) 37 | (setq str (replace-match "" t t str))) 38 | str) 39 | 40 | (defun synosaurus-wordnet--collect-list () 41 | (let ((p (point))) 42 | (end-of-line) 43 | (let* ((str (buffer-substring p (point))) 44 | (list (split-string str "," t)) 45 | (stripped (mapcar 'synosaurus-wordnet--chomp list))) 46 | stripped))) 47 | 48 | (defun synosaurus-wordnet--parse-buffer () 49 | (let ((words)) 50 | (goto-char (point-min)) 51 | (while (search-forward-regexp "^Sense" nil t) 52 | (forward-line 1) 53 | (beginning-of-line) 54 | (push (synosaurus-wordnet--collect-list) words)) 55 | words)) 56 | 57 | ;;;###autoload 58 | (defun synosaurus-backend-wordnet (word) 59 | (let ((buf (get-buffer-create "*Wordnet*"))) 60 | (with-current-buffer buf 61 | (erase-buffer) 62 | (apply 'call-process synosaurus-wordnet--command nil buf nil word synosaurus-wordnet--options) 63 | (synosaurus-wordnet--parse-buffer)))) 64 | 65 | 66 | (provide 'synosaurus-wordnet) 67 | ;;; synosaurus-wordnet.el ends here 68 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | [[https://melpa.org/#/synosaurus][https://melpa.org/packages/synosaurus-badge.svg]] 2 | 3 | * Synosaurus 4 | 5 | Synosaurus is a thesaurus fontend for Emacs with pluggable backends. 6 | 7 | [[file:screenshots/cnr.png]] 8 | 9 | ** Getting Started 10 | 11 | - Synosaurus is available from [[https://melpa.org/][MELPA]]. Install it with: 12 | 13 | : M-x package-install synosaurus 14 | 15 | Or if you really want to install it manually, add the synosaurus directory 16 | to your load-path: 17 | 18 | : (add-to-list 'load-path "/path/to/synosaurus") 19 | 20 | - Then enable the minor mode with ~synosaurus-mode~. 21 | 22 | ** Usage 23 | 24 | The main commands for you to use are: 25 | 26 | - ~synosaurus-lookup~ :: Queries you for a word, looks it up in the 27 | thesaurus and shows you a list of alternatives. You can click or press 28 | RET on these alternatives to look them up instead. 29 | 30 | - ~synosaurus-choose-and-replace~ :: Look up the word under the cursor, asks 31 | you to select one of the alternatives and replaces the original word 32 | with you selection. You can configure different methods for the 33 | alternative selection, see below. 34 | 35 | - ~synosaurus-choose-and-insert~ :: Asks for a word, presents a list of 36 | synonyms to choose from, and inserts the selected one into the current 37 | buffer. 38 | 39 | The default keybindings are: 40 | 41 | | Key | Command | 42 | |-----------+-------------------------------| 43 | | =C-c C-s l= | ~synosaurus-lookup~ | 44 | | =C-c C-s r= | ~synosaurus-choose-and-replace~ | 45 | | =C-c C-s i= | ~synosaurus-choose-and-insert~ | 46 | 47 | ** Configuration 48 | 49 | Synosaurus can be configured through the normal customization interface of 50 | emacs. Take a look at: 51 | 52 | : M-x customize-group synosaurus 53 | 54 | The individual options are: 55 | 56 | - ~synosaurus-backend~ 57 | 58 | The thesaurus backend to use. This can also be set per buffer. 59 | 60 | - ~synosaurus-choose-method~ 61 | 62 | The way, ~synosaurus-choose-and-replace~ should query you for 63 | alternatives. The following symbols are acceptable values. 64 | 65 | - popup :: Use the library popup.el to show a popup with alternatives. 66 | This is recommended and the default, but you will need to 67 | install popup.el separately. 68 | 69 | - ido :: Use IDO to show a nice fuzzy matching completing minibuffer. 70 | 71 | - default :: Use the normal minibuffer completion. 72 | 73 | ** Backends 74 | 75 | Two thesaurus backends are implemented right now in various states of 76 | completion. 77 | 78 | *Openthesaurus* is a open German thesaurus and is supported quite well, but 79 | needs an Internet connection to be queried. Its backend function is called 80 | ~synosaurus-backend-openthesaurus~. 81 | 82 | *Wordnet* is a English thesaurus, that can be installed as a separate program 83 | called /wn/, that is used offline. Wordnet can do lot's of things other than 84 | simple lists of synonyms. Not many of these features are supported by 85 | synosaurus, yet. Wordnet's backend function is called 86 | ~synosaurus-backend-wordnet~. 87 | 88 | ** Dependencies 89 | 90 | - popup.el, if you want to use the /popup/ method for choosing alternatives. 91 | -------------------------------------------------------------------------------- /synosaurus.el: -------------------------------------------------------------------------------- 1 | ;;; synosaurus.el --- An Emacs frontend for thesauri -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2019 Hans-Peter Deifel 4 | 5 | ;; Author: Hans-Peter Deifel 6 | ;; Keywords: wp 7 | ;; Homepage: https://github.com/hpdeifel/synosaurus 8 | ;; Package-Requires: ((cl-lib "0.5")) 9 | 10 | ;; This program is free software; you can redistribute it and/or modify 11 | ;; it under the terms of the GNU General Public License as published by 12 | ;; the Free Software Foundation, either version 3 of the License, or 13 | ;; (at your option) any later version. 14 | 15 | ;; This program is distributed in the hope that it will be useful, 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;; GNU General Public License for more details. 19 | 20 | ;; You should have received a copy of the GNU General Public License 21 | ;; along with this program. If not, see . 22 | 23 | ;;; Commentary: 24 | 25 | ;; An extensible thesaurus supporting lookup and substitution. 26 | 27 | ;; You can choose between multiple backends. Current backends include 28 | ;; wordnet and openthesaurus, but it's easy to add your own. 29 | 30 | ;; Use `synosaurus-lookup' for lookup and `synosaurus-choose-and-replace' 31 | ;; to replace the word under cursor. 32 | 33 | ;; Customization can be done by M-x customize-group synosaurus 34 | 35 | ;;; Code: 36 | 37 | (require 'button) 38 | (require 'cl-lib) 39 | (require 'thingatpt) 40 | (require 'ido) 41 | 42 | (declare-function popup-menu* "popup") 43 | 44 | (defgroup synosaurus nil "An extensible thesaurus mode" 45 | :group 'convenience 46 | :group 'text) 47 | 48 | (defcustom synosaurus-choose-method 'ido 49 | "The way of querying the user for word replacements. 50 | 51 | This is used in `synosaurus-choose-and-replace'. 52 | 53 | Valid values are: 54 | 55 | - popup : Use popup.el to show a nice popup with alternatives. 56 | The popup.el library must be installed for this to work. 57 | - ido : Use IDO to read an alternative with completion. 58 | - default : Use normal minibuffer completion." 59 | :group 'synosaurus 60 | :type '(choice (const :tag "popup.el" popup) 61 | (const :tag "Ido" ido) 62 | (const :tag "Completing read" default))) 63 | 64 | (defcustom synosaurus-backend 'synosaurus-backend-wordnet 65 | "The backend for the thesaurus. 66 | 67 | Built-in backends are 68 | 69 | - synosaurus-backend-wordnet An english offline thesaurus 70 | - synosaurus-backend-openthesaurus A german online thesaurus" 71 | :group 'synosaurus 72 | :type '(choice (const :tag "Wordnet" synosaurus-backend-wordnet) 73 | (const :tag "OpenThesaurus" synosaurus-backend-openthesaurus) 74 | (function :tag "Other"))) 75 | (make-variable-buffer-local 'synosaurus-backend) 76 | 77 | (defcustom synosaurus-prefix (kbd "C-c C-s") 78 | "Synosaurus keymap prefix." 79 | :group 'synosaurus 80 | :type 'string) 81 | 82 | (defun synosaurus--internal-lookup (word) 83 | "Call current backend with `WORD'." 84 | (if synosaurus-backend 85 | (funcall synosaurus-backend word) 86 | (error "No thesaurus lookup function specified"))) 87 | 88 | (defun synosaurus--strip-properties (string) 89 | "Remove text properties from `STRING'." 90 | (set-text-properties 0 (length string) nil string) 91 | string) 92 | 93 | (defun synosaurus--guess-default (&optional errorp) 94 | "Return region or word under cursor. 95 | 96 | If `ERRORP' is non-nil, throw an error if the region is not 97 | active and there is no word at point." 98 | (if (use-region-p) 99 | (buffer-substring-no-properties (region-beginning) (region-end)) 100 | (let ((word (thing-at-point 'word))) 101 | (if (and (null word) errorp) 102 | (error "No word at point.") 103 | (synosaurus--strip-properties word))))) 104 | 105 | (defvar synosaurus--history nil) 106 | 107 | (defun synosaurus--interactive () 108 | "Ask the user for a word (with default)." 109 | (let* ((default (synosaurus--guess-default)) 110 | (res (read-string (if default 111 | (format "Word (default %s): " default) 112 | "Word: ") 113 | nil 'synosaurus--history default))) 114 | (list res))) 115 | 116 | (defun synosaurus--button-action (arg) 117 | (synosaurus-lookup (button-label arg))) 118 | 119 | (defvar synosaurus-list-mode-map 120 | (let ((map (copy-keymap button-buffer-map))) 121 | (set-keymap-parent map special-mode-map) 122 | map)) 123 | 124 | (define-derived-mode synosaurus-list-mode special-mode "Synosaurus") 125 | 126 | ;;;###autoload 127 | (defun synosaurus-lookup (word) 128 | "Lookup `WORD' in the thesaurus. 129 | 130 | Queries the user for a word and looks it up in a thesaurus using 131 | `synosaurus-backend'. 132 | 133 | The resulting synonym list will be shown in a new buffer, where 134 | the words are clickable to look them up instead of the original 135 | word." 136 | (interactive (synosaurus--interactive)) 137 | (let ((synonyms (synosaurus--internal-lookup word)) 138 | (backend synosaurus-backend) 139 | (inhibit-read-only t)) 140 | (with-current-buffer (get-buffer-create "*Synonyms List*") 141 | (erase-buffer) 142 | (insert 143 | (propertize (format "Synonyms of %s:\n\n" word) 144 | 'face 'success)) 145 | (cl-flet ((ins (syn) 146 | (unless (string= word syn) 147 | (insert " ") 148 | (insert-text-button syn 149 | 'action 'synosaurus--button-action) 150 | (insert "\n")))) 151 | (dolist (syn synonyms) 152 | (if (not (listp syn)) 153 | (ins syn) 154 | (dolist (syn2 syn) 155 | (ins syn2)) 156 | (insert "\n")))) 157 | (goto-char (point-min)) 158 | (condition-case nil (forward-button 1 t nil) 159 | (error nil)) 160 | (synosaurus-list-mode) 161 | (setq-local synosaurus-backend backend))) 162 | (display-buffer "*Synonyms List*")) 163 | 164 | (defun synosaurus--choose (list) 165 | "Choose among a `LIST' of values." 166 | (let ((completion-prompt "Replacement: ")) 167 | (pcase synosaurus-choose-method 168 | (`popup (unless (require 'popup nil t) 169 | (error "Please install popup.el to use the popup choose-method")) 170 | (popup-menu* list)) 171 | (`ido (require 'ido) 172 | (ido-completing-read completion-prompt list)) 173 | (_ (completing-read completion-prompt list))))) 174 | 175 | ;;;###autoload 176 | (defun synosaurus-choose-and-replace () 177 | "Replace the word under the cursor by a synonym. 178 | 179 | Look up the word in the thesaurus specified by 180 | `synosaurus-backend', let the user choose an alternative 181 | and replace the original word with that. 182 | 183 | If the region is active, replace the region instead of the word 184 | at point." 185 | (interactive "") 186 | (let* ((word (synosaurus--guess-default t)) 187 | (syns 188 | (delete-dups 189 | (cl-loop for syn in (synosaurus--internal-lookup word) 190 | if (listp syn) append syn 191 | else append (list syn))))) 192 | (if (null syns) (message "No synonyms found for %s" word) 193 | (let ((res (synosaurus--choose syns))) 194 | (when res 195 | (if (use-region-p) 196 | (delete-region (region-beginning) (region-end)) 197 | (delete-region (beginning-of-thing 'word) 198 | (end-of-thing 'word))) 199 | (insert res)))))) 200 | 201 | ;;;###autoload 202 | (defun synosaurus-choose-and-insert (word) 203 | "Look up `WORD' in the thesaurus, choose a synonym for `WORD', 204 | and insert it into the current buffer." 205 | (interactive (synosaurus--interactive)) 206 | (let ((syns (delete-dups 207 | (cl-loop for syn in (synosaurus--internal-lookup word) 208 | if (listp syn) append syn 209 | else append (list syn))))) 210 | (if (null syns) (message "No synonyms found for %s" word) 211 | (let ((res (synosaurus--choose syns))) 212 | (when res (insert res)))))) 213 | 214 | (defvar synosaurus-command-map 215 | (let ((map (make-sparse-keymap))) 216 | (define-key map (kbd "l") 'synosaurus-lookup) 217 | (define-key map (kbd "r") 'synosaurus-choose-and-replace) 218 | (define-key map (kbd "i") 'synosaurus-choose-and-insert) 219 | map)) 220 | (fset 'synosaurus-command-map synosaurus-command-map) 221 | 222 | (defvar synosaurus-mode-map 223 | (let ((map (make-sparse-keymap))) 224 | (define-key map synosaurus-prefix synosaurus-command-map) 225 | map)) 226 | 227 | ;;;###autoload 228 | (define-minor-mode synosaurus-mode 229 | "Minor mode for thesaurus lookups. 230 | 231 | When called interactively, toggle `synosaurus-mode'. With prefix 232 | ARG, enable `synosaurus-mode' if ARG is positive, otherwise 233 | disable it. 234 | 235 | When called from Lisp, enable `synosaurus-mode', if ARG is 236 | omitted, nil or positive. If ARG is `toggle', toggle 237 | `synosaurus-mode'. Otherwise behave as if called interactively. 238 | 239 | The thesaurus backend can be configured with 240 | `synosaurus-backend'. 241 | 242 | \\{synosaurus-mode-map}" 243 | :lighter " Syn" 244 | :keymap synosaurus-mode-map 245 | :group 'synosaurus) 246 | 247 | (provide 'synosaurus) 248 | ;;; synosaurus.el ends here 249 | --------------------------------------------------------------------------------