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