1 ;;; synonyms.el --- Look up synonyms for a word or phrase in a thesaurus.
3 ;; Filename: synonyms.el
4 ;; Description: Look up synonyms for a word or phrase in a thesaurus.
6 ;; Maintainer: Drew Adams
7 ;; Copyright (C) 2005-2011, Drew Adams, all rights reserved.
8 ;; Created: Tue Dec 20 14:39:26 2005
10 ;; Last-Updated: Sat Jul 30 11:36:00 2011 (-0700)
13 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/synonyms.el
14 ;; Keywords: text, dictionary, thesaurus, spelling, apropos, help
15 ;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x
17 ;; Features that might be required by this library:
19 ;; `thingatpt', `thingatpt+'.
21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25 ;; Look up synonyms for a word or phrase in a thesaurus.
31 ;; To use library Synonyms, you will need the Moby Thesaurus II file,
32 ;; `mthesaur.txt', available here:
34 ;; ftp://ibiblio.org/pub/docs/books/gutenberg/etext02/mthes10.zip
36 ;; Put this in your initialization file (~/.emacs):
38 ;; ;; The file names are absolute, not relative, locations
39 ;; ;; - e.g. /foobar/mthesaur.txt.cache, not mthesaur.txt.cache
40 ;; (setq synonyms-file <name & location of mthesaur.txt>)
41 ;; (setq synonyms-cache-file <name & location of your cache file>)
42 ;; (require 'synonyms)
44 ;; As an alternative to the first two lines, you can use Customize to
45 ;; set `synonyms-file' and `synonyms-cache-file' persistently. The
46 ;; second of these files is created by this library, to serve as a
47 ;; synonym cache for completion.
49 ;; The main command is `synonyms'. It prompts you for a word or
50 ;; phrase to look up in the thesaurus. The synonyms found are then
51 ;; displayed in buffer *Synonyms*. For example, `M-x synonyms RET
52 ;; democracy' displays synonyms for `democracy'.
54 ;; If you do not define `synonyms-file' and `synonyms-cache-file'
55 ;; prior to using command `synonyms', that command will prompt you to
56 ;; define them. If you want to use the same values during subsequent
57 ;; Emacs sessions, then you should use `M-x customize-option' to save
58 ;; those newly defined values.
64 ;; The thesaurus is divided into "entries", which are like glossary
65 ;; entries: each entry is followed by associated words and phrases,
66 ;; which, for lack of a better word, I refer to as "synonyms". For
67 ;; example, `democracy' is an entry, and it is followed by its
68 ;; synonyms. Some synonyms are not also entries. For example,
69 ;; `patriarchy' is in the thesaurus as a synonym but not as an entry.
71 ;; Note: What I call "synonyms" here are not necessarily synonyms, in
72 ;; the sense of having the same or even similar meanings. They are
73 ;; simply terms collected together with the same thesaurus entry
74 ;; because they are related in some way - the grouping is what
75 ;; defines their relation.
77 ;; In Moby Thesaurus II, the meanings of synonyms in the same group
78 ;; do have something in common, but this might be simply the fact
79 ;; that they are terms of a similar kind. For example, the
80 ;; "synonyms" following the `democracy' thesaurus entry are words
81 ;; such as `dictatorship' and `autocracy'. These are different forms
82 ;; of the same general thing: government - they are certainly not
83 ;; synonymous with each other or with the entry `democracy'.
86 ;; Searching the Thesaurus
87 ;; -----------------------
89 ;; The default input value for command `synonyms' is the word under
90 ;; the cursor. Alternatively, if a region is active and you are in
91 ;; Transient Mark mode (recommended), then it is the text in the
92 ;; region (selection).
94 ;; Your input is actually treated as a regular expression (regexp),
95 ;; so you can also input patterns like `for.*ion', which will match
96 ;; thesaurus entries `formation', `formulation', `fornication',
97 ;; `fortification', and `forward motion'. Note that the last of
98 ;; these is a phrase rather than a single word.
100 ;; Using a regexp as input is a powerful way to search, but be aware
101 ;; that it can be costly in CPU time and computer memory if the
102 ;; regexp is not appropriate. The regexp `.*' will, for example,
103 ;; likely use up available memory before being able to return the
104 ;; entire thesaurus (it's very large). You can always use `C-g' to
105 ;; interrupt a thesaurus search if you mistakenly use an inefficient
109 ;; Using a Prefix Argument To Do More
110 ;; ----------------------------------
112 ;; You can use a prefix argument to modify searching and the
113 ;; presentation of search results, as follows:
115 ;; `C-u' - Search for additional synonyms, in two senses:
117 ;; 1) Return also synonyms that are matched partially
120 ;; 2) Search the entire thesaurus for input matches,
121 ;; even if the input matches a thesaurus entry.
123 ;; `M--' - Append the search results to any previous search
124 ;; results, in buffer *Synonyms*. (Normally, the new
125 ;; results replace any previous results.)
127 ;; `C-u C-u' - `C-u' plus `M--': Search more and append results.
129 ;; If you find yourself often using a particular prefix argument (for
130 ;; example, to append results), then you might want to instead change
131 ;; the default behavior to reflect this preference. Options
132 ;; `synonyms-match-more-flag' and `synonyms-append-result-flag'
133 ;; correspond to using `C-u' and `M--', respectively. In fact, a
134 ;; prefix argument simply toggles the value of the corresponding
135 ;; option for the duration of the command. So, for example, if
136 ;; `synonyms-append-result-flag' is t and you use `M--', then results
137 ;; will not be appended.
139 ;; When partially matching input (`C-u', sense #1), complete synonyms
140 ;; are matched against your input. This means that you generally
141 ;; need not add a preceding or trailing `.*' to try to match a
142 ;; complete synonym. For example, input `format' will match the
143 ;; complete synonyms `conformation', `efformation', `format',
144 ;; `formation', `formative', `formational', `information',
145 ;; `informative', `informational', `malformation', `deformation',
146 ;; `reformation', `transformation', `reformatory', and so on - there
147 ;; is no need to input `.*format.*' to match the same synonyms.
149 ;; To better understand the meaning of #2 above for `C-u' (to
150 ;; continue the search even if your input matches an entry), try, for
151 ;; example, `C-u M-x synonyms RET widespread'. You'll see not only
152 ;; the main synonyms listed for `widespread' as an entry, but also
153 ;; lots of different meanings of `widespread', judging by the entries
154 ;; for which it is listed as a synonym:
156 ;; `accepted', `ample', `broad', `broadcast', `capacious',
157 ;; `catholic', `commodious', `commonness', `conventional',
158 ;; `currency', `current', `customary', `deep', `deltoid',
159 ;; `diffuse', `discrete', `dispersed', `disseminated',
160 ;; `dissipated', `distributed', `epidemic', `established',
161 ;; `everyday', `expansive', `extended', `extensive', `familiar',
162 ;; `fan shaped', `far flung', `far reaching', `flaring', `full',
163 ;; `general', `indiscriminate', `infinite', `large scale',
164 ;; `liberal', `normal', `normality', `open', `ordinary',
165 ;; `outstretched', `pervasive', `popular', `prescribed',
166 ;; `prescriptive', `prevailing', `prevalence', `prevalent',
167 ;; `public', `rampant', `received', `regnant', `regular',
168 ;; `regulation', `reign', `rife', `roomy', `ruling', `run',
169 ;; `scattered', `set', spacious`', `sparse', `splay', `sporadic',
170 ;; `sprawling', `spread', `standard', `stock', `straggling',
171 ;; `stretched out', `sweeping', `time-honored', `traditional',
172 ;; `universal', `usual', `vast', `voluminous', `wholesale', `wide
173 ;; open', `wide', and `wonted'.
175 ;; These are just the entries! Each of these is of course followed by
176 ;; its own synonyms - perhaps 100 or 300, including `widespread'.
178 ;; This list of entries is not the same list as the synonyms for
179 ;; entry `widespread'. There are words and phrases here that are not
180 ;; in the latter list, and vice versa. For example, the former (but
181 ;; not the latter) list includes `full'; the latter (but not the
182 ;; former) list includes `wide-reaching'.
184 ;; The latter are the words most closely related to `widespread'.
185 ;; The list above are the other thesaurus entries (corresponding to
186 ;; main categories) to which `widespread' is most closely related.
187 ;; Looking at all of the synonym groups in which `widespread' appears
188 ;; can tell you additional information about its meanings - and it
189 ;; can provide additional synonyms for `widespread'.
192 ;; Using Completion with Synonyms
193 ;; ------------------------------
195 ;; You can complete words and phrases in the minibuffer, as input to
196 ;; command `synonyms'. You can use library Synonyms together with
197 ;; library Icicles to complete a partial word in a text buffer into a
198 ;; word or phrase in the thesaurus. If you use both libraries then
199 ;; load Icicles after Synonyms. For more information on Icicles, see
200 ;; `http://www.emacswiki.org/cgi-bin/wiki/icicles.el'.
202 ;; ** Minibuffer Input Completion **
204 ;; You can enter any text to match against thesaurus synonyms. When
205 ;; you are prompted by command `synonyms' to enter this text, you can
206 ;; also use input completion to complete to a thesaurus synonym.
207 ;; That is, even though you can enter any text (including a regexp),
208 ;; completion will only complete to synonyms in the thesaurus.
210 ;; If you load library Icicles, then a more powerful version of
211 ;; command `synonyms' is used. In particular, it lets you:
213 ;; - Use `S-TAB' during completion to see the list of all synonyms
214 ;; (thesaurus terms) that match your minibuffer input so far.
216 ;; - Use `[next]', and `[prior]' (usually keys `Page Down' and `Page
217 ;; Up') during completion to cycle through the completion
218 ;; candidates (synonyms) that match your input.
220 ;; - Use `C-o', `C-[next]', and `[C-prior]' during completion to
221 ;; display the synonyms of the current completion candidate.
223 ;; ** Completing Buffer Text Using the Thesaurus **
225 ;; Icicles also provides two commands for using completion to insert
226 ;; thesaurus entries in a buffer:
228 ;; - `icicle-complete-thesaurus-entry' completes a word in a text
229 ;; buffer to any word or phrase in the thesaurus. I bind it to
232 ;; - `icicle-insert-thesaurus-entry' inserts thesaurus words and
233 ;; phrases in a text buffer. It is a multi-command, which means
234 ;; that, within a single call to it, you can insert any number of
235 ;; thesaurus entries, in succession. If you want to, you can
236 ;; write an entire book using a single call to
237 ;; `icicle-insert-thesaurus-entry'!
240 ;; Browsing the Thesaurus
241 ;; ----------------------
243 ;; Besides using command `synonyms' to search for synonyms, you can
244 ;; use Synonyms to browse the thesaurus. This is really just the
245 ;; same thing, but key and mouse bindings are provided in buffer
246 ;; *Synonyms*, so you need not input anything - just point and click
247 ;; the hyperlinks. Buffer *Synonyms* is in Synonyms major mode,
248 ;; which provides a few additional features.
250 ;; You can still choose to search for additional synonyms or append
251 ;; search results, without bothering with a prefix argument, by using
252 ;; modifier keys (Control, Meta) with a mouse click.
254 ;; Another way of browsing is to revisit previous search-result
255 ;; pages. You can do this using commands `synonyms-history-backward'
256 ;; and `synonyms-history-forward'. In buffer *Synonyms*, these are
257 ;; bound to the following key sequences, for convenience:
259 ;; `l', `p', `mouse-4' - `synonyms-history-backward'
260 ;; `r', `n', `mouse-5' - `synonyms-history-forward'
262 ;; The `l' and `r' bindings correspond to the history bindings in
263 ;; Info. The `p' and `n' bindings stand for "previous" and "next".
264 ;; The bindings to additional mouse buttons correspond to typical
265 ;; bindings for Back and Forward in Web browsers.
267 ;; In addition to these bindings, the same history commands can be
268 ;; accessed by clicking links [Back] and [Forward] with `mouse-2'.
270 ;; If you have previously used the append option (via, for example,
271 ;; `M-mouse2'), so that there are multiple search results in buffer
272 ;; *Synonyms*, then using a history command simply takes you to the
273 ;; preceding (for [Back]) or following (for [Forward]) result in the
274 ;; buffer, measured from the current cursor position. Depending on
275 ;; the cursor position, this might be different from the previous or
276 ;; next search made previously.
278 ;; This is for convenience, but it is also more efficient in the case
279 ;; of a regexp search that takes a long time. Except for this
280 ;; special treatment of appended results, whenever you navigate the
281 ;; search-results history you are actually searching again for a
282 ;; synonym you sought previously. The case of appended results is
283 ;; analogous to accessing a Web browser cache when navigating the
286 ;; You can of course use modifier keys (Control, Meta) while you
287 ;; click links [Back] and [Forward], to impose their usual behavior:
288 ;; search for additional synonyms or append search results, or both.
290 ;; Finally, some people prefer menus, so there is a Synonyms menu-bar
291 ;; menu when you are in Synonyms mode, complete with all of the
292 ;; functionalities described above.
294 ;; For more information on the browsing possibilities in buffer
295 ;; *Synonyms*, use `?' in Synonyms mode.
298 ;; Dictionary Definitions, Antonyms, etc.
299 ;; --------------------------------------
301 ;; Synonyms works with a large but simple database of groups of words
302 ;; and phrases that are synonyms of each other. This database does
303 ;; not provide definitions of words or phrases; it simply groups
304 ;; them. Command `synonym-definition' (aka `dictionary-definition')
305 ;; lets you look up a word or phrase (or a regexp) using one or more
306 ;; dictionaries on the Web. That is usually the best source for this
307 ;; kind of information, but you obviously need an Internet connection
308 ;; to use this command.
310 ;; Options (variables) `synonyms-dictionary-url' and
311 ;; `synonyms-dictionary-alternate-url' are URLs you can set to point
312 ;; to the dictionaries of your choice. The default value of
313 ;; `synonyms-dictionary-alternate-url' looks up the search term in
314 ;; multiple dictionaries, and it lets you use wildcards. Use `C-h v
315 ;; synonyms-dictionary-alternate-url' for more information. The
316 ;; default value of `synonyms-dictionary-url' usually provides a
317 ;; quicker answer. Both of these URLs also give you access to
318 ;; additional information about the search term (antonyms, etymology,
319 ;; even pronunciation).
321 ;; In buffer *Synonyms*, you can simply hit `d' followed by `RET' or
322 ;; `mouse-2' to look up a term that is in the buffer. Just as for
323 ;; looking up a synonym by clicking `mouse-2', if you select text
324 ;; (region), then that text is looked up.
327 ;; A Cache File of Synonyms
328 ;; ------------------------
330 ;; The very first time you use Synonyms, a large list of synonyms
331 ;; will be compiled and written to a cache file. This is slow - it
332 ;; takes 2-3 minutes - but it is only a one-time cost. From then on,
333 ;; whenever you first use Synonyms during an Emacs session, the cache
334 ;; file will be read (quickly), to create the list of synonyms that
335 ;; are used for minibuffer completion.
338 ;; Using Other Thesauri, Dictionaries, and so on - CSV data
339 ;; --------------------------------------------------------
341 ;; There is nothing in library Synonyms that ties it to the Moby
342 ;; Thesaurus II thesaurus. All of its functionality will work with
343 ;; any file of comma-separated values. Each line of such a file is
344 ;; interpreted as a synonym group, as understood here, and the first
345 ;; word or phrase on each line is interpreted as a thesaurus entry,
346 ;; as understood here. This means only that search results are
347 ;; organized into sections with entry headers.
349 ;; If, for example, you had a CSV file of personal contacts, where
350 ;; the first term in each line was a last name or a company name,
351 ;; then you could use library Synonyms to query it, producing the
352 ;; same kind of output as for the thesaurus.
354 ;; One thing to keep in mind if you try to use library Synonyms with
355 ;; a different CSV file is that there are several different CSV-file
356 ;; syntaxes. The one that Synonyms is built to use is a simple one,
357 ;; with no quote marks around entries and no embedded quote marks
360 ;; Similarly, there is nothing here that limits the functionality to
361 ;; English. If you had a thesaurus in another language, it should
364 ;; Currently, Synonyms works with a single raw synonyms file
365 ;; (thesaurus) and a corresponding single cache file (for
366 ;; completion). However, it would be easy to extend the
367 ;; functionality to use multiple thesauri or, in general, multiple
368 ;; CSV files. Suggestions of requirements (e.g. ways to select a
369 ;; thesaurus for particular passages of text) are welcome.
373 ;; Things Defined Here
374 ;; -------------------
376 ;; Faces defined here -
378 ;; `synonyms-heading', `synonyms-search-text',
379 ;; `synonyms-mouse-face'.
382 ;; User options (variables) defined here -
384 ;; `synonyms-append-result-flag', `synonyms-cache-file',
385 ;; `synonyms-file', `synonyms-fill-column',
386 ;; `synonyms-match-more-flag', `synonyms-mode-hook',
387 ;; `synonyms-use-cygwin-flag'.
389 ;; Commands defined here -
391 ;; `dictionary-definition', `synonyms', `synonyms-append-result',
392 ;; `synonyms-append-result-no-read', `synonyms-definition',
393 ;; `synonyms-definition-mouse', `synonyms-definition-no-read',
394 ;; `synonyms-ensure-synonyms-read-from-cache',
395 ;; `synonyms-history-backward', `synonyms-history-forward',
396 ;; `synonyms-make-obarray', `synonyms-match-more',
397 ;; `synonyms-match-more-no-read',
398 ;; `synonyms-match-more+append-result',
399 ;; `synonyms-match-more+append-result-no-read', `synonyms-mode',
400 ;; `synonyms-mouse', `synonyms-mouse-append-result',
401 ;; `synonyms-mouse-match-more',
402 ;; `synonyms-mouse-match-more+append-result', `synonyms-no-read',
403 ;; `synonyms-write-synonyms-to-cache'.
405 ;; Non-interactive functions defined here -
407 ;; `synonyms-action', `synonyms-add-history-links',
408 ;; `synonyms-default-regexp', `synonyms-define-cache-file',
409 ;; `synonyms-define-synonyms-file', `synonyms-format-entries',
410 ;; `synonyms-format-entry', `synonyms-format-finish',
411 ;; `synonyms-format-synonyms',
412 ;; `synonyms-hack-backslashes-if-cygwin', `synonyms-lookup',
413 ;; `synonyms-nearest-word', `synonyms-file-readable-p',
414 ;; `synonyms-search-entries', `synonyms-search-synonyms',
415 ;; `synonyms-show-synonyms', `synonyms-file-writable-p'.
417 ;; Internal variables defined here -
419 ;; `synonyms-history', `synonyms-history-forward',
420 ;; `synonyms-list-for-obarray', `synonyms-mode-map',
421 ;; `synonyms-obarray', `synonyms-search-text'.
423 ;; Key bindings made here - see `synonyms-mode'. All key bindings
424 ;; are local to Synonyms mode; no global bindings are made here.
431 ;; The basic functionality provided here was derived from library
432 ;; `mthesaur.el', by Tad Ashlock <taashlo@cyberdude.com>. That
433 ;; library, in turn, was inspired by library `thesaurus.el', by Ray
434 ;; Nickson. Thanks also to those who sent helpful bug reports.
437 ;; Note on MS Windows Emacs 20 and Cygwin `grep'
438 ;; ---------------------------------------------
440 ;; There is apparently a bug in the Emacs (at least versions 20-22) C
441 ;; code that implements function `call-process' on MS Windows. When
442 ;; using native Windows Emacs with Cygwin commands, such as `grep',
443 ;; the C code removes a level of backslashes in some cases, so string
444 ;; arguments supplied to `call-process' need to have twice as many
445 ;; backslashes as they should need in those cases. It is for this
446 ;; reason that option `synonyms-use-cygwin-flag' is supplied here.
447 ;; When that option is non-nil, backslashes in regexps are hacked to
448 ;; do the right thing. (In Emacs 20, this means doubling the
449 ;; backslashes; in Emacs 21-22, this means doubling them unless there
450 ;; are spaces in the search string.)
456 ;; 1. It would be ideal to have not only synonym information but also
457 ;; definitions, antonyms, more general and more specific terms,
458 ;; filtering by part of speech (verb vs adjective etc.), and so
459 ;; on. A good example of what I'd really like to have is provided
460 ;; by the free Windows program WordWeb (available here:
461 ;; http://wordweb.info/). Combining that functionality with
462 ;; Icicles completion features would provide a great tool, IMO.
464 ;; `synonyms-definition*' goes a long way toward providing this,
465 ;; and perhaps it is the best way to go, since there is so much
466 ;; more definitional info on the Web.
468 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
473 ;; Moved Icicles code to icicles-cmd2.el. Removed soft-require of icicles.el.
475 ;; Better defaults for faces, for dark backgrounds.
477 ;; Added autoload cookies (for defgroup, defface, defcustom, and commands).
479 ;; synonyms - non-Icicles version: Made ARG optional too.
480 ;; synonyms(-no-read|-history-(backward|forward)):
481 ;; Use ARG, not current-prefix-arg.
483 ;; synonyms-history-(backward|forward): save-excursion + set-buffer -> with-current-buffer.
485 ;; synonyms-obarray: Removed * doc-string prefix.
487 ;; icicle-sort-case-insensitively -> icicle-case-insensitive-string-less-p.
489 ;; Renamed group synonyms to Synonyms. :group 'icicles -> :group 'Icicles.
491 ;; synonyms-write-synonyms-to-cache: Use prin1 instead of pp.
493 ;; synonyms-file-(read|writ)able-p: Put non-empty string condition first.
495 ;; synonyms-file-(read|writ)able-p: Make sure also not a directory.
497 ;; synonyms-ensure-synonyms-read-from-cache, synonyms-define-synonyms-file:
498 ;; Set synonyms(-cache)-file to expanded version.
500 ;; Updated Commentary to mention Icicles completion of synonyms.
502 ;; synonyms-define-cache-file: Fixed typo.
504 ;; synonyms-define-cache-file: wrap file-name-directory in expand-file-name.
506 ;; synonyms-format-finish: Minor tweak to regexp: space and tab, but not newline or formfeed.
508 ;; Added dictionary definition lookup:
509 ;; Added: synonyms-dictionary(-alternate)-url, synonyms-definition*.
510 ;; Bound synonyms-definition-*.
513 ;; Make sure file name is expanded (thanks to Nikos Apostolakis):
514 ;; synonyms-search-(entries|synonyms): Expand file name.
515 ;; synonyms-define-*-file: Set variable after expanding file name.
516 ;; synonyms-format-entry, synonyms-history-*, synonyms-add-history-links:
517 ;; Raise error if search finds nothing.
518 ;; synonyms-hack-backslashes-if-cygwin: Don't double if spaces and not Emacs 20.
519 ;; Renamed synonyms-double-backslashes-if-cygwin to synonyms-hack-backslashes-if-cygwin.
520 ;; synonyms-mode-map: swapped bindings for C-mouse-2 and C-down-mouse-2, for Emacs 22.
522 ;; Fixed typo: require 'synonyms. (Thanks to Nikos Apostolakis.)
526 ;; synonyms-format-finish: Don't skip numbered header, so highlight multiple synonyms in entry.
528 ;; Added: synonyms-define-cache-file, synonyms-define-synonyms-file,
529 ;; synonyms-file-readable-p, synonyms-file-writable-p.
530 ;; synonyms-make-obarray: Use synonyms-define-synonyms-file.
531 ;; Use synonyms-mode, to get modified syntax (bug fix).
532 ;; synonyms-write-synonyms-to-cache: Use synonyms-define-cache-file.
533 ;; synonyms-ensure-synonyms-read-from-cache: Use synonyms-file-readable-p.
534 ;; synonyms(-cache)-file: Use empty string as initial value.
535 ;; Thanks to Alex Schroeder [alex@emacswiki.org] for suggestion to prompt for file names.
537 ;; Added menu-bar Synonyms menu.
538 ;; Renamed synonyms-read-synonyms-from-cache to synonyms-ensure-synonyms-read-from-cache.
539 ;; Call it from synonyms, not from synonyms-mode.
540 ;; Defined synonyms-mode-map per convention.
541 ;; synonyms-match-more, synonyms-append-result, synonyms-match-more+append-result:
542 ;; Use synonyms, not synonyms-no-read.
543 ;; Added: synonyms-*-no-read. Bound those, not the new read versions.
545 ;; Treat modifiers with clicks on [Back] and [Forward] links.
546 ;; synonyms-history-(backward|forward): Add prefix arg. Bind options.
547 ;; synonyms-mode, synonyms-lookup: Disable undo.
549 ;; Added: synonyms-history-(backward|forward), synonyms-add-history-links, synonyms-link.
550 ;; Added: [Back] and [Forward] links.
551 ;; synonyms-show-synonyms: Put cursor on first synonym.
552 ;; synonyms-mouse, synonyms-lookup: Removed save-excursion.
553 ;; synonyms-mouse: Treat clicks on [Back] and [Forward] links too.
554 ;; synonyms-format-finish: Added save-excursion for last part: filling and adding mouse-face.
555 ;; synonyms-nearest-word: Remove text properties.
556 ;; synonyms: Use synonym-action.
557 ;; synonyms-lookup: When no synonyms found, remove search-text from history.
558 ;; Require cl.el when compile.
560 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
562 ;; This program is free software; you can redistribute it and/or modify
563 ;; it under the terms of the GNU General Public License as published by
564 ;; the Free Software Foundation; either version 2, or (at your option)
565 ;; any later version.
567 ;; This program is distributed in the hope that it will be useful,
568 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
569 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
570 ;; GNU General Public License for more details.
572 ;; You should have received a copy of the GNU General Public License
573 ;; along with this program; see the file COPYING. If not, write to the
574 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth
575 ;; ;; Floor, Boston, MA 02110-1301, USA.
577 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
581 (eval-when-compile (require 'cl)) ;; push, pop
583 (require 'thingatpt+ nil t) ;; (no error if not found): word-nearest-point
584 (require 'thingatpt nil t) ;; (no error if not found): word-at-point
586 ;; Note: You might get byte-compiler warnings that variables `appendp'
587 ;; and `morep' are free: . This is OK.
589 ;;;;;;;;;;;;;;;;;;;;;;;;;
594 ;;; Faces (alphabetical) -----------------------------------
597 (defgroup Synonyms nil
598 "Commands to look up synonyms in a thesaurus."
600 :group 'convenience :group 'help :group 'apropos :group 'matching
601 :link `(url-link :tag "Send Bug Report"
602 ,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
604 &body=Describe bug here, starting with `emacs -q'. \
605 Don't forget to mention your Emacs and library versions."))
606 :link '(url-link :tag "Other Libraries by Drew"
607 "http://www.emacswiki.org/cgi-bin/wiki/DrewsElispLibraries")
608 :link '(url-link :tag "Download" "http://www.emacswiki.org/cgi-bin/wiki/synonyms.el")
609 :link '(url-link :tag "Description" "http://www.emacswiki.org/cgi-bin/wiki/Synonyms")
610 :link '(emacs-commentary-link :tag "Commentary" "synonyms"))
613 (defface synonyms-heading '((((background dark)) (:foreground "Yellow"))
614 (t (:foreground "Blue")))
615 "*Face for different synonym types."
616 :group 'Synonyms :group 'faces)
619 (defface synonyms-search-text '((t (:foreground "Red")))
620 "*Face for the term whose synonyms were sought."
621 :group 'Synonyms :group 'faces)
624 (defface synonyms-link '((((background dark)) (:foreground "Yellow" :underline t))
625 (t (:foreground "Blue" :underline t)))
626 "*Face for history links."
627 :group 'Synonyms :group 'faces)
630 (defface synonyms-mouse-face '((((background dark)) (:background "DarkCyan"))
631 (t (:background "Cyan")))
632 "*Mouse face for the term whose synonyms were sought."
633 :group 'Synonyms :group 'faces)
638 ;;; User Options (alphabetical) ----------------------------
641 (defcustom synonyms-append-result-flag nil
642 "*t means that `synonyms' appends search result to previous results.
643 No other value, besides t, has this effect.
645 This can be overridden by using a negative prefix argument,
646 for example, `M--'. If you use `C-u C-u', then both this and
647 `synonyms-match-more-flag' are overridden."
648 :type 'boolean :group 'Synonyms)
651 (defcustom synonyms-cache-file ""
652 "*Location to write cache file containing synonyms.
653 Written to save the list of synonyms used for completion.
654 This is an absolute (complete-path) location, including the file name."
655 :type '(file :must-match t) :group 'Synonyms)
658 (defcustom synonyms-file ""
659 "*Location of thesaurus file `mthesaur.txt'.
660 This is an absolute (complete-path) location, including the file name."
661 :type '(file :must-match t) :group 'Synonyms)
664 (defcustom synonyms-fill-column 80
665 "*Synonyms* buffer text is wrapped (filled) to this many columns."
666 :type 'integer :group 'Synonyms)
669 (defcustom synonyms-match-more-flag nil
670 "*t means additional thesaurus entries can be matched by `synonyms'.
671 No other value, besides t, has this effect.
673 A value of t means two things:
674 1) Input can match parts of synonyms, in addition to whole synonyms.
675 2) All synonyms are shown, even if input matches a thesaurus entry.
677 This can be overridden by using a positive prefix argument,
678 for example, `C-u'. If you use `C-u C-u', then both this and
679 `synonyms-append-result-flag' are overridden."
680 :type 'boolean :group 'Synonyms)
683 (defcustom synonyms-mode-hook nil
684 "*Normal hook run when entering Thesaurus mode."
685 :type 'hook :group 'Synonyms)
688 (defcustom synonyms-use-cygwin-flag nil
689 "*Non-nil means to double backslashes in arguments to `call-process'.
690 There is apparently a bug in the Emacs (at least versions 20-22) C
691 code that implements function `call-process' on MS Windows. When
692 using native Windows Emacs with Cygwin commands, such as `grep', the C
693 code removes a level of backslashes, so string arguments supplied to
694 `call-process' need to have twice as many backslashes as they should
695 need. If you are using Emacs on Windows and Cygwin `grep', then you
696 probably will want to use a non-nil value for
697 `synonyms-use-cygwin-flag'."
698 :type 'boolean :group 'Synonyms)
701 (defcustom synonyms-dictionary-url "http://dictionary.reference.com/search?q="
702 "*URL of a Web dictionary lookup. Text to look up is appended to this.
703 See also `synonyms-dictionaries-url'."
704 :type 'string :group 'Synonyms)
707 (defcustom synonyms-dictionary-alternate-url "http://www.onelook.com/?ls=b&w="
708 "*URL of a Web dictionary lookup. Text to look up is appended to this.
709 The default value, \"http://www.onelook.com/?ls=b&w=\" lets you use `?'
710 and `*' as wildcards in the terms you look up. These are not used as
711 regexp wildcards, however. `?' stands for any single character, and
712 `*' stands for any sequence of characters. In terms of regexp syntax,
713 `?' here is equivalent to the regexp `.', and `*' is equivalent to the
714 regexp `.*'. See http://www.onelook.com/?c=faq#patterns for more
715 information on the allowed wildcard patterns.
716 See also `synonyms-dictionary-url'."
717 :type 'string :group 'Synonyms)
719 ;;; Internal variables (alphabetical) ----------------------
721 (defvar synonyms-history nil "Minibuffer history list for thesaurus lookup.")
723 (defvar synonyms-history-forward nil
724 "Minibuffer history list for thesaurus lookup using `synonyms-history-backward'.")
726 (defvar synonyms-list-for-obarray nil "List of synonyms to be used for completion")
728 (defvar synonyms-mode-map nil "Keymap for `synonyms-mode'.")
730 (unless synonyms-mode-map
731 (let ((map (make-sparse-keymap "Synonyms")))
732 (define-key map [(?d) (mouse-2)] 'synonyms-definition-mouse)
733 (define-key map "d\r" 'synonyms-definition-no-read)
734 (define-key map "s" 'synonyms)
735 (define-key map [S-return] 'synonyms)
736 (define-key map "\r" 'synonyms-no-read)
737 (define-key map [C-return] 'synonyms-match-more-no-read)
738 (define-key map [M-return] 'synonyms-append-result-no-read)
739 (define-key map [C-M-return] 'synonyms-match-more+append-result-no-read)
740 (define-key map [mouse-2] 'synonyms-mouse)
741 (define-key map [C-mouse-2] 'undefined)
742 (define-key map [C-down-mouse-2] 'synonyms-mouse-match-more) ; Get rid of `facemenu-mouse-menu'
743 (define-key map [M-mouse-2] 'synonyms-mouse-append-result)
744 (define-key map [C-M-mouse-2] 'synonyms-mouse-match-more+append-result)
745 (define-key map "l" 'synonyms-history-backward) ; As in Info
746 (define-key map "p" 'synonyms-history-backward) ; As in previous
747 (define-key map "r" 'synonyms-history-forward) ; As in Info
748 (define-key map "n" 'synonyms-history-forward) ; As in next
749 (define-key map [mouse-4] 'synonyms-history-backward)
750 (define-key map [mouse-5] 'synonyms-history-forward)
751 (define-key map " " 'scroll-up) ; SPC
752 (define-key map "\^?" 'scroll-down) ; DEL
753 (define-key map "?" 'describe-mode)
754 (define-key map "q" 'quit-window)
755 (define-key map [menu-bar] (make-sparse-keymap))
756 (define-key map [menu-bar synonyms] (cons "Synonyms" map))
757 (define-key map [synonyms-help] '("Help" . describe-mode))
758 (define-key map [synonyms-separator-2] '("--"))
759 (define-key map [synonyms-next] '("Show Next" . synonyms-history-forward))
760 (put 'synonyms-history-forward 'menu-enable 'synonyms-history-forward)
761 (define-key map [synonyms-previous] '("Show Previous" . synonyms-history-backward))
762 (put 'synonyms-history-backward 'menu-enable '(and synonyms-history (cdr synonyms-history)))
763 (define-key map [synonyms-separator] '("--"))
764 (define-key map [synonyms-more-append]
765 '("Find (Max), Append Results" . synonyms-match-more+append-result))
766 (define-key map [synonyms-append]
767 '("Find, Append Results" . synonyms-append-result))
768 (define-key map [synonyms-more] '("Find (Max)" . synonyms-match-more))
769 (define-key map [synonyms-synonyms] '("Find" . synonyms))
770 (setq synonyms-mode-map map)))
772 ;; 103307 is the smallest prime > 103304, which is the number of synonyms.
773 (defvar synonyms-obarray (make-vector 103307 0)
774 "Obarray of synonyms. Used for completion.")
776 (defvar synonyms-search-text nil "Current text being looked up (matched).")
781 ;;; Functions ----------------------------------------------
784 (define-derived-mode synonyms-mode text-mode "Synonyms"
785 "Major mode for browsing thesaurus entries (synonyms).
786 Like Text mode but with these additional key bindings:
788 \\<synonyms-mode-map>\\[synonyms-mouse], \\[synonyms-no-read], \\[synonyms] - \
789 Look up synonyms for a word or phrase
790 \\[synonyms-mouse-match-more], \\[synonyms-match-more] - Like \\[synonyms-no-read], but \
791 try to match more terms
792 \\[synonyms-mouse-append-result], \\[synonyms-append-result] - Like \\[synonyms-no-read], but \
793 add result to previous result
794 \\[synonyms-mouse-match-more+append-result], \\[synonyms-match-more+append-result] - Like \
795 \\[synonyms-match-more] and \\[synonyms-append-result] combined
797 \\[scroll-up] - Scroll down through the buffer of synonyms
798 \\[scroll-down] - Scroll up through the buffer of synonyms
799 \\[describe-mode] - Display this help
800 \\[quit-window] - Quit Synonyms mode
802 Of the various key bindings that look up synonyms, the most flexible
803 is \\[synonyms] - it prompts you for the search string to match. This
804 can be a regular expression (regexp). The other lookup bindings are
805 for convenience - just click.
807 In Synonyms mode, Transient Mark mode is enabled.
809 Options `synonyms-match-more-flag' and `synonyms-append-result-flag'
810 affect synonym matching and the results. For convenience, \\[synonyms-mouse-match-more],
811 \\[synonyms-mouse-append-result], and \\[synonyms-mouse-match-more+append-result] \
812 toggle the effect of those options for the
813 duration of the command.
815 Note that even though Synonyms mode is similar to Text mode, buffer
816 `*Synonyms*' is read-only, by default - use `C-x C-q' to toggle.
818 Turning on Synonyms mode runs the normal hooks `text-mode-hook' and
819 `synonyms-mode-hook' (in that order)."
821 ;; Synonyms to account for:
822 ;; `$', `1', `0': $100-a-plate dinner; `2': catch-22, V-2; `3': 3-D; `9': strontium 90.
823 ;; To match `$', you will of course need to escape it: `\$'.
824 (modify-syntax-entry ?- "w" synonyms-mode-syntax-table) ; Make hyphen (-) a word character.
825 (modify-syntax-entry ?1 "w" synonyms-mode-syntax-table) ; Make numerals 1,2,3,9,0 word characters.
826 (modify-syntax-entry ?2 "w" synonyms-mode-syntax-table)
827 (modify-syntax-entry ?3 "w" synonyms-mode-syntax-table)
828 (modify-syntax-entry ?9 "w" synonyms-mode-syntax-table)
829 (modify-syntax-entry ?0 "w" synonyms-mode-syntax-table)
830 (modify-syntax-entry ?$ "w" synonyms-mode-syntax-table) ; Make dollar ($) a word character.
831 (buffer-disable-undo)
832 (setq fill-column synonyms-fill-column)
833 (set (make-local-variable 'transient-mark-mode) t))
836 (defun synonyms-ensure-synonyms-read-from-cache ()
837 "Ensure synonyms are in `synonyms-obarray', from `synonyms-cache-file'.
838 If this file does not yet exist, then it and the obarray are created.
839 Creating the obarray for the first time takes 2-3 minutes.
840 This does nothing if the obarray is already complete."
842 (unless (intern-soft "synonym" synonyms-obarray) ; Do nothing if already complete.
843 (setq synonyms-list-for-obarray () ; Just to make sure.
844 synonyms-cache-file (expand-file-name synonyms-cache-file))
845 (if (synonyms-file-readable-p synonyms-cache-file)
846 (let ((list-buf (find-file-noselect synonyms-cache-file 'nowarn 'raw))
847 (obarray synonyms-obarray))
849 (setq synonyms-list-for-obarray (read list-buf))
850 (kill-buffer list-buf)))
851 (synonyms-make-obarray) ; Create obarray from scratch
852 (synonyms-write-synonyms-to-cache)))) ; and write it out, for next time.
855 (defun synonyms-make-obarray ()
856 "Fill `synonyms-obarray' with the available synonyms."
858 (unless (intern-soft "synonym" synonyms-obarray) ; Do nothing if already complete.
859 (synonyms-define-synonyms-file)
860 (with-temp-message "Building synonyms list for completion. This will take a few minutes..."
861 (let ((thesaurus-buf (find-file-noselect synonyms-file 'nowarn 'raw))
865 (set-buffer thesaurus-buf)
866 (goto-char (point-min))
867 (synonyms-mode) ; To use the modified syntax table.
868 (while (re-search-forward "\\(\\(\\w\\|[ ]\\)+\\)\\(,\\|$\\)" nil t)
869 (setq synonym (buffer-substring (match-beginning 1) (match-end 1)))
870 (intern synonym synonyms-obarray)))
871 (kill-buffer thesaurus-buf))))))
873 (defun synonyms-define-synonyms-file ()
874 "Prompt user to define `synonyms-file', unless it is readable."
875 (setq synonyms-file (expand-file-name synonyms-file))
876 (unless (synonyms-file-readable-p synonyms-file)
877 (while (not (synonyms-file-readable-p synonyms-file))
878 (setq synonyms-file (read-file-name "Thesaurus file: " nil nil 'confirm "mthesaur.txt")))
879 (custom-set-variables (list 'synonyms-file
880 (setq synonyms-file (expand-file-name synonyms-file))
884 (defun synonyms-write-synonyms-to-cache ()
885 "Write synonyms in `synonyms-obarray' to file `synonyms-cache-file'."
887 (synonyms-define-cache-file)
888 (with-temp-message "Writing synonyms cache file..."
889 (with-temp-file synonyms-cache-file
890 (mapatoms (lambda (symb) (push symb synonyms-list-for-obarray)) synonyms-obarray)
891 (prin1 synonyms-list-for-obarray (current-buffer)))))
893 (defun synonyms-define-cache-file ()
894 "Prompt user to define `synonyms-cache-file', unless it is writable."
895 (unless (synonyms-file-writable-p synonyms-cache-file)
896 (while (not (synonyms-file-writable-p synonyms-cache-file))
897 (setq synonyms-cache-file
898 (read-file-name "Cache file: "
899 (expand-file-name (file-name-directory synonyms-file)) nil nil
900 (concat (file-name-nondirectory synonyms-file) ".cache"))))
901 (custom-set-variables (list 'synonyms-cache-file
902 (setq synonyms-cache-file (expand-file-name synonyms-cache-file))
905 (defun synonyms-file-readable-p (file)
906 "Return non-nil if FILE (a string) names a readable file."
907 (and (not (string= "" file)) (file-readable-p file) (not (file-directory-p file))))
909 (defun synonyms-file-writable-p (file)
910 "Return non-nil if FILE (a string) names a writable file."
911 (and (not (string= "" file)) (file-writable-p file) (not (file-directory-p file))))
913 (defun synonyms (&optional arg regexp)
914 "Show synonyms that match a regular expression (e.g. a word or phrase).
915 You are prompted for the regexp. By default, it is the text
916 of the region, if it is active and `transient-mark-mode' is enabled,
917 or the nearest word to the cursor, if not.
919 Option `synonyms-match-more-flag' non-nil means additional thesaurus
920 entries can be matched. This can be more time-consuming. It means
923 1) Input can match parts of synonyms, in addition to whole synonyms.
924 2) All synonyms are shown, even if input matches a thesaurus entry.
926 Option `synonyms-append-result-flag' non-nil means to append search
927 result to previous results.
929 A prefix argument toggles the meaning of each of those options for the
930 duration of the command:
932 If `C-u' or `C-u C-u', then toggle `synonyms-match-more-flag'.
933 If negative or `C-u C-u', then toggle `synonyms-append-result-flag'.
935 \(`C-u C-u' thus means toggle both options.)
937 When called from Lisp, optional second argument REGEXP is the regexp
938 to match (no prompting)."
940 (synonyms-ensure-synonyms-read-from-cache) ; Fill `synonyms-obarray', for use in completion.
941 (let* ((num-arg (prefix-numeric-value arg))
942 (morep (eq synonyms-match-more-flag (atom arg)))
943 (appendp (eq synonyms-append-result-flag (and (wholenump num-arg)
945 (default-search-text (or regexp (synonyms-default-regexp)))
946 (search-text (or regexp
947 (let ((case-fold-search t)) ; Case-insensitive completion.
949 "Show synonyms for word or phrase (regexp): "
950 synonyms-obarray nil nil nil 'synonyms-history
951 default-search-text)))))
952 (synonyms-action search-text)))
954 (defun synonyms-action (search-text)
955 "Helper function for command `synonyms'.
956 APPENDP and MOREP are free here."
957 (setq synonyms-search-text search-text) ; Save it.
958 (when (string= "" search-text) (error "No text to look up"))
959 (unless (member search-text synonyms-history) (push search-text synonyms-history))
960 ;; Change `.' to `[^,]' in `search-text', so we don't mix terms.
961 (setq search-text (replace-regexp-in-string "\\." "[^,]" search-text nil t))
962 (synonyms-lookup search-text (and (boundp 'appendp) appendp) (and (boundp 'morep) morep)))
965 (defun synonyms-no-read (arg)
966 "Same as command `synonyms', but uses the default input text (regexp)."
968 (let* ((num-arg (prefix-numeric-value arg))
969 (morep (eq synonyms-match-more-flag (atom arg)))
970 (appendp (eq synonyms-append-result-flag (and (wholenump num-arg) (/= 16 num-arg))))
971 (search-text (synonyms-default-regexp)))
972 (setq synonyms-search-text search-text) ; Save it.
973 (when (string= "" search-text) (error "No text to look up"))
974 (unless (member search-text synonyms-history) (push search-text synonyms-history))
975 ;; Change `.' to `[^,]' in `search-text', so we don't mix terms.
976 (setq search-text (replace-regexp-in-string "\\." "[^,]" search-text nil t))
977 (synonyms-lookup search-text appendp morep)))
980 (defun synonyms-match-more ()
981 "Same as using `synonyms' with `synonyms-match-more-flag' = t."
983 (let ((synonyms-match-more-flag t))
987 (defun synonyms-match-more-no-read (arg)
988 "Same as using `synonyms' with `synonyms-match-more-flag' = t."
990 (let ((synonyms-match-more-flag t))
991 (synonyms-no-read arg)))
994 (defun synonyms-append-result ()
995 "Same as using `synonyms' with `synonyms-append-result-flag' = t."
997 (let ((synonyms-append-result-flag t))
1001 (defun synonyms-append-result-no-read (arg)
1002 "Same as using `synonyms' with `synonyms-append-result-flag' = t."
1004 (let ((synonyms-append-result-flag t))
1005 (synonyms-no-read arg)))
1008 (defun synonyms-match-more+append-result ()
1009 "Like `synonyms-match-more-flag' = `synonyms-append-result-flag' = t."
1011 (let ((synonyms-match-more-flag t)
1012 (synonyms-append-result-flag t))
1016 (defun synonyms-match-more+append-result-no-read (arg)
1017 "Like `synonyms-match-more-flag' = `synonyms-append-result-flag' = t."
1019 (let ((synonyms-match-more-flag t)
1020 (synonyms-append-result-flag t))
1021 (synonyms-no-read arg)))
1024 (defun synonyms-mouse (event arg)
1025 "Show synonyms that match a regular expression (e.g. a word or phrase).
1026 The regexp to match is the synonym or region clicked with mouse-2. If
1027 the region is active, but a synonym elsewhere is clicked, that synonym
1028 is used, not the selected text.
1030 You can either click a listed synonym, to see its synonyms, or select
1031 one or more words and click the selection, to see matching synonyms.
1032 To quickly select a series of words: double-click mouse-1 to select
1033 the first word, then click mouse-3 to extend the selection to the last
1036 Selection is useful when you want to see synonyms of a similar term.
1037 For example, instead of clicking the listed synonym `bleeding heart', you
1038 might select `heart' and click that.
1040 The prefix argument acts the same as for command `synonyms'.
1042 If you click a history link with mouse-2, previously retrieved search
1043 results are revisited."
1044 (interactive "e\nP")
1045 (set-buffer (window-buffer (posn-window (event-end event))))
1046 (let ((beg (region-beginning))
1048 (active mark-active))
1049 (goto-char (posn-point (event-end event)))
1050 (cond ((get-text-property (point) 'back-link) (synonyms-history-backward nil))
1051 ((get-text-property (point) 'forward-link) (synonyms-history-forward nil))
1052 (t (if (and active (> (point) beg) (< (point) end))
1054 (deactivate-mark)) ; User did not click inside region, so deactivate it.
1055 (synonyms-no-read arg)))))
1058 (defun synonyms-mouse-match-more (event arg)
1059 "Same as `synonyms-mouse' with `synonyms-match-more-flag' = t."
1060 (interactive "e\nP")
1061 (let ((synonyms-match-more-flag t))
1062 (synonyms-mouse event arg)))
1065 (defun synonyms-mouse-append-result (event arg)
1066 "Same as `synonyms-mouse' with `synonyms-append-result-flag' = t."
1067 (interactive "e\nP")
1068 (let ((synonyms-append-result-flag t))
1069 (synonyms-mouse event arg)))
1072 (defun synonyms-mouse-match-more+append-result (event arg)
1073 "Like `synonyms-match-more-flag' = `synonyms-append-result-flag' = t."
1074 (interactive "e\nP")
1075 (let ((synonyms-match-more-flag t)
1076 (synonyms-append-result-flag t))
1077 (synonyms-mouse event arg)))
1079 (defun synonyms-default-regexp ()
1080 "Return the default regexp for `synonym' and `synonyms-mouse'.
1081 If the region is active in `transient-mark-mode', use its text.
1082 Else, if this is *Synonyms* buffer, use the synonym under the cursor.
1083 Else use the word nearest the cursor.
1085 An active region has no effect except in `transient-mark-mode'."
1086 (if (and mark-active transient-mark-mode) ; Use region text, if active.
1087 (buffer-substring-no-properties (point) (mark))
1088 (if (eq major-mode 'synonyms-mode) ; Use mouse-face text, if in synonyms-mode.
1090 (when (and (not (eobp)) (get-text-property (point) 'mouse-face))
1093 (when (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
1094 (setq end (1- (point))
1097 (synonyms-nearest-word) ; Punt - no mouse-face, for some reason.
1098 (setq beg (previous-single-property-change beg 'mouse-face)
1099 end (or (next-single-property-change end 'mouse-face) (point-max)))
1100 (replace-regexp-in-string ; Replace newlines with spaces, except at the
1101 "\\(^ \\| $\\)" "" ; beginning and end.
1102 (replace-regexp-in-string "[\n]" " " (buffer-substring-no-properties beg end) nil t)
1104 (synonyms-nearest-word))))
1106 (defun synonyms-nearest-word ()
1107 "Word nearest the cursor."
1108 (let ((word (if (fboundp 'word-nearest-point)
1109 (word-nearest-point) ; In `thingatpt+.el'.
1110 (word-at-point)))) ; In `thingatpt.el'.
1111 (set-text-properties 0 (length word) nil word) ; Remove all text properties.
1114 (defun synonyms-lookup (search-text appendp morep)
1115 "Search the thesaurus for SEARCH-TEXT.
1116 APPEND-P non-nil means to append search result to previous results.
1117 MORE-P non-nil means additional thesaurus entries can be matched."
1118 (save-selected-window
1120 (format "Looking up %s synonyms for \"%s\"%s..." (if morep "(max)" "")
1121 (replace-regexp-in-string (regexp-quote "[^,]") "." search-text nil t)
1122 (if appendp " (appending)" ""))
1123 (let ((temp-buf (generate-new-buffer " *Temp*")))
1126 (set-buffer temp-buf)
1127 (buffer-disable-undo) ; Make sure (should already be, because of *Temp* name).
1129 (let ((entry-p (synonyms-search-entries search-text temp-buf morep)))
1130 ;; For `morep' search, we don't stop even if we find an entry.
1132 (or (synonyms-search-synonyms search-text temp-buf t) entry-p)
1133 (or entry-p (synonyms-search-synonyms search-text temp-buf nil)))
1134 (pop synonyms-history) ; Remove it from search history, so we don't try again.
1135 (error "No synonyms found for `%s'" search-text))
1136 (let ((results-buf (get-buffer-create "*Synonyms*")))
1137 (synonyms-format-synonyms search-text morep)
1138 (synonyms-show-synonyms temp-buf results-buf appendp)
1140 (kill-buffer temp-buf))))))
1142 (defun synonyms-search-entries (search-text buf morep)
1143 "Search thesaurus entries (headings) for SEARCH-TEXT.
1144 Put result in buffer BUF.
1145 MORE-P non-nil means additional thesaurus entries can be matched."
1146 (call-process "grep" nil buf nil "-i" (synonyms-hack-backslashes-if-cygwin
1148 (format "^\\w*%s\\w*," search-text)
1149 (format "^%s," search-text)))
1150 (expand-file-name synonyms-file))
1151 (not (zerop (count-lines (point-min) (point-max)))))
1153 (defun synonyms-search-synonyms (search-text buf morep)
1154 "Search thesaurus body for SEARCH-TEXT.
1155 SEARCH-TEXT is a regexp that can match any part of a thesaurus term.
1156 Put result in buffer BUF.
1157 MORE-P non-nil means additional thesaurus entries can be matched."
1158 (call-process "grep" nil buf nil "-i" (synonyms-hack-backslashes-if-cygwin
1160 (format ",\\w*%s\\w*\\(,\\|$\\)" search-text)
1161 (format ",%s\\(,\\|$\\)" search-text)))
1162 (expand-file-name synonyms-file))
1163 (not (zerop (count-lines (point-min) (point-max)))))
1165 (defun synonyms-hack-backslashes-if-cygwin (string)
1166 "Double each backslash in STRING, unless it contains SPC characters.
1167 More precisely, if `synonyms-use-cygwin-flag' is non-nil and this is
1168 Emacs 20 or there are no spaces in STRING, then double any backslashes
1171 This is an ugly hack made necessary because of bugs in Emacs C code."
1172 (when (and synonyms-use-cygwin-flag
1173 (or (= emacs-major-version 20) (not (string-match " " string))))
1174 (setq string (replace-regexp-in-string "[\\]" "\\\\" string nil t)))
1177 (defun synonyms-format-synonyms (search-text morep)
1178 "Format synonyms that match SEARCH-TEXT.
1179 MORE-P non-nil means additional thesaurus entries can be matched."
1180 (goto-char (point-min))
1181 (let ((entries-count (count-lines (point-min) (point-max))))
1182 (if (= entries-count 1)
1183 (synonyms-format-entry search-text t morep)
1184 (synonyms-format-entries search-text entries-count morep))
1185 (synonyms-format-finish search-text morep)))
1187 (defun synonyms-format-entry (search-text single-p morep)
1188 "Format a single thesaurus entry that matches SEARCH-TEXT.
1189 SINGLE-P non-nil means there is only one entry."
1192 (orig (if morep ; Use saved search text.
1193 (format "\\w*\\(%s\\)\\w*" synonyms-search-text)
1194 (format "\\(%s\\)" synonyms-search-text)))
1197 (when single-p (insert "Synonyms for "))
1199 (when (looking-at orig) (setq entry-p t))
1200 (unless (search-forward "," nil t) (error "Bad thesaurus file - no commas"))
1201 (setq end (match-beginning 0))
1202 (replace-match ":\n\n" nil t)
1204 (add-text-properties beg term '(face synonyms-heading))
1205 (add-text-properties term end (if entry-p
1206 '(face synonyms-search-text
1207 mouse-face synonyms-mouse-face)
1208 '(face synonyms-heading)))
1209 (add-text-properties end (+ 2 end) '(face synonyms-heading)))
1211 (add-text-properties beg (1+ end) '(face synonyms-heading))
1215 (narrow-to-region (point) (save-excursion (end-of-line) (backward-char) (point)))
1216 (unless (search-forward ". " nil t)
1217 (error "Badly formatted numeric entry - no period"))
1218 (add-text-properties (point) (point-max) '(mouse-face synonyms-mouse-face))
1219 (when (looking-at orig)
1220 (add-text-properties (match-beginning 1) (match-end 1)
1221 '(face synonyms-search-text)))))))
1224 (defun synonyms-format-entries (search-text entries-count morep)
1225 "Format thesaurus entries that have synonyms matching SEARCH TEXT.
1226 ENTRIES-COUNT is the number of entries.
1227 MORE-P non-nil means additional thesaurus entries can be matched."
1228 (let ((countdown entries-count)
1230 (part1 "Synonyms for ")
1232 (insert part1 synonyms-search-text part2)
1233 (add-text-properties beg (setq beg (+ beg (length part1))) '(face synonyms-heading))
1234 (add-text-properties beg (setq beg (+ beg (length synonyms-search-text)))
1235 '(face synonyms-search-text mouse-face synonyms-mouse-face))
1236 (add-text-properties beg (+ beg (length part2)) '(face synonyms-heading))
1237 (while (> countdown 0)
1238 (setq countdown (1- countdown))
1239 (insert (format "\n\%s. " (- entries-count countdown)))
1240 (synonyms-format-entry search-text nil morep))))
1242 (defun synonyms-format-finish (search-text morep)
1243 "Finish formatting synonyms matching SEARCH-TEXT.
1244 MORE-P non-nil means additional thesaurus entries can be matched."
1245 ;; Put a space after each comma.
1246 (goto-char (point-min))
1247 (forward-line) ; First line might have [^,] in it.
1248 (while (search-forward "," nil t) (replace-match ", " nil t))
1249 (goto-char (point-min))
1250 (let ((case-fold-search t)
1251 (new-search-text (if morep
1252 (format "\\(^\\|, \\)\\w*\\(%s\\)\\w*\\($\\|,\\)" search-text)
1253 (format "\\(^\\|, \\)\\(%s\\)\\($\\|,\\)" search-text)))
1254 (no-numbered-headers-p (not (re-search-forward "^[0-9]+[.]" nil t))))
1255 (goto-char (point-min))
1257 (while (re-search-forward new-search-text nil t)
1258 (add-text-properties (match-beginning 2) (match-end 2) '(face synonyms-search-text))
1259 (goto-char (match-end 2)))
1260 ;; Do `synonyms-mode' here too, so hyphen will be a word char.
1261 ;; IS THERE A WAY TO DO A LET to change the syntax of hyphen, instead of entering mode?
1264 (goto-char (point-min))
1266 (while (re-search-forward "\\(^\\|, \\)\\(\\(\\w\\|[\\t ]\\)+\\)\\($\\|,\\)" nil t)
1267 (add-text-properties (match-beginning 2) (match-end 2) '(mouse-face synonyms-mouse-face))
1268 (goto-char (match-end 2)))
1269 (fill-region (point-min) (point-max)))
1270 (synonyms-add-history-links)))
1272 (defun synonyms-add-history-links ()
1273 "Add Back and Forward chronological navigation links"
1275 (unless (re-search-backward "Synonyms for") (error "No \"Synonyms for\" text"))
1277 (insert (make-string (- fill-column 16 (point)) ?\ ) "[")
1281 (Forward "Forward"))
1283 (add-text-properties beg (point)
1284 '(face synonyms-link mouse-face synonyms-mouse-face back-link t
1285 help-echo "mouse-2, RET: Go backward in synonyms search history"))
1286 (insert spacer Forward)
1287 (add-text-properties (+ beg (length Back) (length spacer)) (point)
1288 '(face synonyms-link mouse-face synonyms-mouse-face forward-link t
1289 help-echo "mouse-2, RET: Go forward in synonyms search history"))
1292 (defun synonyms-show-synonyms (temp-buf results-buf appendp)
1293 "Display search results from buffer TEMP-BUF in buffer RESULTS-BUF.
1294 If APPEND-P is non-nil and RESULTS-BUF is not empty, then insert a
1295 separator line between previous search results and the current results."
1296 (set-buffer results-buf)
1297 (setq buffer-read-only nil)
1298 (unless (= (point-min) (point-max))
1301 (goto-char (point-max))
1302 (let ((beg (point)))
1303 (insert "\n" (make-string (1- (window-width)) ?_) "\n\n\n")
1304 (add-text-properties beg (point) '(face synonyms-heading)))))
1305 (let ((start-result (point)))
1306 (insert-buffer temp-buf)
1307 (select-window (display-buffer results-buf))
1308 (goto-char start-result)
1309 (forward-line 2) ; Put cursor on first synonym.
1310 (when (looking-at "^[0-9]. ") (goto-char (match-end 0)))
1313 (setq buffer-read-only t)))
1316 (defun synonyms-history-backward (arg)
1317 "Run `synonyms' on a previous argument, moving backward in the history.
1318 A prefix argument has the same meaning as for command `synonyms'."
1320 (unless (cdr synonyms-history) (error "Cannot move backward in history"))
1321 (push (pop synonyms-history) synonyms-history-forward) ; Put current on forward list.
1322 (let* ((num-arg (prefix-numeric-value arg))
1323 (morep (eq synonyms-match-more-flag (atom arg)))
1324 (appendp (eq synonyms-append-result-flag (and (wholenump num-arg) (/= 16 num-arg)))))
1326 ;; Visit last. If *Synonyms* has appended search results, go to the previous one, from (point).
1327 (if (not (get-buffer "*Synonyms*"))
1328 (synonyms-action (car synonyms-history))
1329 (let ((divider (with-current-buffer "*Synonyms*" (re-search-backward "^___" nil t))))
1331 (synonyms-action (car synonyms-history))
1332 (set-buffer "*Synonyms*")
1334 (unless (re-search-backward "^Synonyms for \\([^:]+\\):" nil t)
1335 (error "Cannot find previous synonyms page"))
1336 (goto-char (match-beginning 1))
1338 (message "%s" (buffer-substring (match-beginning 1) (match-end 1))))))))
1341 (defun synonyms-history-forward (arg)
1342 "Run `synonyms' on a previous argument, moving forward in the history.
1343 A prefix argument has the same meaning as for command `synonyms'."
1345 (unless synonyms-history-forward (error "Cannot move forward in history"))
1346 (push (pop synonyms-history-forward) synonyms-history) ; Put current on backward list.
1347 (let* ((num-arg (prefix-numeric-value arg))
1348 (morep (eq synonyms-match-more-flag (atom arg)))
1349 (appendp (eq synonyms-append-result-flag (and (wholenump num-arg) (/= 16 num-arg)))))
1351 ;; Visit current. If *Synonyms* has appended search results, go to the next one, from (point).
1352 (if (not (get-buffer "*Synonyms*"))
1353 (synonyms-action (car synonyms-history))
1354 (let ((divider (with-current-buffer "*Synonyms*" (re-search-forward "^___" nil t))))
1356 (synonyms-action (car synonyms-history))
1357 (set-buffer "*Synonyms*")
1359 (unless (re-search-forward "^Synonyms for \\([^:]+\\):" nil t)
1360 (error "Cannot find next synonyms page"))
1361 (goto-char (match-beginning 1))
1363 (message "%s" (buffer-substring (match-beginning 1) (match-end 1))))))))
1366 (defalias 'dictionary-definition 'synonyms-definition)
1368 (defun synonyms-definition (search-text alternate-p)
1369 "Look up the definition of a word or phrase using online dictionaries.
1370 The dictionary used is `synonyms-dictionary-url'.
1371 With prefix arg, look up the definition in the alternate dictionary,
1372 `synonyms-dictionary-alternate-url'."
1373 (interactive (list (completing-read "Look up definition of word or phrase (regexp): "
1374 synonyms-obarray nil nil nil 'synonyms-history
1375 (synonyms-default-regexp))
1376 current-prefix-arg))
1377 (synonyms-ensure-synonyms-read-from-cache) ; Fill `synonyms-obarray', for use in completion.
1378 (browse-url (concat (if alternate-p synonyms-dictionary-alternate-url synonyms-dictionary-url)
1382 (defun synonyms-definition-no-read (alternate-p)
1383 "Look up the definition of a word or phrase using online dictionaries.
1384 The dictionary used is `synonyms-dictionary-url'.
1385 With prefix arg, look up the definition in the alternate dictionary,
1386 `synonyms-dictionary-alternate-url'."
1388 (synonyms-definition (synonyms-default-regexp) alternate-p))
1391 (defun synonyms-definition-mouse (event alternate-p)
1392 "Look up the definition of a word or phrase using online dictionaries.
1393 The dictionary used is `synonyms-dictionary-url'.
1394 With prefix arg, look up the definition in the alternate dictionary,
1395 `synonyms-dictionary-alternate-url'."
1396 (interactive "e\nP")
1397 (set-buffer (window-buffer (posn-window (event-end event))))
1398 (let ((beg (region-beginning))
1400 (active mark-active))
1401 (goto-char (posn-point (event-end event)))
1402 (cond ((get-text-property (point) 'back-link) (synonyms-history-backward nil))
1403 ((get-text-property (point) 'forward-link) (synonyms-history-forward nil))
1404 (t (if (and active (> (point) beg) (< (point) end))
1406 (deactivate-mark)) ; User did not click inside region, so deactivate it.
1407 (synonyms-definition (synonyms-default-regexp) alternate-p)))))
1409 ;;;;;;;;;;;;;;;;;;;;;;;;;
1413 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1414 ;;; synonyms.el ends here