* Re: Fly-spelling with multiple dictionaries
2008-04-03 9:47 Fly-spelling with multiple dictionaries Angelo Graziosi
@ 2008-04-03 12:28 ` martin rudalics
2008-04-03 15:32 ` Claus
2008-04-03 13:13 ` Dan Nicolaescu
1 sibling, 1 reply; 42+ messages in thread
From: martin rudalics @ 2008-04-03 12:28 UTC (permalink / raw)
To: Angelo Graziosi; +Cc: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 590 bytes --]
> I would know if in Emacs-23 one can fly-spells using more than a single
> dictionary. For example, I would to fly-spell my docs using italian and
> english dictionaries in parallel.
>
> Is this possible?
"speck" was an attempt to solve this and a couple of other problems I
encountered with flyspell. I didn't do any serious work on this for
more than a year, hence something might have broken in the meantime.
Also, full support for Ispell was never finished, Aspell support is more
reliable, IIRC. If you nevertheless want to give it a try - comments
very appreciated ;-)
[-- Attachment #2: speck.el --]
[-- Type: text/plain, Size: 179613 bytes --]
;;; speck.el --- minor mode for spell checking
;; Copyright (C) 2006 Martin Rudalics
;; Time-stamp: "2008-04-03 14:22:47 martin"
;; Author: Martin Rudalics <rudalics@gmx.at>
;; Keywords: spell checking
;; speck.el is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; speck.el is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;; Commentary:
;; `speck-mode' is a minor mode for "specking" - spell-checking displayed text.
;; Execute the command `speck-mode' to toggle specking all windows showing the
;; current buffer.
;; _____________________________________________________________________________
;;
;;; General options
;; _____________________________________________________________________________
;;
(defgroup speck nil
"Another interface to Aspell and Ispell."
:version "23.1"
:group 'applications)
(defcustom speck-default-checker 'Ispell
;;; (cond
;;; ((locate-file "aspell" exec-path exec-suffixes 'file-executable-p)
;;; 'Aspell)
;;; ((locate-file "ispell" exec-path exec-suffixes 'file-executable-p)
;;; 'Ispell))
"Default spell-checker."
:type '(choice (const :tag "Unspecified" nil)
(const Aspell)
(const Ispell))
:group 'speck)
(defcustom speck-delay 0.5
"Time in seconds to wait before specking.
Start specking after Emacs has been idle for that many seconds."
:type 'number
:group 'speck)
(defcustom speck-pause 0.1
"Time in seconds to pause specking.
Give other timers a chance to run while specking."
:type 'number
:group 'speck)
(defcustom speck-chunk-at-point 'commands
"Whether chunk-at-point should be specked.
chunk-at-point is the contiguous string of non-whitespace characters
following or preceding `point'. If `point' is between two whitespace
characters \(space, tabs, and newlines) chunk-at-point is undefined.
Choices are:
never ..... never speck chunk-at-point.
commands .. do not speck chunk-at-point after executing a command in
`speck-chunk-at-point-commands'.
always .... always speck chunk-at-point."
:type '(choice (const :tag "never" nil)
(const :tag "commands" commands)
(const :tag "always" t))
:group 'speck)
(defcustom speck-chunk-at-point-commands
'(self-insert-command
backward-char forward-char
delete-char delete-backward-char
backward-delete-char-untabify
transpose-chars)
"Commands that inhibit specking chunk-at-point.
This list is consulted iff `speck-chunk-at-point' is set to `commands'."
:type '(repeat (symbol))
:group 'speck)
(defcustom speck-syntactic nil
"Non-nil means highlight misspelled words in comments or strings only.
Options are to highlight text anywhere in the buffer, text in comments
only, text in strings only, or text in comments or strings.
The preferred way to set this option is via a major mode's hook as
(set (make-local-variable 'speck-syntactic) t)"
:type '(choice (const :tag "any" nil)
(const :tag "comments" 'comments)
(const :tag "strings" 'strings)
(const :tag "comments or strings" t))
:group 'speck)
(defcustom speck-face-inhibit-list nil
"List of faces that inhibit specking.
If this list is not empty, a word is not marked as misspelled if the
face text property of its first character contains an element of this
list. The recommended way to set this variable is via a major mode
hook. The following code asserts that in `emacs-lisp-mode' only text
displayed with `font-lock-comment-face' or `font-lock-doc-face' is
marked, while text in `font-lock-constant-face' is never marked as
misspelled.
(add-hook
'emacs-lisp-mode-hook
'(lambda ()
(set (make-local-variable 'speck-syntactic) t)
(set (make-local-variable 'speck-face-inhibit-list)
'(font-lock-string-face font-lock-constant-face))))"
:type '(repeat face)
:group 'speck)
(defcustom speck-doublets t ; DEFAULT to nil
"Non-nil means highlight doublets.
A doublet is the second of two identical symbols (where symbols are
sequences of characters with word or symbol syntax) starting with a word
character and separated by whitespace only. Doublets may not contain
misspelled words and are highlighted with the face `speck-doublet'."
:type 'boolean
:group 'speck)
(defcustom speck-self-insert-inherit 'white ; DEFAULT to nil
"How self-inserting characters inherit speck multi properties.
Speck multi properties specify whether text shall be specked at all and
which dictionary shall be used for specking.
Choices are:
off \(nil) ... use the standard inheritance mechanism which, by
default, inherits any such properties from the preceding charater.
line ... inherit from preceding character unless the character is
inserted at the beginning of a line in which case properties are
inherited from the following character if it exists and is not a
whitespace character.
white ... inherit from preceding character unless there is none or it
is a whitespace character in which case properties are inherited from
the following character unless there is none or it is a whitespace
character.
Whitespace characters in this context are spaces, tabs and newlines,
regardless of what the current `syntax-table' says about them. If no
rule applies the standard inheritance mechanism is used."
:type '(choice (const :tag "off" nil)
(const :tag "line" line)
(const :tag "white" white))
:group 'speck)
(defcustom speck-replace-query t ; DEFAULT to nil
"When non-nil query for further occurrences after correcting a word.
The commands to correct a word are `speck-popup-menu-previous',
`speck-popup-menu-next', `speck-replace-previous' and
`speck-replace-next'."
:type 'boolean
:group 'speck)
(defcustom speck-replace-preserve-point 'within
"Where to move cursor within replaced text.
Options are:
before ... before replaced text
within ... at same offset from begin of or after replaced text
after .... after replaced text"
:type '(choice (const :tag "before" before)
(const :tag "within" within)
(const :tag "after" after))
:group 'speck)
(defcustom speck-lighter t
"When non-nil display a string in the mode-line when specking.
Compare `speck-mode-line-specking' and `speck-mode-line-specked'."
:type 'boolean
:group 'speck)
(defcustom speck-mode-line-specking t
"String displayed in mode-line while specking window.
Should contain a leading space. Selecting \"dictionary\" here means
display the name of the dictionary valid for the character at
`window-point'. If the dictionary for the next self-inserting character
differs from that, display that dictionary first followed by a slash and
the dictionary for the following character. \"--\" or \"==\" mean the
respective character is not specked."
:type '(choice (const :tag "dictionary" t)
string)
:group 'speck)
(defcustom speck-mode-line-specked t
"String displayed in mode-line after window has been specked.
Should contain a leading space. Selecting \"dictionary\" here means
display the name of the dictionary valid for the character at
`window-point'. If the dictionary for the next self-inserting character
differs from that, display that dictionary first followed by a slash and
the dictionary for the following character. \"--\" or \"==\" mean the
respective character is not specked."
:type '(choice (const :tag "dictionary" t)
string)
:group 'speck)
(defun speck-after-change-major-mode ()
;; Customize this eventually ...
(when speck-multi (speck-mode 1)))
(defun speck-add-after-change-major-mode (value)
;; ... and implicitly that.
(add-hook 'after-change-major-mode-hook 'speck-after-change-major-mode))
;; This is no more a constant after
;; `speck-multi-style-turn-on-speck-after-major-mode-change' has become
;; customizable. But I find the auto-turn-on stuff annoying.
(defconst speck-multi-format-alist-entry
'(speck
"Speck multi format"
;; Note: Never anchor the following regexp at BOL. `revert-buffer' may
;; leave the stuff at BOB unchanged and _not_ start searching from BOB.
;; Note too: We allow 12 characters for the `comment-start' sequence here.
;; Change this number if a mode needs it.
".\\{1,12\\}\\(<<speck-bof:speck-\\(eof\\|nil\\)>>\\)"
speck-multi-read
speck-multi-write
nil speck-add-after-change-major-mode t) ; See above ....
"Entry suitable for `format-alist'.
`speck-multi-style' adds/removes this entry to/from `format-alist' ")
(defcustom speck-multi-style 'eof ; Must become nil, eventually. <----
"Style used to write multi-language information to files.
The following choices are available:
None ......... Do not read or write multi-language information.
End of file .. Write multi-language information at end of file.
Standard ..... Intersperse multi-language information with normal text.
When you choose \"None\" no multi-language annotations are read even if
the file contains them. The other two options read annotations as they
are found on the file but differ in the way they write them out. The
\"Standard\" method puts strings \(\"<<speck-foo:\" and \"speck-foo>>\")
around every single stretch of text checked in the language \"foo\". If
these strings might confuse other applications operating on that file,
use the \"End of file\" method which puts all annotations on a single,
commented-out line at the end of the file.
Note 1: Neither \"Standard\" nor \"End of file\" will handle insertion
of parts of files into a buffer correctly. If you want to insert a
subsection of a file containing multi-language information it's strongly
recommended to visit that file in another buffer first and subsequently
yank the desired part(s) to the final target.
Note 2: The \"End of file\" method may fail to install multi-language
information properly if you decode a file differently than you encoded
it. Hence, if you want to preserve multi-language information when
switching to another coding system you should \(temporarily) use the
\"Standard\" method.
Note 3: Setting this option to \"Standard\" or \"End of file\" adds a
suitable entry to `format-alist'. Implicitly, this will add a
\(commented-out) line at file-beginning when writing the buffer to the
visited file. Resetting this option to \"None\" removes the entry from
`format-alist' but doesn't remove the line and the corresponding
annotations from the file until you explicitly save the buffer."
:type '(choice (const :tag "None" nil)
(const :tag "End of file" eof)
(const :tag "Standard" t))
:set #'(lambda (symbol value)
(set-default symbol value)
(setq format-alist
(delete speck-multi-format-alist-entry format-alist))
(when value
(add-to-list 'format-alist speck-multi-format-alist-entry)))
:group 'speck)
(defcustom speck-dictionary-names-alist nil
"List associating a positive integer with a dictionary name.
The option permits to choose the language for `speck-multi-set' by
entering the associated integer as prefix argument.
Do not set up an association for zero or a negative value here since
these are not handled correctly."
:type '(repeat
(cons :format "%v\n"
(integer :format "%v" :size 2)
(string :tag "Dictionary Name:" :format " %t %v\n" :size 5)))
:group 'speck)
(defcustom speck-auto-correct-case nil
"Non-nil means auto-correct case of misspelled word.
Options are:
Never Do not auto-correct case.
Two Auto-correct iff down-casing the second character yields a
correct word.
One Auto-correct if there's a unique correct word differing in
case only.
Always Auto-correct if speck finds a correct word differing in case
only \(not recommended, use \"One\" unless that's too slow
on your system\).
See also `speck-auto-correct-minimum-length'."
:type '(choice (const :tag "Never" nil)
(const :tag "Two" two)
(const :tag "One" one)
(const :tag "Always" t))
:group 'speck)
(defcustom speck-auto-correct-minimum-length 3
"Minimum length of words that should be auto-corrected.
Setting this to zero will attempt to auto-correct all words. If the
\"-W\" option of `ispell-extra-args' provides a larger value than this
there won't be any misspelling and consequently no auto-correction."
:type 'integer
:group 'speck)
(defcustom speck-email-citations "[>}|]"
"Check citations in Email mode.
A value of nil means check citations as any other text. A face value
means don't check text displayed with this face. A regexp means don't
check text when the beginning of the line where it appears matches this
regular expression."
:type '(choice (const :tag "Never" nil)
(face :face "Face" font-lock-comment-face)
(regexp :tag "Regexp" "[>}|]"))
:group 'speck)
(defcustom speck-iso-639-1-alist
'(("bg" . "bulgarian") ("ca" . "catalan") ("cs" . "czech")
("da" . "danish") ("de" . "deutsch") ("de" . "german")
("el" . "greek") ("en" . "english") ("eo" . "esperanto")
("es" . "spanish") ("fi" . "finnish") ("fr" . "francais")
("fr" . "french") ("hu" . "hungarian") ("it" . "italiano")
("it" . "italian") ("la" . "latin") ("nl" . "dutch")
("no" . "norwegian") ("pl" . "polish") ("pt" . "portuguese")
("ro" . "romanian") ("ru" . "russian") ("sh" . "serbo-croatian")
("sk" . "slovak") ("sv" . "swedish") ("tr" . "turkish"))
"List associating ISO-639-1 language codes with language names.
This list should ideally provide associations for all languages handled
by Ispell. The language code is displayed in the mode-line provided
speck-mode finds the appropriate association. Otherwise speck-mode will
display the first two characters of the dictionary name. This list is
not needed for the Aspell interface."
:type '(repeat
(cons :format "%v\n"
(string :format " %v" :size 2)
(string :format " %v" :size 20)))
:group 'speck)
;;; (defcustom speck-mode-hook nil
;;; "Hook run after specking has been turned on or off."
;;; :type 'hook
;;; :group 'speck)
;; _____________________________________________________________________________
;;
;;; Faces
;; _____________________________________________________________________________
;;
(defgroup speck-faces nil
"Faces."
:group 'speck)
(defface speck-guess
'((((class color)) :underline "red")
(t :underline t))
"Face for highlighting misspelled words with guesses."
:group 'speck-faces)
(defface speck-miss
'((((class color)) :underline "orange")
(t :underline t))
"Face for highlighting misspelled words without guesses."
:group 'speck-faces)
(defface speck-doublet
'((((class color)) :underline "brown")
(t :underline t))
"Face for highlighting doublets.
A doublet is the second of two identical symbols (sequences of
characters with word- or symbol syntax) starting with a word charactetr
and separated by whitespace only. Doublets are highlighted iff the
variable `speck-doublets' is non-nil. Symbols containing misspelled
words are not considered doublets."
:group 'speck-faces)
(defface speck-mouse
'((((class color)) :background "thistle")
(t :underline t))
"Face for highlighting misspelled word when the mouse is over it."
:group 'speck-faces)
(defface speck-query
'((((class color)) :background "yellow")
(t :underline t))
"Face for highlighting word in queries."
:group 'speck-faces)
(defface speck-mode-line-specking
'((((class color)) :foreground "orange")
(t nil))
"Face for highlighting `speck-mode-line-specking' string."
:group 'speck)
(defface speck-mode-line-specked
'((((class color)) :foreground "green")
(t nil))
"Face for highlighting `speck-mode-line-specked' string."
:group 'speck)
;; _____________________________________________________________________________
;;
;;; aspell group
;; _____________________________________________________________________________
;;
(defgroup speck-aspell nil
"Aspell related options."
:group 'speck)
;; needs rewrite
(defcustom speck-aspell-program
(locate-file "aspell" exec-path exec-suffixes 'file-executable-p)
"Name of Aspell's executable."
:type 'file
:group 'speck-aspell)
(defcustom speck-aspell-home-dir nil
"Specify directory where personal word lists reside.
Default uses the default proposed by Aspell. File means you have to
explicitly specify the directory where your personal word lists reside."
;;; Current Directory means Aspell shall look for the word lists in the
;;; directory of the file it's checking (doesn't work here).
:type '(choice (const :tag "Default" nil)
(file :tag "File"))
;;; (const :tag "Current Directory" t))
:group 'speck-aspell)
(defcustom speck-personal-dictionary-file nil
"Relative name of personal dictionary file.
If this option is non-nil speck asks Aspell to search for a file of this
name in the directory specified by `speck-aspell-home-dir'. The default
value leaves it to Aspell to determine the name of this file. When
working with multiple dictionaries it seems better to leave this option
alone. Otherwise Aspell won't be able to add a word to the word list
corresponding to the respective dictionary."
:type '(choice (const :tag "Default" nil)
(file :tag "File"))
:group 'speck-aspell)
(defvar speck-aspell-dictionary-directory
(with-temp-buffer
(call-process speck-aspell-program nil t nil "config" "dict-dir")
(car (split-string (buffer-string))))
"Directory where Aspell's dictionaries reside.")
(defvar speck-aspell-data-directory
(with-temp-buffer
(call-process speck-aspell-program nil t nil "config" "data-dir")
(car (split-string (buffer-string))))
"Directory where Aspell's data files reside.")
(defun speck-aspell-dictionary-names ()
"Return list of Aspell's dictionary names."
(split-string
(with-temp-buffer
(call-process speck-aspell-program nil t nil "dicts")
(buffer-substring (point-min) (point-max)))
"[ \t\n\f]" t))
(defvar speck-aspell-dictionary-names (speck-aspell-dictionary-names)
"List of Aspell's dictionary names.")
(defvar speck-aspell-non-dictionary-names nil
"List of dictionary names asked for but not provided by Aspell.")
(defvar speck-aspell-dictionary-names-history (speck-aspell-dictionary-names)
"History of entered Aspell dictionary names.")
(defun speck-aspell-default-dictionary-name ()
"Return name of Aspell's default dictionary."
(with-temp-buffer
(call-process speck-aspell-program nil t nil "config" "lang")
(goto-char (point-min))
(buffer-substring (point-min) (line-end-position))))
;; Elaborate
(defun speck-aspell-aliases ()
"Return alist with known aliases for Aspell's dictionaries."
(let ((alias-files (file-expand-wildcards
(concat speck-aspell-dictionary-directory "/*.alias")))
aliases)
(dolist (alias-file alias-files aliases)
(with-temp-buffer
(insert-file-contents alias-file)
(when (re-search-forward "^add \\([^.]+\\)\\.multi" nil t)
(let* ((alias (file-name-sans-extension
(file-name-nondirectory alias-file)))
(name (match-string-no-properties 1))
(entry (assoc name aliases)))
(if entry
(setcdr entry (cons alias (cdr entry)))
(setq aliases (cons (cons name (list alias)) aliases)))))))))
(defun speck-aspell-charset (name)
"Return Aspell's coding system (aka charset)."
(setq name (if (string-match "\\(^[a-zA-Z]+\\)[_-]" name)
(match-string-no-properties 1 name)
name))
(let ((data-file (concat speck-aspell-data-directory "/" name ".dat")))
(when (file-exists-p data-file)
(with-temp-buffer
(insert-file-contents data-file)
(goto-char (point-min))
(when (re-search-forward "^charset " nil t)
(let ((charset (buffer-substring (match-end 0) (line-end-position))))
(when (string-match "\\(iso\\)\\([^-].*\\)$" charset)
;; iso... should become iso-...
(setq charset
(concat
(match-string-no-properties 1 charset) "-"
(match-string-no-properties 2 charset))))
(intern charset)))))))
(defun speck-aspell-dictionary-names-and-aliases ()
"Return names of all installed Aspell dictionaries with aliases."
(let ((aliases (speck-aspell-aliases))
names)
(dolist (name speck-aspell-dictionary-names)
(setq names
(cons (list name (cdr (assoc name aliases)))
names)))
;; could sort that here
(nreverse names)))
(defcustom speck-aspell-default-dictionary-name
(speck-aspell-default-dictionary-name)
"Name of Aspell default dictionary.
The default dictionary is used for specking a buffer unless you specify
another dictionary via `speck-buffer' or a file-local variable
The list of dictionaries is constructed from the dictionaries installed
in Aspell's dictionary directory (`speck-aspell-dictionary-directory')
by calling `speck-aspell-program'. The standard value is the initial
value provided by Aspell.
In addition to the name of the dictionary we display also its known
aliases (in parentheses)."
:type `(radio
:indent 2
,@(mapcar
(lambda (name)
(list 'const
:format
(concat
"%v"
(when (nth 1 name)
(let ((aliases (car (nth 1 name))))
(dolist (alias (cdr (nth 1 name)) aliases)
(setq aliases (concat aliases ", " alias)))
(concat " (" aliases ")")))
"\n")
(car name)))
(speck-aspell-dictionary-names-and-aliases)))
:group 'speck-aspell)
;; call this language-codes perhaps <-------
(defun speck-aspell-languages ()
"Return list of Aspell's languages."
(let (language languages)
(with-temp-buffer
;; Aspell returns this list sorted alphabetically.
(call-process speck-aspell-program nil t nil "dicts")
(goto-char (point-min))
(while (not (eobp))
;; The first two letters constitute the language code.
(setq language (buffer-substring-no-properties
(point) (+ (point) 2)))
(unless (member language languages)
(push language languages))
(forward-line)))
(nreverse languages)))
(defun speck-aspell-language-options ()
"Return initial value for variable `speck-aspell-language-options'."
(let (options)
(nreverse
(dolist (language (speck-aspell-languages) options)
(push (list
language
(speck-aspell-charset language)
nil
(when (string-match "^de" language) t))
options)))))
(defcustom speck-aspell-language-options (speck-aspell-language-options)
"Aspell language options.
Its value is a list of five entries for each language recognized by
`speck-mode'.
\(1) The two letter ISO-639 language code.
\(2) The coding system for sending text to and receiving text from the
Aspell process.
\(3) A mimimum word length which tells Aspell to ignore words shorter
than that.
\(4) A run-together words entry telling Aspell the maximum number of
words that can be strung together \(where the value t means no limit).
\(5) Extra Arguments passed to Aspell.
Specifying a value of \"None\" \(nil) for \(2)-(4) means do not pass a
value for this option to Aspell."
:type '(repeat
(list :tag "" :format "%v"
(string :tag "Language" :format "%t: %v\n" :size 2)
(choice :tag "Coding System" :format "%t: %[Choice%] %v\n"
(const :tag "None" nil)
(coding-system :tag "Coding System" :size 10 :value utf-8)
;; Leave this in: it might be useful when a user changes
;; this option and installs a new dictionary later.
(const :tag "Aspell" t))
(choice :tag "Minimum Word Length" :format "%t: %[Choice%] %v\n"
(const :tag "None" :format "%t" nil)
(integer :tag "Length" :format "%t: %v " :size 2))
(choice :tag "Run-together Words" :format "%t: %[Choice%] %v\n"
(const :tag "None" :format "%t" nil)
(integer :tag "Maximum Number" :format "Number: %v " :size 2)
(const :tag "Unlimited" :format "%t" t))
(repeat :tag "Extra Arguments"
(string :format "%v\n" :size 40))))
:group 'speck-aspell)
(defcustom speck-aspell-coding-system nil
"Language independent coding system for communicating with Aspell.
`None' means accept the setting from `speck-aspell-language-options'.
Specifying a value here will override those settings. If communication
with Aspell appears broken and the version of Aspell is 0.60 setting
this to `utf-8' might help."
:type '(choice (cons :tag "None" nil)
(coding-system :tag "Coding System" utf-8))
:group 'speck-aspell)
(defcustom speck-aspell-minimum-word-length nil
"Language independent mimimum word length.
`None' means accept the setting from `speck-aspell-language-options'.
Specifying a value here will override those settings."
:type '(choice (cons :tag "None" nil)
(integer :tag "Length" :format "%t: %v " :size 2))
:group 'speck-aspell)
(defcustom speck-aspell-maximum-run-together nil
"Language independent maximum nmber of run-together words.
`None' means accept the setting from `speck-aspell-language-options'.
Specifying a value here will override those settings."
:type '(choice (const :tag "None" :format "%t" nil)
(integer :tag "Maximum Number" :format "Number: %v " :size 2)
(const :tag "Unlimited" :format "%t" t))
:group 'speck-aspell)
(defcustom speck-aspell-extra-arguments nil
"Language independent arguments passed to Aspell process.
These arguments are passed to Aspell regardless of any other arguments.
Language dependent arguments can be supplied by customizing
`speck-aspell-language-options'."
:type '(repeat (string :tag "Argument" :format "%t: %v\n" :size 40))
:group 'speck-aspell)
(defcustom speck-aspell-suggestion-mode "ultra"
"Aspell suggestion mode.
The default value does not pass a suggestion mode to the Aspell process.
On slow systems `Ultra' is recommended. With Aspell 0.60 the method
`Fast' is identical to `Ultra'. You have to \(re-)activate `speck-mode'
for this option to take effect."
:type '(choice (const :tag "None" nil)
(const :tag "Ultra" "ultra")
(const :tag "Fast" "fast")
(const :tag "Normal" "normal")
(const :tag "Slow" "slow")
(const :tag "Bad Spellers" "bad-spellers"))
:group 'speck-aspell)
(defcustom speck-filter-mode 'URL
"Speck filter mode."
:type '(choice
(const None)
(const URL)
(const Email)
(const SGML)
(const TeX))
:group 'speck-aspell)
(make-variable-buffer-local 'speck-filter-mode)
;; _____________________________________________________________________________
;;
;;; files
;; _____________________________________________________________________________
;;
(defgroup speck-save nil
"Saving speck specifications to visited file."
:group 'speck)
(defcustom speck-save-ask 'ask
"Save/restore speck specifications to/from visited file.
When this option equals \"Never\" \(nil) `speck-mode' never saves or
restores specifications. When the option equals \"Ask\" \('ask)
`speck-mode' may ask you once and only once in the lifetime of a buffer
whether specifications shall be saved or restored. When the option is
\"Silently\" \(t) `speck-mode' is allowed to silently save and restore
specifications.
Specifications affected by this option are local words and options, as
well as multi-dictionary properties. Settings for this option override
any existing settings for `speck-save-multi', `speck-save-words' and
`speck-save-options'."
:type '(choice (const :tag "Never" nil)
(const :tag "Ask" ask)
(const :tag "Silently" t))
:group 'speck-save)
;; `speck-save-ask' may be consulted during `insert-file-contents' and should
;; survive any subsequent `kill-all-local-variables'. It will also continue to
;; live after specking has been deactivated in a buffer and is needed when you
;; save or kill the buffer.
(make-variable-buffer-local 'speck-save-ask)
(put 'speck-save-ask 'permanent-local t)
(defvar speck-save-confirmed 'undecided
"Whether saving and restoring has been confirmed.
The purpose of this variable is to ask only once for each buffer whether
specifications shall be saved/restored from/to the visited file. If its
value is nil, `speck-mode' has asked this question and the user said no.
If the value is 'undecided `speck-mode' hasn't asked yet. If the value
is t speck-mode has asked and the user has said yes or the actual value
of`speck-save-ask' allows to save/restore silently. Any value but
undecided can't be changed again during the lifetime of the buffer.")
;; `speck-save-confirmed' may be consulted during `insert-file-contents' and
;; should survive any subsequent `kill-all-local-variables'; otherwise the
;; `speck-save-confirm' question may be asked again and again. It will also
;; continue to live after specking has been deactivated in a buffer and is
;; needed when you save or kill the buffer.
(make-variable-buffer-local 'speck-save-confirmed)
(put 'speck-save-confirmed 'permanent-local t)
(defun speck-save-confirm ()
"Confirm save/restore of specifications to/from file.
This function should ask the user a question once and only once in the
lifetime of a buffer. It asks iff the option `speck-save-ask' is set to
'ask, the buffer is visiting a file, and `speck-mode' has to save or
restore a specification like a local word, option, or text property.
This function should be always called _last_ in conjuncts. Otherwise
you might end up asking the question when it shouldn't be asked."
(or (eq speck-save-confirmed t)
(and speck-save-ask buffer-file-name
speck-save-confirmed ; hence it's yet 'undecided
(setq speck-save-confirmed
(y-or-n-p
"Process buffer-local specifications for specking? ")))))
(defcustom speck-save-permanent 'adjust
"Whether specification changes are permanent.
Specifications affected by this option are those `speck-mode' may save
to file like local words and options or multi-language properties.
If this option is nil, changing such a specification will (1) make the
current buffer appear modified if it was unmodified so far and (2) can
be undone via \\[undo]. Note, however, that if `speck-mode' appends a
word to the Local Words list of a buffer and you manually undo that
addition together with other ones, `speck-mode' will not be aware of
that and continue to consider the word as correct.
If this option is non-nil, changing a specification will not make the
current buffer appear modified and cannot be undone. If this option is
\"adjust\" undoable buffer changes following the affected Local section
are adjusted properly so that undoing them later is done correctly."
:type '(choice (const nil)
(const t)
(const :tag "adjust" 'adjust))
:group 'speck-save)
;; Must be buffer-local.
(make-variable-buffer-local 'speck-save-permanent)
(defcustom speck-save-words t
"Non-nil means save and restore word lists from and to file.
Speck permits to save word lists to the file visited by a buffer and
restore these lists when you visit the file again. For this purpose
words are inserted in the Local Words Section \(LWS) of the file. The
LWS is usually located near the end of the file \(but _before_ any other
\"Local\" section. When this option is t and you activate `speck-mode'
it will search for a line matching `speck-save-words-regexp' within 3000
characters from the end of the buffer and process this and all preceding
lines matching that expression. Word lists are saved according to the
actual setting of `speck-save-permanent'.
When this option is nil, local words are not restored and/or saved. Any
LWS present on the file remains unaffected. Observe that this option is
respected iff `speck-save-ask' does not equal \"Never\" \(nil)."
:type 'boolean
:group 'speck-save)
(defcustom speck-save-words-regexp
"LocalWords\\|Local Words"
"Regexp for buffer local word list.
The regexp must match within 3000 characters from the end of the buffer.
Ispell looks by default for \"LocalWords: \".
`speck-mode' automatically adds a colon at the end of this. For
dictionary specific word lists it also searches for a dictionary code
enclosed in parentheses and the colon."
:type 'regexp
:group 'speck-save)
(defcustom speck-save-words-string
"Local Words"
"String inserted before members of buffer local word list.
The value specified here will be used unless an entry with another value
matched by `speck-save-words-regexp' is on the file. `ispell' inserts
by default \"LocalWords: \".
`speck-mode' automatically adds a colon at the end of this. For
dictionary specific word lists it adds a space, the dictionary code
within parentheses, and the colon."
:type 'string
:group 'speck-save)
(defcustom speck-save-options t
"Non-nil means save and restore options from and to file.
Speck permits to save options like the current dictionary or filter mode
to the file visited by a buffer and restore these options buffer-locally
lists when you visit the file again. For this purpose options are
inserted in the file after any Local Words Section \(LWS) but before any
Local Variables section of the file. When you activate `speck-mode' it
will search for options within 3000 characters from the end of the
buffer and restore all options it finds in this area.
When this option is nil options are never processed and/or saved. Any
options present on the file remain unaffected. This option is ignored
when `speck-save-ask' equals \"Never\" \(nil)."
:type 'boolean
:group 'speck-save)
(defcustom speck-save-dictionary-regexp
"Local IspellDict:\\|Local Dictionary:"
"Regexp for buffer local dictionary."
:type 'regexp
:group 'speck-save)
(defcustom speck-save-dictionary-string
"Local Dictionary:"
"String for buffer local dictionary."
:type 'string
:group 'speck-save)
(defvar speck-saved-dictionary nil
"When non-nil dictionary to be saved before killing the buffer.")
(make-variable-buffer-local 'speck-saved-dictionary)
(defcustom speck-save-filter-mode-regexp
"Local IspellParsing:\\|Local Filter Mode:"
"Regexp for buffer local mode filter."
:type 'regexp
:group 'speck-save)
(defcustom speck-save-filter-mode-string
"Local Filter Mode:"
"String for buffer local mode filter."
:type 'string
:group 'speck-save)
(defvar speck-saved-filter-mode nil
"Non-nil when filter mode shall be saved before killing the buffer.")
(make-variable-buffer-local 'speck-saved-filter-mode)
(defvar speck-kill-buffer-query-list nil
"List of buffers that must be queried before killing.")
(defvar speck-kill-buffer-query nil
"Whether we must query the user when this buffer is killed.")
(make-variable-buffer-local 'speck-kill-buffer-query)
;; _____________________________________________________________________________
;;
;;; Keymaps
;; _____________________________________________________________________________
;;
(defun speck-make-mode-map (map)
"Assign `speck-mode-keys' to MAP which should be `speck-mode-map'."
(when (boundp 'speck-mode-keys)
(define-key map (nth 0 speck-mode-keys) 'speck-popup-menu-previous)
(define-key map (nth 1 speck-mode-keys) 'speck-popup-menu-next)
(define-key map (nth 2 speck-mode-keys) 'speck-replace-previous)
(define-key map (nth 3 speck-mode-keys) 'speck-replace-next)
(define-key map (nth 4 speck-mode-keys) 'speck-add-previous)
(define-key map (nth 5 speck-mode-keys) 'speck-add-next)
(define-key map (nth 6 speck-mode-keys) 'speck-region)
(define-key map (nth 7 speck-mode-keys) 'speck-change-aspell-dictionary)
(define-key map (nth 8 speck-mode-keys) 'speck-multi-set)
(define-key map (nth 9 speck-mode-keys) 'speck-set-filter-mode)))
(defvar speck-mode-map
(let ((map (make-sparse-keymap)))
(speck-make-mode-map map)
map)
"Keymap used by `speck-mode'. `speck-make-mode-map' fills it.")
(defcustom speck-mode-keys
'([(control ?\.)] [(control meta ?\.)]
[(control ?\,)] [(control meta ?\,)]
[(control ?\+)] [(control meta ?\+)]
[(control ?\!)] [(control meta ?\!)]
[(control ?\?)] [(control meta ?\?)])
"Keys used by `speck-mode'."
:type
'(list
(key-sequence
:tag "Popup menu at previous word" :format "\n %t %v\n\n"
:value '[(control ?\.)] :size 20)
(key-sequence
:tag "Popup menu at next word " :format " %t %v\n\n"
:value '[(control meta ?\.)] :size 20)
(key-sequence
:tag "Replace previous word " :format " %t %v\n\n"
:value '[(control ?\,)] :size 20)
(key-sequence
:tag "Replace next word " :format " %t %v\n\n"
:value '[(control meta ?\,)] :size 20)
(key-sequence
:tag "Accept previous word " :format " %t %v\n\n"
:value '[(control ?\+)] :size 20)
(key-sequence
:tag "Accept next word " :format " %t %v\n\n"
:value '[(control meta ?\+)] :size 20)
(key-sequence
:tag "Spell-check region " :format " %t %v\n\n"
:value '[(control ?\!)] :size 20)
(key-sequence
:tag "Change dictionary " :format " %t %v\n\n"
:value '[(control meta ?\!)] :size 20)
(key-sequence
:tag "Set language " :format " %t %v\n\n"
:value '[(control ?\?)] :size 20)
(key-sequence
:tag "Set option " :format " %t %v\n\n"
:value '[(control meta ?\?)] :size 20))
:set #'(lambda (symbol value)
(when (and (boundp 'speck-mode-map)
;; Paranoia.
(boundp 'speck-mode-keys)
(listp speck-mode-keys))
(dolist (key speck-mode-keys)
(define-key speck-mode-map key nil)))
(set-default symbol value)
(when (boundp 'speck-mode-map)
(speck-make-mode-map speck-mode-map)))
:group 'speck)
(defun speck-assign-keys-to-map (map keys)
"Assign KEYS to MAP.
MAP must be a keymap, KEYS a list of (command . key) pairs."
(dolist (pair keys)
(define-key map (cdr pair) (car pair))))
(defcustom speck-replace-keys
'((help . [(control ?\?)])
(help . [(control ?\h)])
(help . [f1])
(help . [help])
(accept . [(control ?\!)])
(accept-and-quit . [(control ?\.)])
(reject-and-quit . [(control ?\-)])
(reject-and-quit . [(control ?\g)])
(reject-and-quit . [(control ?\])])
(reject-and-quit . [escape])
(forward . [(control ?\,)])
(backward . [(control meta ?\,)]))
"Keys used by `speck-mode' during replacement."
:type
'(repeat
(cons :format "%v"
(choice :format " %[Command%] %v"
(const :format "help " help)
(const :format "accept " accept)
(const :format "accept-and-quit" accept-and-quit)
(const :format "reject-and-quit" reject-and-quit)
(const :format "forward " forward)
(const :format "backward " backward))
(key-sequence :format " Key: %v\n\n" :size 20)))
:set #'(lambda (symbol value)
;; Don't "and" these.
(when (boundp 'speck-replace-map)
(when (boundp 'speck-replace-keys)
(dolist (pair speck-replace-keys)
;; Reset them all.
(define-key speck-replace-map (cdr pair) nil))))
(set-default symbol value)
(when (boundp 'speck-replace-map)
(speck-assign-keys-to-map speck-replace-map speck-replace-keys)))
:group 'speck)
(defvar speck-replace-map
(let ((map (make-sparse-keymap)))
(speck-assign-keys-to-map map speck-replace-keys)
map)
"Dummy keymap for `speck-replace'.")
(defcustom speck-replace-query-keys
'((help . [(control ?\?)])
(help . [(control ?\h)])
(help . [f1])
(help . [help])
(accept . [(control ?\!)])
(accept . [?\ ])
(accept . [return])
(accept-and-quit . [(control ?\.)])
(reject . [(control ?\-)])
(reject-and-quit . [(control ?\g)])
(reject-and-quit . [(control ?\])])
(reject-and-quit . [escape])
(forward . [(control ?\,)])
(forward . [tab])
(backward . [(control meta ?\,)])
(backward . [(shift tab)]))
"Keys used by `speck-mode' during query replacement."
:type
'(repeat
(cons :format "%v"
(choice :format " %[Command%] %v"
(const :format "help " help)
(const :format "accept " accept)
(const :format "accept-and-quit" accept-and-quit)
(const :format "reject " reject)
(const :format "reject-and-quit" reject-and-quit)
(const :format "forward " forward)
(const :format "backward " backward))
(key-sequence :format " Key: %v\n\n" :size 20)))
:set #'(lambda (symbol value)
;; Don't "and" these.
(when (boundp 'speck-replace-query-map)
(when (boundp 'speck-replace-query-keys)
(dolist (pair speck-replace-query-keys)
;; Reset them all.
(define-key speck-replace-query-map (cdr pair) nil))))
(set-default symbol value)
(when (boundp 'speck-replace-query-map)
(speck-assign-keys-to-map
speck-replace-query-map speck-replace-query-keys)))
:group 'speck)
(defvar speck-replace-query-map
(let ((map (make-sparse-keymap)))
(speck-assign-keys-to-map map speck-replace-query-keys)
map)
"Dummy keymap for `speck-replace-query'.")
(add-to-list 'text-property-default-nonsticky '(specked . t))
(defvar speck-delay-timer nil)
(defvar speck-pause-timer nil)
(defvar speck-buffer-list nil
"List of buffers managed by speck-mode.")
(defvar speck-window-list nil
"List of windows that should be specked.")
(defvar speck-stop nil
"Non-nil when input has arrived during specking.")
(defvar speck-break nil
"Break specking window when this is non-nil.")
(defvar speck-multi nil
"Non-nil means check for multiple languages.")
;; `speck-multi' may be set during `insert-file-contents' and must survive any
;; subsequent `kill-all-local-variables' when a major mode is chosen; therefore
;; it must be `permanent-local'. It will also continue to live after specking
;; has been deactivated in a buffer and is needed when you save or kill the
;; buffer.
(make-variable-buffer-local 'speck-multi)
(put 'speck-multi 'permanent-local t)
(defvar speck-ppss-at nil) ; <------------------------- from here --------
(defvar speck-ppss nil)
(defvar speck-nospeck-buffer nil
"Buffer where specking the word at `point' is suspended.
When Emacs is idle and this variable is non-nil it must denote the
current buffer. Note: The value of `speck-nospeck-at' is considered
meaningful iff this is non-nil.")
(defvar speck-nospeck-at nil
"Value of `window-point' during suspension of speck.")
(defvar speck-suspension-list nil
"List of windows where specking is suspended.
A window is on this list when everything but the word around `point' is
specked, and `speck-chunk-at-point' settings inhibit further specking.
This avoids that `speck-window' gets executed over and over without any
progress thus needlessly wasting resources. Invariantly, when Emacs is
idle, any window on this list must show the current buffer.
A window is put on this list by `speck-window' and removed by
`speck-desuspend' which is called by `pre-command-hook'.")
(defvar speck-marker (make-marker)
"Marker used during querying.")
(defvar speck-marker-window nil
"Window where `speck-marker' was set.")
(defvar speck-replace-history ()
"Speck replacements history.")
(defvar speck-dictionary nil
"Default dictionary used for specking this buffer (a symbol).")
(make-variable-buffer-local 'speck-dictionary)
(defvar speck-process nil
"Spell-checking process associated with current buffer.")
(make-variable-buffer-local 'speck-process)
(defvar speck-process-argument-alist nil
"List associating each speck process with its arguments.
The key of each element of this list is a process. The value of an
element is the list of arguments supplied when calling the process.
When `speck-start-process' is called it checks whether a process with
the supplied arguments exists already. If such a process exists it will
reuse that process rather than starting a new one.")
(defvar speck-process-buffer-alist nil
"List associating each speck process with the buffers that use it.
The key of each element of this list is a process. The value is a list
of buffers sharing that process. Whenever `speck-start-process' decides
that it may reuse a running process it appends the current buffer to the
value for that process. Otherwise it creates a new process and entry.
When the list of buffers associated with a process becomes empty that
process is eventually deleted.
Note: The buffers on this list are the \"normal\" buffers whose spelling
is checked, not the process buffers.")
(defvar speck-process-dictionary-alist nil
"List associating each speck process with a dictionary.
The key of each element of this list is a process. The value is the
dictionary supplied when calling the process.
This variable is buffer-local for the following reason: All text regions
of a buffer with a given dictionary text-property share the same process
since we do not recognize any other text-property. Hence to find out
whether a process for a dictionary text-property exists, we search for
an association in this list first.")
(make-variable-buffer-local 'speck-process-dictionary-alist)
(defvar speck-hash-table nil
"The local hash-table for this buffer.")
(make-variable-buffer-local 'speck-hash-table)
(defvar speck-multi-pre-property nil
"Variable holding multi property for next command.")
(defvar speck-multi-post-property nil
"Variable holding multi property for this command.")
(defvar speck-retain-local-variables nil
"Non-nil means activating speck should retain local variables.
Bound locally by `speck-buffer' and `speck-filter-mode'.")
;; _____________________________________________________________________________
;;
;;; macro
;; _____________________________________________________________________________
;;
(eval-when-compile
(require 'cl)
(defmacro with-buffer-unmodified (&rest body)
"Eval BODY, preserving the current buffer's modified state."
(declare (debug t))
(let ((modified (make-symbol "modified")))
`(let ((,modified (buffer-modified-p)))
(unwind-protect
(progn ,@body)
(unless ,modified
(restore-buffer-modified-p nil))))))
;; Save match-data maybe .............
(defmacro with-buffer-prepared-for-specking (&rest body)
"Execute BODY in current buffer, overriding several variables.
Preserves the `buffer-modified-p' state of the current buffer."
(declare (debug t))
`(with-buffer-unmodified
(let ((buffer-undo-list t)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
(inhibit-modification-hooks t)
(inhibit-field-text-motion t)
first-change-hook after-change-functions
deactivate-mark buffer-file-name buffer-file-truename)
,@body))))
;; _____________________________________________________________________________
;;
;;; mode
;; _____________________________________________________________________________
;;
(defun speck-lighter ()
"Speck lighter."
(let (prop prop-insert)
(propertize
(if (stringp speck-mode-line-specking)
speck-mode-line-specking
(setq prop (or (speck-get-speck (window-point))
speck-dictionary))
(setq prop-insert
(cond
((and speck-self-insert-inherit
(not (eobp))
(not (memq (char-after) '(?\ ?\n ?\t)))
(or (bobp)
(and (eq speck-self-insert-inherit 'line)
(eq (char-before) ?\n))
(and (eq speck-self-insert-inherit 'white)
(memq (char-before) '(?\ ?\n ?\t)))))
(speck-get-speck (point)))
((not (bobp))
;; People should not change the stickyness of the speck property.
(or (speck-get-speck (1- (point)))
speck-dictionary))))
(concat
" ["
(when (and prop-insert (not (eq prop prop-insert)))
(concat (symbol-name prop-insert) "/"))
(symbol-name (or prop speck-dictionary))
"]"))
'face (if (memq (selected-window) speck-window-list)
'speck-mode-line-specking
'speck-mode-line-specked))))
;;;###autoload
(define-minor-mode speck-mode
"Toggle `speck-mode'.
With prefix ARG, turn speck-mode on if and only if ARG is positive.
Turning on speck-mode will spell-check (\"speck\") all windows showing
the current buffer.
Global bindings \(customizable via `speck-mode-keys').
\\{speck-mode-map}"
:group 'speck
:init-value nil
:lighter (:eval (when speck-lighter (speck-lighter)))
:keymap speck-mode-map
:require 'speck
(if speck-mode
(speck-activate)
(speck-deactivate)))
;;;###autoload
(defun speck-buffer (&optional arg)
"Toggle `speck-mode' for current buffer.
With non-numeric prefix argument ARG prompt for \(new) dictionary. With
prefix argument ARG zero use the default dictionary. With ARG any other
number use the corresponding entry from `speck-dictionary-names-alist'."
(interactive "P")
(require 'speck)
(cond
((not arg)
;; With no argument toggle `speck-mode' respecting any existing value for
;; (file-)local dictionary.
(if speck-mode
(speck-mode 0)
(speck-mode 1)))
((not (numberp arg))
;; With non-numeric argument prompt for dictionary, this may override
;; any existing (file-)local value for `speck-dictionary'.
(let* ((dictionary-names
(cond
((eq speck-default-checker 'Aspell)
speck-aspell-dictionary-names)
((eq speck-default-checker 'Ispell)
speck-ispell-dictionary-names)))
(dictionary-names-history
(cond
((eq speck-default-checker 'Aspell)
speck-aspell-dictionary-names-history)
((eq speck-default-checker 'Ispell)
speck-ispell-dictionary-names-history)))
(dictionary-name
(completing-read
(concat
"Enter " (when speck-mode "new ")
"dictionary name (RET for default, SPC to complete): ")
(mapcar 'list (cons "default" dictionary-names))
nil t nil 'dictionary-names-history))
(default-dictionary-name
(cond
((eq speck-default-checker 'Aspell)
speck-aspell-default-dictionary-name)
((eq speck-default-checker 'Ispell)
speck-ispell-default-dictionary-name)))
dictionary)
(if (or (string-equal dictionary-name "")
(string-equal dictionary-name "default"))
(setq dictionary (intern default-dictionary-name))
(setq dictionary (intern dictionary-name)))
(if speck-mode
;; Retain all local variable values but that of `speck-dictionary'.
(if (eq dictionary speck-dictionary)
(message "Dictionary \"%s\" unchanged" dictionary)
(speck-deactivate)
(setq speck-dictionary dictionary)
(let ((speck-retain-local-variables t))
(speck-mode)))
(setq speck-dictionary dictionary)
(speck-mode))))
((zerop arg)
;; With argument zero force use of default dictionary (may override
;; file-local value).
(let ((dictionary
(cond
((eq speck-default-checker 'Aspell)
(intern speck-aspell-default-dictionary-name))
((eq speck-default-checker 'Ispell)
(intern speck-ispell-default-dictionary-name)))))
(if speck-mode
(if (eq dictionary speck-dictionary)
(message "Dictionary \"%s\" unchanged" dictionary)
(speck-deactivate)
(setq speck-dictionary dictionary)
(let ((speck-retain-local-variables t))
(speck-mode)))
(setq speck-dictionary dictionary)
(speck-mode))))
(t
;; With any other argument try association list (may override file-local
;; value).
(let* ((association (assoc arg speck-dictionary-names-alist))
(dictionary-name (when association (cdr association)))
(dictionary (intern dictionary-name))
(dictionary-names
(cond
((eq speck-default-checker 'Aspell)
speck-aspell-dictionary-names)
((eq speck-default-checker 'Ispell)
speck-ispell-dictionary-names))))
(if dictionary
(if (member dictionary-name dictionary-names)
(if speck-mode
(if (eq dictionary speck-dictionary)
(message "Dictionary \"%s\" unchanged" dictionary)
(speck-deactivate)
(setq speck-dictionary dictionary)
(let ((speck-retain-local-variables t))
(speck-mode)))
(setq speck-dictionary dictionary)
(speck-mode))
(message "No such dictionary \"%s\"" dictionary-name))
(message "No association for argument \"%s\"" arg))))))
(defun speck-activate ()
"Activate specking for current buffer."
(save-restriction
(widen)
;; Remove text properties and overlays (paranoia).
(with-buffer-prepared-for-specking
(speck-remove-property (point-min) (point-max)))
(speck-delete-overlays))
(unless speck-retain-local-variables
;; Confirmation. We may set this iff it has not been already set to avoid
;; that user gets asked twice.
(unless (local-variable-p 'speck-save-confirmed)
(setq speck-save-confirmed
(or (eq speck-save-ask t) 'undecided)))
;; Install hash-table first `speck-restore-words' may fill it afterwards.
(setq speck-hash-table nil)
;; Local Words:
(when (and speck-save-ask speck-save-words) (speck-restore-words))
;; Local Options.
(when (and speck-save-ask speck-save-options) (speck-restore-options)))
(unless (and (local-variable-p 'speck-dictionary) speck-dictionary)
(setq speck-dictionary
(or speck-saved-dictionary ; Saved value.
(cond
((eq speck-default-checker 'Aspell)
(intern speck-aspell-default-dictionary-name))
((eq speck-default-checker 'Ispell)
(intern speck-ispell-default-dictionary-name))))))
(setq speck-saved-dictionary speck-dictionary)
;; Filter-mode.
(unless (local-variable-p 'speck-filter-mode)
(setq speck-filter-mode
;; Use either saved or default value.
(or speck-saved-filter-mode speck-filter-mode)))
(setq speck-saved-filter-mode speck-filter-mode)
(when (eq speck-filter-mode 'Email)
;; Set up regions in Email mode.
(speck-email-region))
;; Inform user.
(if (eq speck-filter-mode 'None)
(message "Using dictionary \"%s\"" speck-dictionary)
(message "Using dictionary \"%s\" and filter \"%s\""
speck-dictionary speck-filter-mode))
(setq speck-process-dictionary-alist nil)
;; Start `speck-process'.
(speck-start-process)
;; Set mode variable, is this needed ????
(set (make-local-variable 'speck-mode) t)
;; Add current buffer to speck's buffers.
(unless (memq (current-buffer) speck-buffer-list)
(setq speck-buffer-list
(cons (current-buffer) speck-buffer-list)))
;; Add all windows showing current buffer to speck's windows.
(dolist (window (get-buffer-window-list (current-buffer) t))
(speck-window-add window))
;; Add buffer-local hooks
(add-hook 'after-change-functions 'speck-after-change nil t)
(add-hook 'window-scroll-functions 'speck-window-change nil t)
(add-hook 'before-revert-hook 'speck-before-revert nil t)
(add-hook 'after-save-hook 'speck-after-save nil t)
;; The following two are mainly useful for deleting speck's processes.
(add-hook 'change-major-mode-hook 'speck-deactivate nil t)
(add-hook 'after-change-major-mode-hook 'speck-after-change-major-mode nil t)
(add-hook 'kill-buffer-hook 'speck-deactivate nil t)
;; Add global hooks. The `window-size-change-functions' stuff should be
;; covered by `speck-configuration-change' but leave it in for now.
(add-hook 'window-size-change-functions 'speck-frame-change)
(add-hook 'window-configuration-change-hook 'speck-configuration-change)
(add-hook 'redisplay-end-trigger-functions 'speck-redisplay-end-trigger)
;; Activate `speck-delay-timer' - an idle timer called each time Emacs has
;; been idle for `speck-delay' seconds.
(unless speck-delay-timer
(setq speck-delay-timer
(run-with-idle-timer speck-delay t 'speck-windows)))
;; Create `speck-pause-timer' - an idle timer called iff Emacs has been idle
;; for `speck-pause' seconds. This timer is activated in `speck-windows'.
(unless speck-pause-timer
(setq speck-pause-timer (timer-create))
(timer-set-function speck-pause-timer 'speck-windows '(t)))
;; Reset `speck-suspension-list'.
(setq speck-suspension-list nil))
(defun speck-deactivate ()
"Deactivate specking for current buffer."
(when speck-process ; <------ somehow we have to delete all processes <-----
;; Delete process. This is the main reason why `speck-deactivate' is on
;; `kill-buffer-hook'.
(speck-delete-process)
(setq speck-process nil))
(setq speck-mode nil)
;; Remove current buffer from speck's buffers.
(setq speck-buffer-list (delq (current-buffer) speck-buffer-list))
;; Remove all windows showing current buffer from speck's windows.
(dolist (window (get-buffer-window-list (current-buffer)))
(speck-window-remove window))
;; Remove text properties and overlays.
(save-restriction
(widen)
(with-buffer-prepared-for-specking
(speck-remove-property (point-min) (point-max)))
(speck-delete-overlays))
;; Remove buffer-local hooks.
(remove-hook 'after-change-functions 'speck-after-change t)
(remove-hook 'window-scroll-functions 'speck-window-change t)
(remove-hook 'before-revert-hook 'speck-before-revert t)
(remove-hook 'after-save-hook 'speck-after-save t)
(remove-hook 'change-major-mode-hook 'speck-deactivate t)
(remove-hook 'after-change-major-mode-hook 'speck-after-change-major-mode t)
(remove-hook 'kill-buffer-hook 'speck-deactivate t)
;; Remove global hooks and timers iff `speck-buffer-list' has become empty.
(unless speck-buffer-list
;; Remove global hooks.
(remove-hook 'window-size-change-functions 'speck-frame-change)
(remove-hook 'window-configuration-change-hook 'speck-configuration-change)
(remove-hook 'redisplay-end-trigger-functions 'speck-redisplay-end-trigger)
;; Cancel `speck-delay-timer'.
(when speck-delay-timer
(cancel-timer speck-delay-timer)
(setq speck-delay-timer nil))
;; Cancel `speck-pause-timer'.
(when speck-pause-timer
(cancel-timer speck-pause-timer)
(setq speck-pause-timer nil)))
;;; (run-hooks 'speck-mode-hook)
(message "Speck-mode turned off"))
;; _____________________________________________________________________________
;;
;;; utility functions
;; _____________________________________________________________________________
;;
(defun speck-window-add (window)
"Add WINDOW to `speck-window-list'."
(unless (memq window speck-window-list)
(with-current-buffer (window-buffer window)
(when speck-mode
(setq speck-window-list
(cons window speck-window-list))
(force-mode-line-update)))))
(defun speck-window-remove (window)
"Remove WINDOW from `speck-window-list'."
(setq speck-window-list
(delq window speck-window-list))
(force-mode-line-update))
(defun speck-marker-goto ()
"Go to `speck-marker' and make it nil."
(when (and (markerp speck-marker) (marker-position speck-marker)
(window-live-p speck-marker-window))
(select-window speck-marker-window)
(goto-char speck-marker)
(set-marker speck-marker nil)))
;; _____________________________________________________________________________
;;
;;; overlays
;; _____________________________________________________________________________
;;
(defvar speck-overlay-map
(let ((map (make-sparse-keymap)))
(define-key map [down-mouse-3] 'speck-mouse-popup-menu)
map)
"Speck mouse map.")
(defun speck-make-overlay (from to face)
"Highlight region from FROM to TO with face FACE."
(let ((overlay (make-overlay from to)))
(overlay-put overlay 'specky t)
(overlay-put overlay 'face face)
(when (memq face '(speck-guess speck-miss))
(overlay-put overlay 'keymap speck-overlay-map)
;; No help-echo here since I don't know in advance which key
;; `speck-mouse-popup-menu' is bound to.
(overlay-put overlay 'mouse-face 'speck-mouse))
(setq speck-break t)))
(defun speck-delete-overlays (&optional beg end)
"Delete all speck overlays overlapping the region."
(unless beg (setq beg (point-min)))
(unless end (setq end (point-max)))
(when (< end beg) (setq beg (prog1 end (setq end beg))))
(save-excursion
(overlay-recenter end)
;; The following is not overl(a)y fast.
(dolist (overlay (overlays-in beg end))
(when (overlay-get overlay 'specky)
(delete-overlay overlay)))))
(defun speck-delete-doublet-overlays (&optional beg end)
"Delete all speck overlays overlapping the region."
(unless beg (setq beg (point-min)))
(unless end (setq end (point-max)))
(when (< end beg) (setq beg (prog1 end (setq end beg))))
(save-excursion
(overlay-recenter end)
;; The following is not overl(a)y fast.
(dolist (overlay (overlays-in beg end))
(when (eq (overlay-get overlay 'face) 'speck-doublet)
(delete-overlay overlay)))))
(defun speck-overlay-at-point (&optional at faces)
"Return speck overlay at point.
Optional argument AT non-nil means return overlay at position AT.
Optional argument FACES non-nil means return overlay iff it has a face
property in that list."
(setq at (or at (point)))
(let ((overlay (cdr (get-char-property-and-overlay at 'specky))))
(when (or (not faces)
(and overlay (memq (overlay-get overlay 'face) faces)))
overlay)))
(defun speck-next-overlay (&optional arg faces)
"Get first speck overlay ending after `point'.
Optional argument ARG non-nil means return ARGth overlay after `point'.
Optional argument FACES non-nil means return overlay iff it has a face
property in that list."
(save-excursion
(setq arg (or arg 1))
(let ((overlay (speck-overlay-at-point nil faces)))
(unless (and overlay
(or (= arg 1)
(progn
(setq arg (1- arg))
(goto-char (overlay-end overlay))
(setq overlay nil))))
(save-restriction
(narrow-to-region (point) (window-end))
(while (and (not overlay) (< (point) (point-max)) (>= arg 0))
(goto-char (next-overlay-change (point)))
(setq overlay (speck-overlay-at-point nil faces))
(when (and overlay (> arg 1))
(setq overlay nil)
(setq arg (1- arg))))))
overlay)))
(defun speck-previous-overlay (&optional arg faces)
"Get first speck overlay starting before `point'.
Optional argument ARG non-nil means return ARGth overlay before `point'.
Optional argument FACES non-nil means return overlay iff it has a face
property in that list."
(save-excursion
(setq arg (or arg 1))
(let ((overlay (speck-overlay-at-point nil faces)))
(unless (and overlay
(or (< (overlay-start overlay) (point))
(setq overlay nil))
(or (= arg 1)
(progn
(setq arg (1- arg))
(goto-char (overlay-start overlay))
(setq overlay nil))))
(save-restriction
(narrow-to-region (window-start) (point))
(while (and (not overlay) (> (point) (point-min)) (>= arg 0))
(goto-char (previous-overlay-change (point)))
(setq overlay (speck-overlay-at-point nil faces))
(when (and overlay (> arg 1))
(setq overlay nil)
(setq arg (1- arg))))))
overlay)))
;; _____________________________________________________________________________
;;
;;; hooks
;; _____________________________________________________________________________
;;
(defvar speck-auto-correct-after-change t)
;;; (defun remove-single-text-property (start end prop value &optional object)
;;; "Remove a specific property value from text from START to END.
;;; Arguments PROP and VALUE specify the property and value to remove. The
;;; resulting property values are not equal to VALUE nor lists containing VALUE.
;;; Optional argument OBJECT is the string or buffer containing the text."
;;; (let ((start (text-property-not-all start end prop nil object)) next prev)
;;; (while start
;;; (setq next (next-single-property-change start prop object end)
;;; prev (get-text-property start prop object))
;;; (cond ((and (symbolp prev) (eq value prev))
;;; (remove-text-property start next prop object))
;;; ((and (listp prev) (memq value prev))
;;; (let ((new (delq value prev)))
;;; (cond ((null new)
;;; (remove-text-property start next prop object))
;;; ((= (length new) 1)
;;; (put-text-property start next prop (car new) object))
;;; (t
;;; (put-text-property start next prop new object))))))
;;; (setq start (text-property-not-all next end prop nil object)))))
(defun speck-after-change (start end old-len)
"Speck after a text change.
START, END, and OLD-LEN have the usual meanings."
(when speck-mode
(if (> end start)
;; Insertion.
(with-buffer-prepared-for-specking
(put-text-property start end 'specked 'fresh)
(if speck-multi-post-property
;; Assign `speck-multi-post-property' to inserted text.
(if (eq speck-multi-post-property 'default)
(remove-text-properties start end '(speck nil))
(put-text-property start end 'speck speck-multi-post-property))
(let ((prop
;; Check whether we should inherit speck property from
;; following character.
(and speck-self-insert-inherit
;; Inherit for self-insertions only.
(eq this-command 'self-insert-command)
;; There must be a following character ...
(/= end (point-max))
;; ... and it must not be whitespace.
(not (memq (char-after end) '(?\ ?\n ?\t)))
(or (= start (point-min))
(and (eq speck-self-insert-inherit 'line)
(eq (char-before start) ?\n))
(and (eq speck-self-insert-inherit 'white)
(memq (char-before start) '(?\ ?\n ?\t))))
(speck-get-speck end))))
(when prop (speck-put-speck start end prop)))))
;; Deletion.
(setq start (max (1- start) (point-min)))
(setq end (min (1+ end) (point-max)))
(with-buffer-prepared-for-specking
(put-text-property start end 'specked 'fresh)))
(speck-delete-overlays start end)
(dolist (window (get-buffer-window-list (current-buffer)))
(speck-window-add window))
(when speck-auto-correct-after-change
(speck-auto-correct-after-change))))
(defun speck-window-change (window start)
"Speck after WINDOW changes, START is ignored."
(speck-window-add window))
(defun speck-frame-change (frame)
"Speck after FRAME changes."
(dolist (window (window-list frame))
(speck-window-add window)))
(defun speck-configuration-change ()
"Speck after configuration changes."
(dolist (window (window-list (selected-frame)))
(speck-window-add window)))
(defun speck-redisplay-end-trigger (window start)
"Speck after redisplay end triggers on WINDOW. START is ignored."
(speck-window-add window))
(defvar speck-reverting nil
"Non-nil when buffer is reverted.")
;; We make this permanently buffer-local to assure that any error that might
;; occur during `revert-buffer' dropping the call for `speck-after-revert' and
;; thus not resetting this variable affects other buffers.
(make-variable-buffer-local 'speck-reverting)
(put 'speck-reverting 'permanent-local t)
(defun speck-before-revert ()
"Set `speck-reverting' before reverting buffer."
(when speck-mode
(add-hook 'after-revert-hook 'speck-after-revert t t)
;; `speck-reverting' is permanently buffer-local.
(setq speck-reverting t)))
(defun speck-after-revert ()
"Reset `speck-reverting' after reverting buffer."
(remove-hook 'after-revert-hook 'speck-after-revert t)
;; `speck-reverting' is permanently buffer-local.
(setq speck-reverting nil))
(defun speck-after-save ()
"Function run by `after-save-hook'.
- Remove `fresh' specked properties from buffer. Needed to avoid
surprising behavior of `speck-auto-correct-case'.
- Remove `speck-kill-buffer-query' for this buffer since the local words
were saved anyway when saving the buffer."
(with-buffer-prepared-for-specking
;; Remove 'fresh properties from current buffer.
(save-excursion
(save-restriction
(widen)
(let (from)
(while (setq from (text-property-any
(point) (point-max) 'specked 'fresh))
(goto-char (next-single-property-change
from 'specked nil (point-max)))
(speck-remove-property from (point)))))))
;; Reset `speck-kill-buffer-query'.
(when speck-kill-buffer-query ; When non-nil this is buffer-local.
(setq speck-kill-buffer-query nil)
(setq speck-kill-buffer-query-list
(delq (current-buffer) speck-kill-buffer-query-list))))
;; _____________________________________________________________________________
;;
;;; hash tables
;; _____________________________________________________________________________
;;
;; For each key (which is actually a word rejected by the spell-checking
;; process) we store one of the following informations:
;; nil - buffer-local, do not write ("accept for session")
;; t - file-local, do write ("accept for file")
;; a list of symbols (dictionaries) - text-local, do write with dictionary
;; ("accept for file with dictionary")
(defun speck-hash-get (word)
(when speck-hash-table
(gethash word speck-hash-table)))
(defun speck-hash-restore (word value)
"Restore hash table when reading in Local Words."
(unless speck-hash-table
(setq speck-hash-table (make-hash-table :test 'equal)))
(let ((hash (speck-hash-get word)))
(cond
((eq value 'buffer)
;; A buffer value can't override anything.
(unless hash (puthash word value speck-hash-table)))
((eq value 'file)
;; A `file' value overrides anything else.
(puthash word value speck-hash-table))
((consp hash)
;; We have a dictionary entry, add new one (intern `value').
(puthash word (cons (intern value) hash) speck-hash-table))
(t
;; Make this the only entry (intern `value').
(puthash word (list (intern value)) speck-hash-table)))))
(defun speck-hash-put (word value)
"Add word to `speck-hash-table' and maybe save it to file."
(unless speck-hash-table
(setq speck-hash-table (make-hash-table :test 'equal)))
(let ((hash (speck-hash-get word)))
(when (and (not (eq value 'buffer))
speck-save-ask speck-save-words speck-save-permanent)
;; Make sure a word section is written before buffer is killed.
(speck-kill-buffer-add))
(cond
((eq value 'buffer)
;; A buffer value can't override anything.
(unless hash (puthash word value speck-hash-table)))
((eq value 'file)
;; A `file' value overrides anything else.
(puthash word value speck-hash-table)
(speck-save-word word))
((consp hash)
;; We already have a dictionary entry, add new one.
(puthash word (cons value hash) speck-hash-table)
(speck-save-word word value))
(t
;; Make a new dictionary entry.
(puthash word (list value) speck-hash-table)
(speck-save-word word value)))))
;; _____________________________________________________________________________
;;
;;; process management
;; _____________________________________________________________________________
;;
(defun speck-start-process ()
(cond
((eq speck-default-checker 'Aspell)
(speck-aspell-start-process))
((eq speck-default-checker 'Ispell)
(speck-ispell-start-process))
(t
;; Turn specking off.
(speck-mode -1)
(error "Invalid default checker"))))
(defun speck-aspell-start-process ()
"Start Aspell process."
;; `speck-dictionary' must be a symbol denoting a valid dictionary.
(let* ((dictionary-name (symbol-name speck-dictionary))
;; The first two characters are the language code, the remainder are
;; regions, accents, ...
(entry (assoc (substring dictionary-name 0 2)
speck-aspell-language-options))
(coding-system
;; A value specified in `speck-aspell-coding-system' overrides
;; everything else. Note: Most problems in our communcation with
;; Aspell will stem from what we set up here.
(or speck-aspell-coding-system
(when entry
(if (eq (nth 1 entry) t)
;; Obtain coding system from Aspell.
(speck-aspell-charset entry)
;; Obtain coding system from option.
(nth 1 entry)))))
(minimum-word-length
;; A value specified in `speck-aspell-minimum-word-length' overrides
;; anything else.
(or speck-aspell-minimum-word-length
(when entry (nth 2 entry))))
(run-together
;; A value specified in `speck-aspell-maximum-run-together' overrides
;; anything else.
(or speck-aspell-maximum-run-together
(when entry (nth 3 entry))))
(extra-arguments (when entry (nth 4 entry)))
(arguments
(append
;; Pipe option and dictionary-name.
(list "-a" "-d" dictionary-name)
;; Coding system.
(when coding-system
(list (concat "--encoding=" (symbol-name coding-system))))
;; Minimum word length.
(when minimum-word-length
(list (concat "--ignore=" (number-to-string minimum-word-length))))
;; Run-together words.
(if run-together (list "-C") (list "-B"))
(when (numberp run-together)
(list (concat "--run-together-limit=" (number-to-string run-together))))
;; Filter-mode, aspell wants it downcased.
(unless (eq speck-filter-mode 'URL)
(list (concat "--mode=" (downcase (symbol-name speck-filter-mode)))))
;; The following code doesn't work on my system when multiple
;; dictionaries are involved, for some strange reason Emacs decides
;; to set buffer-file-name to nil for the second call and Aspell
;; seems to get confused.
;;; (cond
;;; ((and (eq speck-aspell-home-dir t)
;;; (let* ((dir-name
;;; (when buffer-file-name
;;; (directory-file-name
;;; (file-name-directory buffer-file-name)))))
;;; (when dir-name
;;; (list "--home-dir"
;;; (convert-standard-filename dir-name))))))
;; Specify directory where personal word lists reside.
(when speck-aspell-home-dir
(list "--home-dir"
(convert-standard-filename speck-aspell-home-dir)))
;; The name of the personal word list (dictionary file).
(when speck-personal-dictionary-file
(list "--personal" speck-personal-dictionary-file))
;; The following is the Aspell standard, hence it's commented out.
;;; (list "--personal" (concat dictionary-name ".pws")))
(when speck-aspell-suggestion-mode
(list (concat "--sug-mode=" speck-aspell-suggestion-mode)))
extra-arguments
speck-aspell-extra-arguments))
(process (rassoc arguments speck-process-argument-alist))
;; An entry should exist when a process exists, but be paranoid here.
(entry (when process (assq (car process) speck-process-buffer-alist)))
process-connection-type)
(if (and process entry)
;; Process and entry exist.
(progn
(setq speck-process (car process))
(setcdr entry (cons (current-buffer) (cdr entry))))
;; No suitable process exists.
;;; (message "... %s" arguments) (sit-for 1)
(let ((default-directory
(if (and (file-directory-p default-directory)
(file-readable-p default-directory))
;; Defend against bad `default-directory'.
default-directory
(expand-file-name "~/"))))
(setq speck-process
(apply 'start-process "speck"
(generate-new-buffer "*speck-process-buffer*") ; use leading space <---
speck-aspell-program arguments)))
(setq speck-process-buffer-alist
(cons (cons speck-process (list (current-buffer)))
speck-process-buffer-alist))
(setq speck-process-argument-alist
(cons (cons speck-process arguments)
speck-process-argument-alist))
(setq speck-process-dictionary-alist
;; Buffer local.
(cons (cons speck-process speck-dictionary)
speck-process-dictionary-alist))
(set-process-query-on-exit-flag speck-process nil)
(when coding-system
(set-process-coding-system
speck-process coding-system coding-system)))))
(defun speck-delete-process ()
"Delete any `speck-process' associated with current buffer.
Do not delete such a process if another buffer still needs it."
(dolist (buffer-entry speck-process-buffer-alist)
(setcdr buffer-entry (delq (current-buffer) (cdr buffer-entry)))
(unless (cdr buffer-entry)
(setq speck-process-buffer-alist
(assq-delete-all
(car buffer-entry) speck-process-buffer-alist))
(setq speck-process-argument-alist
(assq-delete-all
(car buffer-entry) speck-process-argument-alist))
;; Kill process-buffer.
(kill-buffer (process-buffer (car buffer-entry)))
;; Likely kill-buffer should have done that already:
(delete-process (car buffer-entry))))
(setq speck-process-dictionary-alist nil)
(setq speck-process nil))
(defun speck-chunk () ; clean-up <-------
"Send a line-like object to `speck-process'."
(let* ((process speck-process)
(process-buffer (process-buffer speck-process))
(string
(concat "^" (buffer-substring-no-properties
(point-min) (point-max))
"\n"))
(bol (point-min))
(eol (point-max))
(old bol)
at length from to face hash)
(speck-delete-overlays (point-min) (point-max))
(with-current-buffer process-buffer
;; Erasing the buffer does not give any guarantee that process feeds us
;; with some stale information, hence let's accept some output before.
;; But this 0.01 must be made customizable. <--------------------
(accept-process-output speck-process 0.01)
(erase-buffer)
(process-send-string process "!\n")
(process-send-string process string)
(while (and (not (speck-stop))
(progn
(accept-process-output process 0.01)
(goto-char (point-max))
;; Aspell appends an empty line, wait till it's here.
(not (looking-back "^\n")))))
(goto-char (point-min)))
(while (and (not (speck-stop))
(with-current-buffer process-buffer
(and (re-search-forward "\\(^& \\)\\|\\(^# \\)" nil t)
(cond
((match-beginning 1) ; &
(setq length (skip-chars-forward "^ "))
(forward-char)
(re-search-forward " " nil t)
(setq at (point))
(re-search-forward ":" nil t)
(setq from (+ (string-to-number
(buffer-substring-no-properties
at (1- (point))))
bol -1))
;; The `eol' stuff should work around Ispell failing to
;; report our positions and lengths when coding-systems
;; mismatch.
(setq to (min (+ from length) eol))
(setq face 'speck-guess))
((match-beginning 2) ; #
(setq length (skip-chars-forward "^ "))
(forward-char)
(setq at (point))
;; Stop before space or newline character.
(skip-chars-forward "^ \n")
(setq from (+ (string-to-number
(buffer-substring-no-properties
at (point)))
bol -1))
;; See above.
(setq to (min (+ from length) eol))
(setq face 'speck-miss))))))
(cond
((and speck-face-inhibit-list
(let ((faces (get-text-property from 'face)))
;; Inhibit specking this word if (one of) its face(s) at the
;; _first_ character is in `speck-face-inhibit-list'.
(cond
((not faces)
nil)
((listp faces)
;; We have a list of face properties.
(catch 'found
(dolist (face faces)
(when (memq face speck-face-inhibit-list)
(throw 'found t)))))
(t ; atom
(memq faces speck-face-inhibit-list)))))
(speck-put-specked old to))
((and (eq speck-filter-mode 'Email)
speck-email-citations
(if (facep speck-email-citations)
;; Face.
(let ((faces (get-text-property from 'face)))
;; Inhibit specking this word if (one of) its face(s) at the
;; _first_ character is in `speck-face-inhibit-list'.
(cond
((not faces)
nil)
((listp faces)
;; We have a list of face properties.
(catch 'found
(dolist (face faces)
(when (eq face speck-email-citations)
(throw 'found t)))))
(t ; atom
(eq faces speck-email-citations))))
;; Regexp
(save-excursion
(save-restriction
(widen)
(beginning-of-line)
(looking-at speck-email-citations)))))
(speck-put-property old to))
((and speck-hash-table
(setq hash (speck-hash-get
(buffer-substring-no-properties from to)))
(or (memq hash '(buffer file))
(if (speck-get-speck from)
(memq (speck-get-speck from) hash)
(memq speck-dictionary hash))))
;; Don't put overlay if the word is in the hash table.
(speck-put-specked old to))
((and (eq (current-buffer) speck-nospeck-buffer)
(<= from speck-nospeck-at)
(<= speck-nospeck-at to))
;; We are not allowed to put an overlay here
(speck-put-specked old from)
(speck-remove-property from to))
((and speck-auto-correct-case
;; Proceed iff we have guesses.
(eq face 'speck-guess)
(text-property-any from to 'specked 'fresh)
(speck-auto-correct-case
old from to (buffer-substring-no-properties from to))))
(t
;; Put property and overlay.
(speck-put-specked old to from)
(speck-make-overlay from to face)))
;; The following is a pain, needed to handle Ispell's failure to get
;; coding-system.
(setq old to))
(unless speck-stop
(speck-put-specked old (point-max)))))
(defun speck-word (from to word &optional multi)
"Send a word-like object to `speck-process' and return list of guesses."
(let* ((dictionary (when multi (speck-get-speck from)))
(process
(if dictionary
(car (rassq dictionary speck-process-dictionary-alist))
speck-process))
guesses)
(unless process
;; Should not occur.
(let ((speck-dictionary dictionary)
speck-process)
(speck-start-process)
(setq process speck-process)))
(with-current-buffer (process-buffer process)
(erase-buffer)
(process-send-string process (concat "^" word "\n"))
(while (and (not quit-flag)
(progn
(accept-process-output process 0.01)
(goto-char (point-max))
;; Aspell appends an empty line, wait till it's here.
(not (looking-back "^\n")))))
(goto-char (point-min))
(when (and (re-search-forward "^& " nil t)
(not (zerop (skip-chars-forward "^ ")))
(re-search-forward ": "))
(while (re-search-forward "\\(.*?\\)\\(?:, \\|\n\n\\)" nil t)
(setq guesses (cons (match-string-no-properties 1) guesses)))
(when guesses (nreverse guesses))))))
(defun speck-send-replacement (misspelled replacement)
"Tell Aspell that MISSPELLED should be spelled REPLACEMENT."
;; This doesn't seem to work in spite of the fact that I ask Aspell to save
;; the dictionary afterwards.
(process-send-string
speck-process (concat "$$ra " misspelled "," replacement "\n"))
(process-send-string speck-process "#\n"))
;; _____________________________________________________________________________
;;
;;; windows
;; _____________________________________________________________________________
;;
(defun speck-stop ()
(or speck-stop (setq speck-stop (input-pending-p))))
(defun speck-respeck (delay)
"Speck again after DELAY seconds."
(timer-set-idle-time speck-pause-timer (current-idle-time))
(timer-inc-time speck-pause-timer (or delay 0))
(timer-activate-when-idle speck-pause-timer t))
(defun speck-desuspend ()
"De-suspend all suspended window.
This function must be executed by `pre-command-hook'."
(setq speck-suspension-list nil)
(remove-hook 'pre-command-hook 'speck-desuspend))
(defun speck-windows (&optional pause)
"Speck windows on `speck-window-list'.
Works correctly iff the optional argument PAUSE is nil when triggered by
`speck-delay-timer' and non-nil when triggered by `speck-pause-timer'."
(unless pause
;; When `pause' is nil cancel `speck-pause-timer' (in pathological cases
;; this might interfere with the current call).
(cancel-timer speck-pause-timer))
;; Continue iff there's something to speck and we don't interfere with more
;; important activities.
(cond
((or (input-pending-p) ; (active-minibuffer-window) ; do we ned this?
executing-kbd-macro defining-kbd-macro)
;; Pause by `speck-delay' seconds (maybe the list above should be extended).
(speck-respeck speck-delay))
;; Test selected window first.
((and (not (memq (selected-window) speck-suspension-list))
;; Do not reset `speck-nospeck-buffer' as long as the selected window
;; is suspended.
(progn
(setq speck-nospeck-buffer nil)
(memq (selected-window) speck-window-list))
(or (let ((buffer (window-buffer)))
(and (local-variable-p 'speck-mode buffer)
(buffer-local-value 'speck-mode buffer)))
;; The selected window is not suitable for specking, remove it
;; from `speck-window-list' (could it ever get there?).
(and (speck-window-remove (selected-window)) nil)))
;; Auto correction, must be improved, currently speck-fresh is never reset.
;;; (when speck-fresh (speck-auto-correct))
(with-buffer-prepared-for-specking
;; The selected window is suitable for specking, test for nospeck area.
(when (and speck-process (not (process-get speck-process 'preempted)))
(let (minibuffer-auto-raise message-log-max)
(save-excursion
(speck-window t))))))
((let ((window
(catch 'found
;; Scan `speck-window-list'
(dolist (window speck-window-list)
(unless (memq window speck-suspension-list)
(if (and (window-live-p window)
(let ((buffer (window-buffer window)))
(and (local-variable-p 'speck-mode buffer)
(buffer-local-value 'speck-mode buffer))))
;; `window' is suitable for specking, return it.
(throw 'found window)
;; `window' is not suitable for specking, remove it from
;; `speck-window-list'.
(speck-window-remove window)))))))
;; Speck `window'.
(with-selected-window window
;; Do this after we selected the window and thus implicitly made its
;; buffer current.
(when (and speck-process (not (process-get speck-process 'preempted)))
(with-buffer-prepared-for-specking
(let (minibuffer-auto-raise message-log-max)
(save-excursion
(speck-window)))))))))
(when speck-window-list
;; Pause by `speck-pause' seconds.
(speck-respeck speck-pause)))
(defun speck-window (&optional selected)
"Speck selected window.
Optional argument SELECTED is non-nil when selected window is the window
actually selected by the user.
This function must be called `with-buffer-prepared-for-specking' and
within a `save-excursion'."
(let ((at (window-point))
(window-start (window-start))
(window-end (window-end))
line-start line-end)
;; Note: `selected' => `speck-nospeck-buffer' is either nil or
;; `current-buffer'.
(setq speck-stop nil)
(setq speck-break nil)
(setq speck-ppss-at nil)
;; In user-selected window try to speck line around `at'.
(when (and selected (not (speck-stop)))
(if (bolp)
;; When at `bolp' speck last chunk on preceding line.
(forward-line -1)
;; Speck last chunk on present line.
(when (or (eq speck-chunk-at-point t)
(and (eq speck-chunk-at-point 'commands)
(memq last-command speck-chunk-at-point-commands)))
(setq speck-nospeck-buffer (current-buffer))
(setq speck-nospeck-at (window-point))))
(save-excursion
(save-restriction
(let (temp)
(narrow-to-region
(progn
(skip-chars-backward " \t")
(setq temp (point))
(skip-chars-backward "^ \n\t\f")
(point))
(progn
(goto-char temp)
(skip-chars-forward "^\n\t\f")
(point)))
(goto-char (point-min))
;; `speck-chunks' would be more intuitive here but we would have to
;; set up things for that, hence stick to `speck-line'.
(speck-line))))
(when (and speck-nospeck-buffer
(or speck-stop
(and (or (= speck-nospeck-at window-start)
(eq (get-text-property
(1- speck-nospeck-at) 'specked) t))
(or (= speck-nospeck-at window-end)
(eq (get-text-property
speck-nospeck-at 'specked) t)))))
;; Reset this, we won't need it in this round.
(setq speck-nospeck-buffer nil)))
;; Reset again.
(setq speck-ppss-at nil)
;; Speck window.
(unless (or (speck-stop) speck-break)
(save-restriction
(narrow-to-region window-start window-end)
(goto-char (point-min))
(while (and (not (speck-stop)) (not (eobp)))
(speck-line))))
(unless (or speck-stop speck-break) ; speck-break set by loop ? <-------
(if (eq (current-buffer) speck-nospeck-buffer)
(progn
;; Suspend specking this window.
(setq speck-suspension-list
(cons (selected-window) speck-suspension-list))
(add-hook 'pre-command-hook 'speck-desuspend))
;; Nothing to speck in this window, remove it from
;; `speck-window-list'.
(speck-window-remove (selected-window))))))
(defun speck-chunks ()
"Process a contiguous set of chunks."
(let (old)
(goto-char (point-min))
(while (and (not (speck-stop)) (not (eobp)))
(setq old (point))
(skip-chars-forward " \t")
(speck-put-property old (point))
(unless (eobp)
(save-restriction
(narrow-to-region
(point)
(progn
(skip-chars-forward "^ \t")
(point)))
;; We have isolated a chunk.
(if speck-multi
(speck-multi-chunk)
(speck-chunk)))))))
(defun speck-multi-chunk ()
"Process a chunk possibly composed from multi language chunks."
(goto-char (point-min))
(while (not (eobp))
(save-restriction
(narrow-to-region
(point)
(next-single-property-change (point) 'speck nil (point-max)))
;; Check language.
(let* ((dictionary (speck-get-speck (point-min)))
(speck-process
(if dictionary
(if (memq dictionary '(-- ==))
'ignore
(car (rassq dictionary speck-process-dictionary-alist)))
speck-process))
(speck-dictionary (or dictionary speck-dictionary)))
(cond
((eq speck-process 'ignore)
(speck-put-property (point-min) (point-max)))
(speck-process
(speck-chunk))
;; Using `member' seems ugly. But the following check is needed only
;; for the first time the property is encountered in a buffer.
((member (symbol-name speck-dictionary)
(cond
((eq speck-default-checker 'Aspell)
speck-aspell-dictionary-names)
((eq speck-default-checker 'Ispell)
speck-ispell-dictionary-names)))
(speck-start-process)
(speck-chunk))
;; This check is needed more often, but it should be exceptional using
;; an uninstalled dictionary.
((member (symbol-name speck-dictionary)
(cond
((eq speck-default-checker 'Aspell)
speck-aspell-non-dictionary-names)
((eq speck-default-checker 'Ispell)
speck-ispell-non-dictionary-names)))
;; We already know that this dictionary doesn't exist.
(speck-put-property (point-min) (point-max)))
(t
;; We encounter this dictionary for the first time, it's
;; probably from an imported file and we have to warn the user
;; that the dictionary doesn't exist.
(speck-put-property (point-min) (point-max))
(cond
((eq speck-default-checker 'Aspell)
(setq speck-aspell-non-dictionary-names
(cons (symbol-name speck-dictionary)
speck-aspell-non-dictionary-names)))
((eq speck-default-checker 'Ispell)
(setq speck-ispell-non-dictionary-names
(cons (symbol-name speck-dictionary)
speck-ispell-non-dictionary-names))))
(save-restriction
(widen)
;; Should become an error, maybe ... On the other hand we might want
;; to continue checking the rest of the text if it has a valid
;; dictionary.
(message "No such dictionary \"%s\"" speck-dictionary)
(ding) (sit-for 3)))))
(goto-char (point-max)))))
(defun speck-line ()
"Speck line."
(interactive)
(let (old)
(unless (eolp)
(save-restriction
(narrow-to-region (line-beginning-position) (line-end-position))
(goto-char (point-min))
(while (and (not (speck-stop))
(setq old (text-property-not-all
(point) (point-max) 'specked t)))
(goto-char old)
(save-restriction
;; Narrow down to chunk around `old'.
(narrow-to-region
(progn
(skip-chars-backward "^ \t") (point))
(progn
(goto-char
(or (text-property-any old (point-max) 'specked t)
(point-max)))
(skip-chars-forward "^ \t") (point)))
(cond
((save-excursion
(goto-char (point-min))
(skip-chars-forward " \t")
(eobp))
;; Only whitespace here.
(speck-put-property (point-min) (point-max)))
(speck-syntactic
;; Speck comments and/or strings only.
(goto-char (point-min))
(save-restriction
(widen)
(if speck-ppss-at
;; Parse from `speck-ppss-at'.
(setq speck-ppss
(parse-partial-sexp
speck-ppss-at (point) nil nil speck-ppss))
;; Use `syntax-ppss'.
(setq speck-ppss (syntax-ppss))))
(setq speck-ppss-at (point))
(unless (or (and (nth 3 speck-ppss)
(memq speck-syntactic '(strings t)))
(and (nth 4 speck-ppss)
(memq speck-syntactic '(comments t))))
;; Find end of comment or string.
(setq speck-ppss
(parse-partial-sexp
speck-ppss-at (point-max) nil nil
speck-ppss 'syntax-table))
(setq speck-ppss-at (point))
(speck-put-property old (point)))
(while (and (not (speck-stop)) (not (eobp)))
(save-restriction
(let ((in-string (nth 3 speck-ppss))
(in-comment (nth 4 speck-ppss)))
(narrow-to-region
speck-ppss-at
(progn
(setq speck-ppss
(parse-partial-sexp
speck-ppss-at (point-max) nil nil
speck-ppss 'syntax-table))
(setq speck-ppss-at (point))))
(if (or (and in-string
(memq speck-syntactic '(strings t)))
(and in-comment
(memq speck-syntactic '(comments t))))
(speck-chunks)
(speck-put-property (point-min) (point-max)))))
(setq old (point))
(setq speck-ppss
(parse-partial-sexp
speck-ppss-at (point-max) nil nil
speck-ppss 'syntax-table))
(setq speck-ppss-at (point))
(unless speck-stop
(speck-put-property old (point)))))
;; Speck entire line.
(t (speck-chunks)))
(goto-char (point-max))))))
(setq old (point))
(forward-line)
;; Speck newline.
(unless speck-stop
(speck-put-property old (point)))))
(defun speck-put-property (from to)
;;; (put-text-property from to 'face 'speck-mouse)
(put-text-property from to 'specked t))
(defun speck-remove-property (from to)
(remove-text-properties from to '(specked nil)))
;; The following three items stolen from ps-print.el.
(defalias 'speck-jitify 'jit-lock-fontify-now)
(defalias 'speck-lazify 'lazy-lock-fontify-region)
;; Stefan's idea of doing this.
(defun speck-ensure-fontified (start end)
(cond
((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
(speck-jitify start end))
((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
(speck-lazify start end))))
(defun speck-syntactic-p ()
"Return t when character at `point' may be syntactically checked."
(and (or (not speck-syntactic)
(let ((parse-state (syntax-ppss)))
(or (and (nth 3 parse-state)
(memq speck-syntactic '(strings t)))
(and (nth 4 parse-state)
(memq speck-syntactic '(comments t))))))
(or (not speck-face-inhibit-list)
(progn
(unless (get-text-property (point) 'fontified)
(speck-ensure-fontified
(line-beginning-position) (line-end-position))
nil))
(let ((faces (get-text-property (point) 'face)))
;; Inhibit specking this word if (one of) its face(s) is in
;; `speck-face-inhibit-list'.
(cond
((not faces))
((listp faces)
;; We have a list of face properties.
(catch 'found
(dolist (face faces t)
(when (memq face speck-face-inhibit-list)
(throw 'found nil)))))
(t ; Atom.
(not (memq faces speck-face-inhibit-list))))))))
(defun speck-put-specked (old to &optional from)
"Put `specked' property from OLD to TO.
Optional argument FROM means there is a misspelled word from FROM till
TO."
;;; (message "... old %s to %s from %s" old to from) (sit-for 1)
;; Must be called `with-buffer-prepared-for-specking'.
(if speck-doublets
(let ((start old)
(end to)
too prev prev-from prev-to next next-from next-to
nospeck-from nospeck-to)
(save-excursion
(save-restriction
(widen)
;; Adjust region around `old'.
(goto-char old)
(when (and (skip-chars-forward " \t\n\f")
(not (zerop (skip-chars-backward " \t\n\f")))
(setq too (point))
;; We consider symbol syntax only.
(not (zerop (skip-syntax-backward "w_")))
(not (text-property-not-all (point) old 'specked t))
(not (get-char-property (point) 'specky))
(= (next-single-char-property-change
(point) 'specky nil too) too))
(setq start (point)))
;; Adjust region around `to'.
(goto-char to)
(when (and (not (zerop (skip-chars-forward " \t\n\f")))
(not (zerop (skip-syntax-forward "w_"))))
(if from
(progn
(unless (or (text-property-not-all to (point) 'specked t)
(zerop (skip-chars-forward " \t\n\f")) (eobp)
(progn
(setq too (point))
(zerop (skip-syntax-forward "w_"))))
;; Remove any doublet overlays here.
(speck-delete-doublet-overlays too (point)))
(goto-char from)
(skip-chars-backward " \t\n\f")
(setq end (point)))
(setq end (point))))
;; Now scan region from `start' till `end'.
(speck-delete-doublet-overlays old end)
(narrow-to-region start end)
(goto-char start)
;; A doublet _must_ start with a word character.
(skip-syntax-forward "^w")
(setq prev-from (point))
(skip-syntax-forward "w_")
(setq prev-to (point))
(setq prev (buffer-substring-no-properties prev-from prev-to))
(while (not (eobp))
(if (and (not (string-equal prev ""))
(not (zerop (skip-chars-forward " \t\n\f")))
(setq next-from (point))
(skip-syntax-forward "w_")
(setq next-to (point))
(setq next (buffer-substring-no-properties
next-from next-to))
(not (string-equal next "")))
(progn
(when (and (string-equal prev next)
(or (not (eq (current-buffer) speck-nospeck-buffer))
(> next-from speck-nospeck-at)
(< next-to speck-nospeck-at)
(progn
(setq nospeck-from next-from)
(setq nospeck-to next-to)
nil)))
(speck-make-overlay next-from next-to 'speck-doublet))
(setq prev-from next-from)
(setq prev-to next-to)
(setq prev next))
(skip-syntax-forward "^w")
(setq prev-from (point))
(skip-syntax-forward "w_")
(setq prev-to (point))
(setq prev (buffer-substring-no-properties prev-from prev-to))))))
(if nospeck-from
(progn
(speck-put-property old nospeck-from)
(speck-put-property nospeck-to to))
(speck-put-property old to)))
;; Put the text property.
(speck-put-property old to)))
;; _____________________________________________________________________________
;;
;;; adding words
;; _____________________________________________________________________________
;;
(defun speck-add-cleanup (overlay from to word)
"Cleanup after WORD has been added.
OVERLAY is the overlay covering WORD, FROM and TO its boundaries."
(with-buffer-prepared-for-specking
(delete-overlay overlay)
(speck-remove-property from to)
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
;; Should we relocate all overlays here?
(unless (get-char-property (point) 'specky)
(goto-char (or (next-single-char-property-change (point) 'specky)
(point-max)))
(let (property)
(while (not (eobp))
(setq from (point))
(setq to (or (next-single-char-property-change from 'specky)
(point-max)))
(setq overlay (cdr (get-char-property-and-overlay from 'specky)))
(when (and overlay
(string-equal (buffer-substring-no-properties from to)
word))
(delete-overlay overlay)
(speck-remove-property from to))
(goto-char (or (next-single-char-property-change (point) 'specky)
(point-max)))))))))
;; Add buffer to speck's windows.
(dolist (window (get-buffer-window-list (current-buffer)))
(speck-window-add window)))
(defun speck-add-word (overlay)
"Add word covered by OVERLAY to dictionary or list."
(interactive)
(let* ((from (overlay-start overlay))
(to (overlay-end overlay))
(word (buffer-substring-no-properties from to))
(face (overlay-get overlay 'face))
(hash (speck-hash-get word))
;; We need the correct personal word list (pws) and thus have to find
;; the Aspell process adminstrating it. It's not entirely clear what
;; happens when two process intermittently modify the same pws (there's
;; been some discussion on thread safety) but our approach of sharing
;; one process for all regions with the same dictionary should render
;; this less dramatic within one and the same Emacs session.
(dictionary (speck-get-speck from))
(speck-process
(if dictionary
(car (rassq dictionary speck-process-dictionary-alist))
speck-process))
(speck-dictionary (or dictionary speck-dictionary)))
(when overlay
(overlay-put overlay 'face 'speck-query)
(message (concat
(format "\"p\" add `%s' personally" word)
(unless (string-equal word (downcase word))
(format " (\"l\" adds `%s')" (downcase word)))
;; Suppress the following when an entry already exists.
(unless hash (format ", \"b\" add for buffer"))
(when (and speck-save-confirmed ; may be yet 'undecided
speck-save-words buffer-file-name)
(format ", \"f\" file, \"d\" dictionary \"%s\""
(or dictionary speck-dictionary)))))
(unwind-protect
(let* ((char (read-event))
(key (vector char))
(case-fold-search t))
(cond
((and (integerp char)
(or (char-equal char ?p) (char-equal char ?*)))
(process-send-string speck-process (concat "*" word "\n"))
(process-send-string speck-process "#\n")
(speck-add-cleanup overlay from to word))
((and (integerp char)
(or (char-equal char ?l) (char-equal char ?&)))
(process-send-string speck-process (concat "&" word "\n"))
(process-send-string speck-process "#\n")
(speck-add-cleanup overlay from to word))
((and (integerp char) (char-equal char ?b) (not hash))
(speck-hash-put word 'buffer)
(speck-add-cleanup overlay from to word))
((and (integerp char) (char-equal char ?f)
speck-save-words (speck-save-confirm))
(speck-hash-put word 'file)
(speck-add-cleanup overlay from to word))
((and (integerp char) (char-equal char ?d)
speck-save-words (speck-save-confirm))
(speck-hash-put
word (or dictionary speck-dictionary))
(speck-add-cleanup overlay from to word))
(t
(setq this-command 'mode-exited)
(setq unread-command-events
(append (listify-key-sequence key)
unread-command-events)))))
;; Restore previous face.
(when (overlayp overlay)
(overlay-put overlay 'face face))))))
(defun speck-add-previous (&optional arg)
"Add previous highlighted word on selected window.
With ARG n do this for nth highlighted word preceding `point'."
(interactive "p")
(let ((overlay (speck-previous-overlay (or arg 1) '(speck-guess speck-miss))))
(if overlay
(speck-add-word overlay)
(let (message-log-max)
(message "Not found ...")
(ding)))))
(defun speck-add-next (&optional arg)
"Add next highlighted word on selected window.
With ARG n do this for nth highlighted word following `point'."
(interactive "p")
(let ((overlay (speck-next-overlay (or arg 1) '(speck-guess speck-miss))))
(if overlay
(speck-add-word overlay)
(let (message-log-max)
(message "Not found ...")
(ding)))))
;; _____________________________________________________________________________
;;
;;; popup menus
;; _____________________________________________________________________________
;;
(defun speck-menu-tail (lower buffer dictionary)
"Precalculated tail for popup menu."
(append
(list
"---"
["Read from minibuffer" 'minibuffer]
"---"
["Query-replace" 'query
:style toggle :selected speck-replace-query
:help "Replace this and query for further occurrences."]
"---"
["Add to personal dictionary" 'personal])
(when lower (list ["Add lower-case version" 'lower]))
(when buffer (list ["Add to word-list of buffer" 'buffer]))
(when (and speck-save-confirmed buffer-file-name speck-save-words)
(list ["Add to general word-list of file" 'file]))
(when (and speck-save-confirmed buffer-file-name speck-save-words)
(list ["Add to dictionary word-list of file" 'dictionary]))))
(defun speck-popup-menu (posn &optional faces)
"Pop up speck menu at position POSN."
(let ((overlay (speck-overlay-at-point nil faces))
(process speck-process))
(when (and overlay process)
;; Preempt `speck-process' and unwind-protect the following to assert that
;; preemption is cancelled (we do this to avoid that specking continues
;; during popups).
(process-put process 'preempted t)
(unwind-protect
(let* ((from (overlay-start overlay))
(to (overlay-end overlay))
(word (buffer-substring-no-properties from to))
(guesses
(let (list)
(nreverse
(dolist (item (speck-word from to word speck-multi) list)
(setq list (cons (vector item item) list))))))
(property (when speck-multi (speck-get-speck from)))
(property-name (when property (symbol-name property)))
(hash (speck-hash-get word))
(speck-replace-query speck-replace-query)
(replace (popup-menu
;; Put dictionary in menu (the user should not
;; have to guess which language is used).
(append
(list (if property
(concat word " [" property-name "]")
word))
guesses
(speck-menu-tail
(not (string-equal word (downcase word)))
(not hash)
(or property-name
(symbol-name speck-dictionary))))
posn))
(speck-process
(if property
(car (rassq property speck-process-dictionary-alist))
speck-process))
(speck-dictionary (or property speck-dictionary)))
(while (eq replace 'query)
(setq speck-replace-query (not speck-replace-query))
(setq replace (popup-menu
(append
(list (if property
(concat word " (" property-name ")")
word))
guesses
(speck-menu-tail
(not (string-equal word (downcase word)))
(not hash)
(or property-name speck-dictionary)))
posn)))
(when (eq replace 'minibuffer)
(setq replace
(read-from-minibuffer
"Replace word: " word minibuffer-local-map nil
'speck-replace-history word t)))
(cond
((memq replace '(personal lower))
(if (eq replace 'personal)
(process-send-string speck-process (concat "*" word "\n"))
(process-send-string
speck-process (concat "&" word "\n")))
(process-send-string speck-process "#\n")
(speck-add-cleanup overlay from to word))
((and (eq replace 'buffer) (not hash))
(speck-hash-put word 'buffer)
(speck-add-cleanup overlay from to word))
((eq replace 'file)
(speck-hash-put word 'file)
(speck-add-cleanup overlay from to word))
((eq replace 'dictionary)
(speck-hash-put word (or property speck-dictionary))
(speck-add-cleanup overlay from to word))
(replace
(unless (atom replace)
(setq replace (car replace)))
(speck-replace-word from to word replace overlay property)
(when speck-replace-query
(speck-replace-query
(downcase word) replace (or property speck-dictionary))))))
(process-put process 'preempted nil)))))
(defun speck-popup-menu-at-point (&optional at point)
"Pop up speck menu.
Optional arguments AT and POINT if set mean popup menu at position AT
and return to position POINT afterwards. At least one letter of the
incorrect word must appear at the right of `point'."
(interactive)
(set-marker speck-marker (or point (point)))
(setq speck-marker-window (selected-window)) ; <-----
(when at (goto-char at))
(let ((posn (posn-at-point)))
;; Always jump back to `speck-marker'.
(unwind-protect
(speck-popup-menu
(list (list (car (posn-x-y posn)) (cdr (posn-x-y posn)))
(posn-window posn)))
(speck-marker-goto))))
(defun speck-popup-menu-previous (&optional arg)
"Popup menu for previous word with guesses or miss.
With ARG n do this for nth such word preceding `point'."
(interactive "p")
(let ((overlay (speck-previous-overlay (or arg 1) '(speck-guess speck-miss))))
(if overlay
(speck-popup-menu-at-point (overlay-start overlay) (point))
(let (message-log-max)
(message "Not found ...")
(ding)))))
(defun speck-popup-menu-next (&optional arg)
"Popup menu for next word with guesses or miss.
With ARG n do this for nth such word following `point'."
(interactive "p")
(let ((overlay (speck-next-overlay (or arg 1) '(speck-guess speck-miss))))
(if overlay
(speck-popup-menu-at-point (overlay-start overlay) (point))
(let (message-log-max)
(message "Not found ...")
(ding)))))
(defun speck-mouse-popup-menu (event)
"Pop up speck menu at mouse-position.
Should be bound to a click event."
(interactive "e")
(set-marker speck-marker (window-point) (current-buffer))
(setq speck-marker-window (selected-window))
(mouse-set-point event)
;; Always jump back to `speck-marker'.
(unwind-protect
(speck-popup-menu event)
(speck-marker-goto)))
;; _____________________________________________________________________________
;;
;;; replace
;; _____________________________________________________________________________
;;
(defun speck-key-help (command keys suffix)
"Return string of keys in KEYS executing COMMAND.
KEYS must be either `speck-replace-keys' or `speck-replace-query-keys'."
(let ((string ""))
(dolist (key keys)
(when (eq command (car key))
(setq string
(concat
string
(unless (string-equal string "") ", ") ; Looks better.
(key-description (cdr key))))))
(if (string-equal string "")
""
(concat " " string suffix)))) ; Prefix this with two spaces.
(defun speck-keys-help (keys &optional first)
"Return a readable list of keybindings for help."
(concat
;; Use a fixed list of commands here, it's simpler. Yes we do allocate string
;; space here, but after all this should be used only sporadically.
(speck-key-help 'accept keys
(concat " to accept the replacement and "
(if first "query further occurrences" "continue") "\n"))
(speck-key-help 'accept-and-quit keys
" to accept the replacement and quit\n")
(speck-key-help 'reject keys
" to reject the replacement and continue\n")
(speck-key-help 'reject-and-quit keys
" to reject the replacement and quit\n")
(speck-key-help 'forward keys " to display the next replacement\n")
(speck-key-help 'backward keys " to display the previous replacement\n")
(speck-key-help 'help keys " to display this help\n")))
(defun speck-replace-word (from to word replace &optional overlay property)
(let (move-to)
(when overlay
(delete-overlay overlay))
(when (and (eq (marker-buffer speck-marker)
(current-buffer))
(<= from speck-marker)
(<= speck-marker to))
(cond
((eq speck-replace-preserve-point 'before)
(setq move-to from))
((and (eq speck-replace-preserve-point 'within)
(<= from speck-marker)
(<= speck-marker to)
(< (- speck-marker from)
(length replace)))
(setq move-to (marker-position speck-marker)))
(t (setq move-to (+ from (length replace))))))
(delete-region from to)
(goto-char from)
(insert replace)
(when property
(speck-put-speck from (point) property))
;; I'm not sure whether this makes any sense. Moreove, it might break our
;; speck-marker handling.
(when (char-table-p translation-table-for-input)
(translate-region from (point) translation-table-for-input))
(when move-to
(set-marker speck-marker move-to))
;; The following doesn't work (hardly ever, at least). Maybe I
;; misunderstand this completely.
;;; (speck-send-replacement word replace)
))
(defun speck-replace-put-overlay (overlay from to offset replace)
(if offset
(cond
((eq speck-replace-preserve-point 'before)
(overlay-put overlay 'display replace)
(goto-char from))
((and (eq speck-replace-preserve-point 'within)
(< offset (length replace)))
(overlay-put
overlay 'display
(concat (substring replace 0 offset)
(propertize
(substring replace offset (1+ offset)) 'cursor t)
(substring replace (1+ offset))))
(goto-char from))
(t
(overlay-put overlay 'display replace)
(goto-char to)))
(overlay-put overlay 'display replace)))
(defun speck-replace (overlay)
"Replace word covered by `OVERLAY' with corrections."
(let ((process speck-process))
(when (and overlay process)
(process-put process 'preempted t)
(unwind-protect
(let* ((from (overlay-start overlay))
(property (when speck-multi (speck-get-speck from)))
(to (overlay-end overlay))
(offset (when (and (< from (point))
(< (point) to))
;; Offset of `point' wrt `from'.
(- (point) from)))
(word (buffer-substring-no-properties from to))
(guesses (speck-word from to word speck-multi))
(text
;; We can't use any "`" or "'" here, these characters may be
;; part of the word or the replacement. Hence entirely rely
;; on faces (`speck-query') to set them apart from the rest.
(substitute-command-keys
(concat
"Replace %s"
(when property " [%s]")
" with %s ? Type \\<speck-replace-map>\\[help] for help."))))
(if (null guesses)
(progn
(message "No corrections found")
(ding))
(let* ((replace (car guesses))
(guess-vector (vconcat guesses))
(guess-index 0)
(guess-max (1- (length guess-vector)))
(def 'forward)
change query key)
(set-marker speck-marker (point))
(setq speck-marker-window (selected-window)) ; <----
(speck-replace-put-overlay overlay from to offset replace)
(overlay-put overlay 'face 'speck-query)
(unwind-protect
(progn
(while (memq def '(forward backward help))
(let ((message-log-max nil))
;; This message is also needed to avoid echoing typed
;; characters in the echo area (see replace.el).
(if property
(message
text (propertize word 'face 'speck-query)
property (propertize replace 'face 'speck-query))
(message
text (propertize word 'face 'speck-query)
(propertize replace 'face 'speck-query))))
(setq key (vector (read-event)))
(setq def (lookup-key speck-replace-map key))
(cond
((eq def 'accept)
(setq change t)
(setq query t))
((eq def 'accept-and-quit)
(setq change t))
((memq def '(reject reject-and-quit)))
((eq def 'forward)
(setq guess-index
(if (= guess-index guess-max) 0 (1+ guess-index)))
(setq replace (aref guess-vector guess-index))
(speck-replace-put-overlay overlay from to offset replace))
((eq def 'backward)
(setq guess-index
(if (zerop guess-index) guess-max (1- guess-index)))
(setq replace (aref guess-vector guess-index))
(speck-replace-put-overlay overlay from to offset replace))
((eq def 'help)
(with-output-to-temp-buffer "*Help*"
(princ
(concat
"Replace `" word "' with `" replace "'? Type\n\n"
(speck-keys-help speck-replace-keys t)
"\nAnything else will accept the replacement and reread as command.\n"))
(with-current-buffer standard-output
(help-mode))))
(t
;; The mode-exited stuff is not clean but let's try doing this
;; as in `query-replace'.
(setq this-command 'mode-exited)
(setq unread-command-events
(append (listify-key-sequence key)
unread-command-events))
(setq change t)))))
(cond
(change
(speck-replace-word from to word replace overlay property))
((overlayp overlay)
;; Restore overlay properties.
(overlay-put overlay 'display nil) ; Silly
(overlay-put overlay 'face 'speck-guess)))
(when (and query speck-replace-query)
(speck-replace-query
(downcase word) replace (or property speck-dictionary)))
(speck-marker-goto)))))
(process-put process 'preempted nil)))))
(defun speck-replace-previous (&optional arg)
"Correct previous word with guesses in place.
With ARG n do this for nth such word preceding `point'."
(interactive "p")
(let ((overlay (speck-previous-overlay (or arg 1) '(speck-guess))))
(if overlay
(speck-replace overlay)
(let (message-log-max)
(message "Not found ...")
(ding)))))
(defun speck-replace-next (&optional arg)
"Correct next word with guesses in place.
With ARG n do this for nth such word following `point'."
(interactive "p")
(let ((overlay (speck-next-overlay (or arg 1) '(speck-guess))))
(if overlay
(speck-replace overlay)
(let (message-log-max)
(message "Not found ...")
(ding)))))
(defun speck-replace-query (word replace original-property)
"Query replace further occurrences of WORD by something like REPLACE.
ORIGINAL-PROPERTY must match the speck property of the occurrence."
(let ((regexp (concat "\\<" (regexp-quote word) "\\>"))
(query t)
(case-fold-search t)
(text
(substitute-command-keys
"Replace `%s' with `%s'? Type \\<speck-replace-query-map>\\[help] for help.")))
;; Consider widening here.
;; Consider using `undo-boundary' here.
(goto-char (point-min))
(while (and query (not (eobp))
(re-search-forward regexp nil t))
(let* ((from (match-beginning 0))
(property (when speck-multi (speck-get-speck from)))
(to (match-end 0))
(word (buffer-substring-no-properties from to))
(begin (line-beginning-position))
(end (line-beginning-position 2))
guesses tail)
(when (and (if property
(equal property original-property)
(eq speck-dictionary original-property))
(not (and query-replace-skip-read-only
;; Ignore matches with read-only property.
(text-property-not-all
(match-beginning 0) (match-end 0)
'read-only nil)))
(save-excursion
(and (goto-char from) (speck-syntactic-p)
;; The following ignores matches when ISPELL
;; doesn't deliver guesses. This shouldn't
;; occur.
(consp (setq guesses (speck-word from to word property))))))
(when (setq tail (member-ignore-case replace guesses))
;; REPLACE is in `guesses'.
(unless (eq guesses tail)
;; Move REPLACE to head of list.
(setq guesses
(cons (car tail)
(delete (car tail) guesses)))))
(let* ((replace (car guesses))
(reps-vector (vconcat guesses))
(reps-index 0)
(reps-max (1- (length reps-vector)))
(overlay (or (speck-overlay-at-point
from '(speck-guess speck-miss))
(make-overlay from to)))
(def 'forward)
change key)
(overlay-put overlay 'specky t)
(overlay-put overlay 'display replace)
(overlay-put overlay 'face 'speck-query)
(unwind-protect
(while (memq def '(forward backward help))
(setq query nil)
(setq def nil)
(let ((message-log-max nil))
;; This message is needed to avoid echoing typed
;; characters in the echo area (see replace.el).
(message text word replace))
(setq key (vector (read-event)))
(setq def (lookup-key speck-replace-query-map key))
(cond
((eq def 'accept)
(setq change t)
(setq query t))
((eq def 'accept-and-quit)
(setq change t))
((eq def 'reject)
(setq query t))
((eq def 'reject-and-quit))
((eq def 'forward)
(setq reps-index
(if (= reps-index reps-max) 0 (1+ reps-index)))
(setq replace (aref reps-vector reps-index))
(overlay-put overlay 'display replace))
((eq def 'backward)
(setq reps-index
(if (zerop reps-index) reps-max (1- reps-index)))
(setq replace (aref reps-vector reps-index))
(overlay-put overlay 'display replace))
((eq def 'help)
(with-output-to-temp-buffer "*Help*"
(princ
(concat
"Replace `" word "' with `" replace "'? Type\n\n"
(speck-keys-help speck-replace-query-keys)
"\nAnything else will accept the replacement and reread as command.\n"))
(with-current-buffer standard-output
(help-mode))))
(t
;; The mode-exited stuff is not clean but let's try
;; doing this as in `query-replace'.
(setq this-command 'mode-exited)
(setq unread-command-events
(append (listify-key-sequence key)
unread-command-events))
(setq change t))))
(cond
(change
(speck-replace-word from to word replace overlay property))
((overlayp overlay)
;; Install or restore overlay properties.
(overlay-put overlay 'display nil) ; Silly
(overlay-put overlay 'face 'speck-guess)))
(unless query (speck-marker-goto)))))))))
;; _____________________________________________________________________________
;;
;;; region specking
;; _____________________________________________________________________________
;;
(defun speck-region () ; Put this somewhere else <--------
"Speck region (when mark is active) or current buffer (otherwise)."
(interactive)
(let (start end)
(setq speck-suspension-list nil)
(save-restriction
(widen)
(if mark-active
(progn
(setq start (min (point) (mark)))
(setq end (max (point) (mark))))
(setq start (point-min))
(setq end (point-max)))
(with-buffer-prepared-for-specking
(speck-remove-property (point-min) (point-max)))
(speck-delete-overlays))))
(defun speck-change-aspell-dictionary ()
(interactive)
(speck-buffer '-))
(defvar speck-filter-mode-history nil)
(defun speck-set-filter-mode ()
(interactive)
(let ((filter-mode
(completing-read
(concat
"Enter filter-mode (RET for default, SPC to complete): ")
(list "Default" "None" "URL" "Email" "SGML" "TeX")
nil t nil 'speck-filter-mode-history)))
(if (or (string-equal filter-mode "")
(string-equal filter-mode "Default"))
;; Consider resetting to saved value here, maybe with prefix argument.
(setq filter-mode (default-value 'speck-filter-mode))
(setq filter-mode (intern filter-mode)))
(if (eq filter-mode speck-filter-mode)
(message "Filter-mode \"%s\" unchanged" filter-mode)
(setq speck-filter-mode filter-mode)
(when speck-mode
(speck-deactivate)
(setq speck-retain-local-variables t)
(speck-activate)))))
;; _____________________________________________________________________________
;;
;;; multi-language
;; _____________________________________________________________________________
;;
(defun speck-multi-set-region (from to &optional dictionary)
"Set 'speck property for region between FROM and TO to DICTIONARY.
If DICTIONARY is nil or omitted remove speck property from region."
(if speck-save-permanent
;; Make this a permanent change, not undoable.
(with-buffer-prepared-for-specking
(if dictionary
(progn
(setq speck-multi t)
(speck-put-speck from to dictionary))
(remove-text-properties from to '(speck nil)))
(remove-text-properties from to '(specked nil))
;; Assert this gets saved before the buffer gets killed.
(speck-kill-buffer-add))
(if dictionary
(progn
(setq speck-multi t)
(speck-put-speck from to dictionary))
(remove-text-properties from to '(speck nil)))
(with-buffer-prepared-for-specking
(remove-text-properties from to '(specked nil))))
(speck-delete-overlays from to)
(dolist (window (get-buffer-window-list (current-buffer)))
(speck-window-add window)))
;; `speck-multi-set' permits to specify the dictionary - actually a multi
;; property since we permit `--' here too - for the next self-insertion. For
;; this purpose it assigns the property to `speck-multi-pre-property' and adds
;; `speck-multi-pre-command' to `pre-command-hook'. `speck-multi-pre-command'
;; copies the property to `speck-multi-post-property', adds
;; `speck-multi-post-command' to `post-command-hook', and removes itself from
;; `pre-command-hook'. Any self-insertion command executed now will find the
;; property in `speck-multi-post-property' and assign its value to the text it
;; inserts. `speck-multi-post-command' will reset `speck-multi-post-property'
;; to nil regardless of whether a property was assigned and remove itself from
;; `post-command-hook'. Simpler solutions welcome.
(defun speck-multi-pre-command ()
"Set up speck multi property for this command."
(setq speck-multi-post-property speck-multi-pre-property)
(setq speck-multi-pre-property nil)
(add-hook 'post-command-hook 'speck-multi-post-command nil t)
(remove-hook 'pre-command-hook 'speck-multi-pre-command t))
(defun speck-multi-post-command ()
"Remove speck multi property."
(setq speck-multi-post-property nil)
(remove-hook 'post-command-hook 'speck-multi-post-command t))
(defun speck-multi-set (arg)
"Set dictionary for part of current buffer.
With prefix ARG set proceed as follows: If ARG is not a number
deactivate specking. If ARG is zero use the default dictionary. For
any other number check `speck-dictionary-names-alist' whether an entry
for that number exists. If an entry exists use the associated
dictionary. Otherwise prompt the user for a dictionary.
If the mark is active this command sets the dictionary for the region.
Otherwise, this command will set the dictionary for text that will be
inserted by the next \(interactively called) command."
(interactive "P")
(let ((at (point))
(dictionary-names
(cond
((eq speck-default-checker 'Aspell)
speck-aspell-dictionary-names)
((eq speck-default-checker 'Ispell)
speck-ispell-dictionary-names)))
from to dictionary-name)
(if mark-active
(progn
;; If the mark is active use the region.
(setq from (min (point) (mark)))
(setq to (max (point) (mark))))
;; Otherwise set this up for things to come.
(setq speck-multi-pre-property t))
(cond
((and arg (not (numberp arg)))
;; Set to no-check.
(if speck-multi-pre-property
(setq speck-multi-pre-property '--)
(speck-multi-set-region from to '--))
(message "Reset to no-check"))
((and arg (zerop arg))
;; Reset to default.
(if speck-multi-pre-property
(setq speck-multi-pre-property 'default)
(speck-multi-set-region from to))
(message "Reset to default"))
((and arg
(setq dictionary-name
(cdr (assoc arg speck-dictionary-names-alist))))
;; We have an entry for ARG in `speck-dictionary-names-alist', use
;; associated dictionary-name.
(if (member dictionary-name dictionary-names)
(let ((dictionary (intern dictionary-name)))
(if speck-multi-pre-property
(setq speck-multi-pre-property dictionary)
(speck-multi-set-region from to dictionary))
(message "Set to dictionary \"%s\"" dictionary-name))
(setq speck-multi-pre-property nil)
(message "Can't find dictionary \"%s\"" dictionary-name)))
(t
(setq dictionary-name (read-from-minibuffer "Dictionary: "))
(cond
((or (not dictionary-name) (string-equal dictionary-name ""))
;; Reset to default.
(if speck-multi-pre-property
(setq speck-multi-pre-property 'default)
(speck-multi-set-region from to))
(message "Reset to default"))
((string-match "--" dictionary-name)
;; Set to no-check.
(if speck-multi-pre-property
(setq speck-multi-pre-property '--)
(speck-multi-set-region from to '--))
(message "Set to no-check"))
((member dictionary-name dictionary-names)
(let ((dictionary (intern dictionary-name)))
;; Set dictionary for region.
(if speck-multi-pre-property
(setq speck-multi-pre-property dictionary)
(speck-multi-set-region from to dictionary)
(message "Set to dictionary \"%s\"" dictionary-name))))
(t
(setq speck-multi-pre-property nil)
(message "Can't find dictionary \"%s\"" dictionary-name)))))
(when speck-multi-pre-property
;; We can't do this earlier since `read-from-minibuffer' would execute it.
(add-hook 'pre-command-hook 'speck-multi-pre-command nil t))))
;; Observe: Inserting _parts_ of a file into another file will certainly cause
;; troubles (although the 'eof approach could handle it - we would have to go to
;; the file, look whether it contains the speck-eof line, and propertize the
;; inserted text accordingly).
(defun speck-multi-write (from to buffer)
"Return list of annotations for encoding the region.
FROM and TO denote start and end of the region for buffer BUFFER."
(let (property list)
(cond
((or (not speck-multi) (not (speck-save-confirm))))
((eq speck-multi-style 'eof)
;; This is certainly wrong for `to' /= `point-max'.
(let ((start from))
(save-excursion
(save-restriction
(narrow-to-region from to)
;; Create `list' as (3 7 "fr" 234 256 "it" ...) that is a list of
;; <start end dictionary> triples. Use strings to encode language
;; properties in order to `read' back and subsequently `intern' them
;; in a simple fashion.
(while (setq from (text-property-not-all from to 'speck nil))
(setq property (speck-get-speck from))
(if (eq property '==)
;; Do not record `==' properties (we do record `--'
;; properties, though).
(goto-char
(setq from (or (next-single-property-change from 'speck)
to)))
(setq list (cons from list))
(setq list (cons
(progn
(goto-char
(setq from (or (next-single-property-change
from 'speck)
to)))
from)
list))
(setq list (cons property list))))
(when list
(setq list
(list
(cons
to ; The position passed to `write-region-annotate-functions' ...
(concat ; ... and the string.
;; The following will add a newline at eob unless there's one.
(unless (save-excursion (goto-char to) (bolp)) "\n")
;; Insert a comment starter, if possible, to avoid that other
;; applications choke at our properties.
(or comment-start "")
;; Add a `print'ed version of `list'.
"<<speck-eof"
(let (print-level print-length)
(prin1-to-string (nreverse list)))
;; Mark this appropriately.
"speck-eof>>"
;; Insert a comment ender or a newline
(cond
((string-equal comment-end "") "\n")
((string-equal (substring comment-end -1) "\n")
;; Is this case reasonable?
comment-end)
(t (concat comment-end "\n"))))))))))))
(speck-multi-style
(save-excursion
(save-restriction
(narrow-to-region from to)
(while (setq from (text-property-not-all from to 'speck nil))
(setq property (speck-get-speck from))
(if (eq property '==)
(goto-char
(setq from (or (next-single-property-change from 'speck)
to)))
(setq property (symbol-name property))
;; Disallow colons in Aspell's dictionary names.
(setq list (cons (cons from (concat "<<speck-" property ":"))
list))
(goto-char
(setq from (or (next-single-property-change from 'speck)
to)))
(setq list (cons (cons from (concat "speck-" property ">>"))
list))))
(when list
(setq list (cons (cons (point-max) "<<speck-nil:speck-nil>>") list)))))))
(when list
;; This should eliminate ourselves when `list' is empty. Hopefully, a
;; language called `nil' will not be invented ever.
(comment-normalize-vars)
(cons
(cons
(point-min)
(concat
(comment-padright comment-start 1) " "
(if (eq speck-multi-style 'eof)
"<<speck-bof:speck-eof>>"
"<<speck-bof:speck-nil>>")
(comment-padleft comment-end 1)
(unless (string-equal comment-end "\n") "\n")))
(nreverse list)))))
;;;###autoload
(defun speck-multi-read (begin end)
"Convert annotations to properties.
BEGIN and END denote the region to convert."
(with-buffer-unmodified
;; We cannot generally flush `buffer-undo-list' but we can avoid making
;; an entry when it's nil, the following must be largely handled by
;; `format-decode' or `insert-file-contents'.
(let ((offset (- begin (point-min)))
(undo-list buffer-undo-list)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
(inhibit-modification-hooks t)
(inhibit-field-text-motion t)
first-change-hook after-change-functions
style)
(save-excursion
(cond
((and (goto-char begin)
(not (looking-at
".\\{1,12\\}\\(?:<<speck-bof:speck-\\(eof\\)\\|nil>>\\)")))
;; This should not occur.
(error "Speck annotations corrupted"))
((and (setq style (match-beginning 1))
(not (speck-save-confirm))
(if (yes-or-no-p "Modifying this buffer will lose speck multi information, continue? ")
(save-restriction
;; The following will work iff `insert-file-contents' is
;; fixed !!!!!
(narrow-to-region begin end)
;; Note: We do have to delete the line containing our header
;; here since otherwise format will ask us forever. If you
;; want to see this line you have to use
;; `find-file-literally' instead.
(delete-region begin (line-beginning-position 2))
(point-max))
;; Better signal an error and quit.
(error "Canceled"))))
(t
(save-restriction
;; The following will work iff `insert-file-contents' is fixed !!!!!
(narrow-to-region begin end)
;; Delete this line.
(delete-region begin (line-beginning-position 2))
(setq speck-multi t)
(add-to-list 'buffer-file-format 'speck)
(if style
;; eof case
(let (list)
(goto-char (point-max))
;; We should be right after <<speck-eof(...)speck-eof>> here.
(if (re-search-backward "speck-eof>>" nil t)
(progn
(backward-sexp)
(setq list (read (current-buffer)))
;; If someone modified our text she's on her own.
(delete-region
(line-beginning-position) (line-beginning-position 2))
(if (zerop offset)
;; The "normal" or "reverting" case.
(while list
(speck-put-speck
(pop list) (pop list) (pop list)))
;; The "insert-file" not at `point-min' case.
(while list
(speck-put-speck
(+ (pop list) offset) (+ (pop list) offset)
(pop list)))))
(error "Speck annotations corrupted")))
;; nil case
(let (from property)
(goto-char (point-min))
;; Consider [:alpha:] here.
(while (re-search-forward "<<speck-\\([a-zA-Z-_0-9]+\\):" nil t)
(setq property (match-string-no-properties 1))
(delete-region (match-beginning 0) (point))
(setq from (point))
(if (re-search-forward (concat "speck-" property ">>"))
(progn
(delete-region (match-beginning 0) (point))
(speck-put-speck from (point) (intern property)))
;; The following message might not be very consolidating.
(error
(concat "Missing speck-" property ">>"))))))
;; Reset `buffer-undo-list', if possible.
(unless undo-list (setq buffer-undo-list nil))
(point-max))))))))
;; _____________________________________________________________________________
;;
;;; case auto-correction
;; _____________________________________________________________________________
;;
(defun speck-auto-correct-case (old from to word)
(let (corrected guesses)
(with-current-buffer (process-buffer speck-process)
;; `point' must be after the colon.
(forward-char)
(while (re-search-forward "\\(.*?\\)\\(?:, \\|\n\n\\)" nil t)
(setq guesses (cons (match-string-no-properties 1) guesses)))
(setq guesses (nreverse guesses)))
(cond
((eq speck-auto-correct-case 'two)
(when (and (> (- to from) 1)
;; Replace `word' if downcasing its second letter yields a word
;; in `guesses'.
(not (equal (aref word 0) (downcase (aref word 0))))
(not (equal (aref word 1) (downcase (aref word 1)))))
(let ((replace (concat
(substring word 0 1)
(downcase (substring word 1 2))
(substring word 2))))
(when (catch 'found
(dolist (guess guesses)
(when (string-equal replace guess)
(throw 'found t))))
(speck-replace-word
from to word replace nil
(when speck-multi (speck-get-speck from)))
(setq corrected t)))))
((eq speck-auto-correct-case 'one)
;; Replace `word' if changing its case yields a unique word in
;; `guesses'.
(let ((cased (downcase word))
replace)
(when (catch 'failed
(dolist (guess guesses replace)
(when (eq (compare-strings
cased 0 nil guess 0 nil t)
t)
(if replace
(throw 'failed nil)
(setq replace guess)))))
(speck-replace-word
from to word replace nil
(when speck-multi (speck-get-speck from)))
(setq corrected t))))
((eq speck-auto-correct-case t)
;; Replace `word' if changing its case yields a word in
;; `guesses'.
(let* ((cased (downcase word))
(replace
(catch 'found
(dolist (guess guesses)
(when (eq (compare-strings
cased 0 nil guess 0 nil t)
t)
(throw 'found guess))))))
(when replace
(speck-replace-word
from to word replace nil
(when speck-multi (speck-get-speck from)))
(setq corrected t)))))
(when corrected
(speck-put-property old to))
corrected))
;; _____________________________________________________________________________
;;
;;; auto-correct after a buffer change
;; _____________________________________________________________________________
;;
(defvar speck-auto-correct-regexp
"\\(?:\\sw\\(#\\)[st]\\>\\)")
(defvar speck-auto-correct-replace
(vector "" "'"))
(defun speck-auto-correct-after-change ()
(save-excursion
(when (and (eq this-command 'self-insert-command)
(looking-back speck-auto-correct-regexp))
(cond
((match-beginning 1)
(replace-match (aref speck-auto-correct-replace 1) nil nil nil 1))))))
;; _____________________________________________________________________________
;;
;;; provide us
;; _____________________________________________________________________________
;;
(provide 'speck)
;; _____________________________________________________________________________
;;
;;; beyond this line are monsters
;; _____________________________________________________________________________
;;
;; The following may be asked even _after_ the user has answered "no" in a
;; "Buffer foo.changed modified; kill anyway? (yes or no) yes" dialogue. There
;; doesn't seeem a better solution than asking twice in that case.
;; Unfortunately a file change might not even occur.
(defun speck-kill-buffer-query ()
"Try to save local specifications if `speck-kill-buffer-query' is non-nil."
(when (and speck-kill-buffer-query (speck-save-confirm))
(set-buffer-modified-p t)
(save-buffer))
(setq speck-kill-buffer-query nil)
(setq speck-kill-buffer-query-list
(delq (current-buffer) speck-kill-buffer-query-list))
(remove-hook 'kill-buffer-query-functions 'speck-kill-buffer-query t)
t)
(defun speck-kill-emacs-query ()
"Assert all involved buffers are queried before killing Emacs.
This assures that local specifications get saved before Emacs is killed.
Called by `kill-emacs-query-functions'."
(dolist (buffer speck-kill-buffer-query-list)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(speck-kill-buffer-query))))
t)
(defun speck-kill-buffer-add ()
"Assert that current buffer is queried before getting killed."
(when (and speck-save-ask (not speck-kill-buffer-query))
(add-to-list 'buffer-file-format 'speck)
(setq speck-kill-buffer-query t)
(unless (memq (current-buffer) speck-kill-buffer-query-list)
(setq speck-kill-buffer-query-list
(cons (current-buffer) speck-kill-buffer-query-list)))
(add-hook 'kill-buffer-query-functions 'speck-kill-buffer-query nil t)
(add-hook 'kill-emacs-query-functions 'speck-kill-emacs-query)))
;; Parts of the following function were stolen from erc.el.
(defun speck-insert-string-noundo (string)
"As `insert' but don't allow undoing this and update `buffer-undo-list'.
All items in the buffer-undo-list referencing a position after `point'
are updated so that they can be undone without undoing the present
insertion."
(let ((amount (length string)))
(with-buffer-prepared-for-specking
(insert string))
(unless (or (zerop amount) (atom buffer-undo-list))
(dolist (entry buffer-undo-list)
(cond
((and (integerp entry) (< (point) entry))
;; POSITION
(incf entry amount))
((or (atom entry) (eq (car entry) t) (markerp (car entry)))
;; undo boundary: `nil'
;; change from "unmodified" status: (t HIGH . LOW)
;; marker adjustment: (MARKER . DISTANCE)
nil)
((and (integerp (car entry)) (< (point) (car entry)))
;; insertion: (BEG . END)
(incf (car entry) amount)
(incf (cdr entry) amount))
((and (stringp (car entry)) (< (point) (cdr entry)))
;; deletion: (TEXT . POSITION)
(incf (cdr entry) (if (natnump (cdr entry)) amount (- amount))))
((and (null (car entry)) (< (point) (car (nthcdr 3 entry))))
;; text property modification: (nil PROPERTY VALUE BEG . END)
(let ((cons (nthcdr 3 entry)))
(incf (car cons) amount)
(incf (cdr cons) amount))))))))
(defun speck-save-string (string)
"Insert STRING with `specked' and `==' properties set."
(let ((at (point)))
(cond
((eq speck-save-permanent t)
(with-buffer-prepared-for-specking
(insert string)))
((eq speck-save-permanent 'adjust)
(speck-insert-string-noundo string))
(t
(insert string)))
(with-buffer-prepared-for-specking
;; Never put this on the undo list.
(add-text-properties at (point) '(specked t speck ==)))))
(defun speck-save-word (word &optional dictionary)
"Save WORD in Local Words section.
Optional argument DICTIONARY means save in dictionary specific section."
(when (and speck-save-words (speck-save-confirm))
(save-excursion
(save-restriction
(widen)
(goto-char (point-max))
(let ((dictionary-name (when dictionary (symbol-name dictionary)))
at string found case-fold-search)
;; Search for Local Words section. The beginning of the last line of
;; that section must appear within the 3000 characters limit.
(cond
((re-search-backward speck-save-words-regexp (- (point-max) 3000) t)
;; `string' records any comment-start plus "local-words" string.
(let ((string (buffer-substring-no-properties
(line-beginning-position) (match-end 0))))
(setq at (line-beginning-position))
(if dictionary-name
;; Search for an entry for this dictionary.
(let ((regexp (concat
"[ \t]+(" (regexp-quote dictionary-name) "):")))
(while (and (progn
(goto-char (match-end 0))
(not (setq found (looking-at regexp))))
(progn
(beginning-of-line)
(re-search-backward
speck-save-words-regexp
(line-beginning-position 0) t))))
(if found
;; Corresponding dictionary entry found.
(if (<= (+ (- (line-end-position)
(line-beginning-position))
;; 80 is hard-coded here.
(current-column) 1 (length word)) 80)
;; Insert `word' before first entry on this line.
(progn
(goto-char (match-end 0))
(skip-chars-forward " \t")
(speck-save-string (concat word " ")))
;; Add word on new line.
(forward-line)
(speck-save-string (concat
string " (" dictionary-name "): " word
(when (stringp comment-end)
comment-end)))
;; Assert terminating newline.
(unless (bolp) (speck-save-string "\n")))
;; No dictionary entry found, add one at end of local
;; words section.
(goto-char at)
;; The following was `forward-line' before which added the
;; dictionary entry after an existing file entry. Don't
;; do that (for the moment, rather add it before the last
;; dictionary entry, if there's one).
(beginning-of-line)
(speck-save-string
(concat string " (" dictionary-name "): "
word (when (stringp comment-end) comment-end)))
;; Assert terminating newline.
(unless (bolp) (speck-save-string "\n"))))
;; No dictionary.
(while (and (progn
(goto-char (match-end 0))
(not (setq found (looking-at ":"))))
(progn
(beginning-of-line)
(re-search-backward
speck-save-words-regexp
(line-beginning-position 0) t))))
(if found
;; Corresponding dictionary entry found.
(if (<= (+ (- (line-end-position) (line-beginning-position))
;; 80 is hard-coded here.
(current-column) 1 (length word)) 80)
;; Insert `word' before first entry on this line.
(progn
(goto-char (match-end 0))
(skip-chars-forward " \t")
(speck-save-string (concat word " ")))
;; Add word on new line.
(forward-line)
(speck-save-string
(concat string ": " word
(when (stringp comment-end) comment-end)))
;; Assert terminating newline.
(unless (bolp) (speck-save-string "\n")))
;; No dictionary entry found, add one at end of local words
;; section.
(goto-char at)
(forward-line)
(speck-save-string
(concat string ": " word
(when (stringp comment-end) comment-end)))
;; Assert terminating newline.
(unless (bolp) (speck-save-string "\n"))))
t))
;; Go to minimum of known local positions.
((let* ((at (speck-min-of-list-and-point-max
(speck-local-positions))))
(goto-char at)
(speck-save-string (if (bolp) "\n" "\n\n"))
(speck-save-string
(concat speck-save-words-string
(when dictionary-name (concat " (" dictionary-name ")"))
": " word "\n\n"))
(forward-line -2)
(when comment-start
(let ((comment-style 'plain))
(comment-region
(line-beginning-position) (line-end-position))))
t))
(t (error "Failed to add word"))))))))
;, The following could be useful for reordering local words.
;; In the following, sorting should become optional, namely a predicate to
;; compare ä, ö, ü accordingly, t string-lessp, and nil as on file.
(defun speck-save-words-sort ()
"Write entire Local Words section from `speck-hash-table'."
(interactive)
(let* ((comment-style 'plain)
(comment-before (or comment-start ""))
(comment-after comment-end)
base-list other-lists string from at)
(maphash
(lambda (word value)
(cond
((eq value 'file)
(setq base-list (cons word base-list)))
((listp value)
(let* ((dictionary (car value))
(list (assoc dictionary other-lists)))
(if list
(setcdr list (cons word (cdr list)))
(setq other-lists
(cons (list dictionary word) other-lists)))))))
speck-hash-table)
(goto-char (point-max))
;; Apparently this will insert words somewhere at point-max, probably
;; after any local sections, fix that.
(let ((area (speck-local-positions))
to)
(if (nth 1 area)
;; Local Words section exists.
(let ((regexp
(concat "\\(?:" speck-save-words-regexp
"\\)\\(?::\\|[ \t]*([^)]+):\\)"))
(bound (line-beginning-position 0))
case-fold-search)
(setq to (point))
(while (re-search-backward regexp bound t)
;; Search first entry.
(setq bound (line-beginning-position 0)))
;; Delete all entries.
(delete-region (line-beginning-position) to)
(setq from (point)))
;; No Local Words section exists.
(setq from (speck-min-of-list-and-point-max
(speck-local-positions)))))
;; Insert new one.
(when base-list
(save-restriction
(narrow-to-region from from)
(princ (sort base-list 'string-lessp) (current-buffer))
(delete-char -1)
(insert "\n")
(goto-char (point-min))
(delete-char 1)
(let* ((string (concat speck-save-words-string ": "))
(fill-column (min 40 (- 80 (length string)))))
(fill-region (point-min) (point-max))
(goto-char (point-min))
(while (not (eobp))
(insert string)
(comment-region
(line-beginning-position) (line-end-position))
(forward-line)))))
(when other-lists
(dolist (list other-lists)
(save-restriction
(narrow-to-region (point) (point))
(princ (sort (cdr list) 'string-lessp) (current-buffer))
(delete-char -1)
(insert "\n")
(goto-char (point-min))
(delete-char 1)
(let* ((string
(concat speck-save-words-string " (" (car list) "): "))
(fill-column (min 40 (- 80 (length string)))))
(fill-region (point-min) (point-max))
(goto-char (point-min))
(while (not (eobp))
(insert string)
(comment-region
(line-beginning-position) (line-end-position))
(forward-line))))))
;; The following is not needed for a final writing, but for doing this
;; interactively.
(when (< from (point))
(with-buffer-prepared-for-specking
(add-text-properties from (point) '(specked t speck ==))))))
(defun speck-restore-words (&optional placebo)
"Restore Local Words.
Optional argument `placebo' non-nil means just assign speck properties."
(save-excursion
(save-restriction
(widen)
(let ((bound (- (point-max) 3000))
(regexp speck-save-words-regexp)
case-fold-search dictionary from to)
(goto-char (point-max))
(while (and speck-save-confirmed
(re-search-backward regexp bound t)
(speck-save-confirm))
(setq regexp
(regexp-quote (buffer-substring-no-properties
(line-beginning-position) (match-end 0))))
;; Set `from' and `bound' for next search, and `to' unless set.
(setq from (line-beginning-position))
(unless to (setq to (line-beginning-position 2)))
(setq bound (line-beginning-position 0))
(save-restriction
(narrow-to-region (match-end 0) (line-end-position))
(goto-char (point-max))
(when (looking-back (concat comment-end-skip "[ \t]*"))
;; Strip comment end sequence.
(narrow-to-region (point-min) (match-beginning 0)))
(goto-char (point-min))
;; Check for dictionary.
(cond
((looking-at ":[ \t]+")
(setq dictionary nil))
((looking-at "[ \t]+(\\(\\w\\w[^)]*\\)):[ \t]+")
;; No dictionary.
(setq dictionary (match-string-no-properties 1)))
(t (error "Malformed local words section")))
(goto-char (match-end 0))
(unless placebo
;; Process remainder of line.
(while (re-search-forward "[^ \t\f]+" nil t)
(speck-hash-restore
(buffer-substring-no-properties
(match-beginning 0) (match-end 0))
(or dictionary 'file)))))
;; Search again.
(goto-char from))
(when to
;; Mark local words as specked and ignorable.
(with-buffer-prepared-for-specking
(add-text-properties from to '(specked t speck ==))))))))
;;;;;;;;;;; The following are currently not used ;;;;;;;;;;;;;
(defun speck-set-html-mode ()
(interactive)
(with-current-buffer (process-buffer speck-process)
(erase-buffer))
(process-send-string speck-process "$$cr sug-mode\n")
(accept-process-output speck-process 0.1))
(defun speck-get-option (option)
(interactive "sOption: \n")
(unwind-protect
(progn
(process-put speck-process 'preempted t)
(with-current-buffer (process-buffer speck-process)
(erase-buffer))
(process-send-string speck-process (concat "$$cr " option "\n"))
(accept-process-output speck-process 0.1)
(with-current-buffer (process-buffer speck-process)
(message
"Value of %s is: %s" option
(buffer-substring
(point-min)
(progn
(goto-char (point-max)) (skip-chars-backward "\n") (point))))))
(process-put speck-process 'preempted nil)))
(defun speck-set-option (option value)
(interactive "sOption: \nsValue: ")
(unwind-protect
(progn
(process-put speck-process 'preempted t)
(with-current-buffer (process-buffer speck-process)
(erase-buffer))
(process-send-string speck-process (concat "$$cs " option "," value "\n"))
(process-send-string speck-process (concat "$$cr " option "\n"))
(accept-process-output speck-process 0.1)
(with-current-buffer (process-buffer speck-process)
(message
"Value of %s set to: %s" option
(buffer-substring
(point-min)
(progn
(goto-char (point-max)) (skip-chars-backward "\n") (point))))))
(process-put speck-process 'preempted nil)))
;;;;;;;;;;;;;;;; Not used (till here) ;;;;;;;;;;;;;
;; (1) Default value.
;; (2) Language dependent value (coding-system, ...).
;; (3) File-local value.
;; (4) Buffer-local value (customizably permanent-local), "set-option".
;; (5) Text-local value.
;; (6) Value implied by an "extra argument" (speck won't control these).
;; (a) Default arguments (customizable).
;; (b) Language dependent arguments (customizable).
;; (c) Buffer-dependent arguments ("set-option").
(defun slp ()
(interactive)
(message "... %s" (speck-local-positions)))
(defun speck-local-positions ()
"Get positions of file local specifications for current buffer.
Return value is a list of six elements:
0. Position of last page break.
1. Beginning of line following Local Words section.
2. Start of Local Dictionary line.
3. Start of Local Filter Mode line.
4. Start of Local Variables section.
5. Position before comments within 3000 characters limit or `point-max'
(nil if at least one of the preceding elements is non-nil)."
(let ((case-fold-search t)
;; case-folding is needed because `hack-local-variables' seeems to
;; allow it, it's not awfully nice, though.
(regexp
(concat "\\(^\^L\\)"
"\\|\\(" speck-save-words-regexp "\\)"
"\\|\\(" speck-save-dictionary-regexp "\\)"
"\\|\\(" speck-save-filter-mode-regexp "\\)"
"\\|\\(Local " "Variables:\\)"))
(bound (max (- (point-max) 3000) (point-min)))
page-break words dictionary filter-mode variables state)
(save-excursion
(save-restriction
(widen)
(narrow-to-region bound (point-max))
(goto-char (point-max))
(set-match-data nil)
(while (and (not (and words dictionary filter-mode variables))
(re-search-backward regexp nil t))
(cond
((match-beginning 1)
;; A page-break outside any comment or string.
(unless (or page-break
(let ((state (syntax-ppss (point))))
(or (nth 3 state) (nth 4 state))))
(setq page-break (line-beginning-position 2))))
((match-beginning 2)
(unless words
(setq words (line-beginning-position 2))))
((match-beginning 3)
(setq dictionary (line-beginning-position)))
((match-beginning 4)
(setq filter-mode (line-beginning-position)))
((match-beginning 5)
(setq variables (line-beginning-position)))))
(if (or page-break words dictionary filter-mode variables)
(list page-break words dictionary filter-mode variables nil)
(widen)
(narrow-to-region bound (point-max))
(goto-char (point-max))
(forward-comment (- (buffer-size)))
;; Are we always outside a comment here?
(skip-chars-forward " \n\t\f")
(skip-chars-backward " \t")
(list nil nil nil nil nil
(if (and (bolp)
;; Avoid messing up an existing comment.
(not (nth 4 (syntax-ppss (point)))))
(point)
;; Before all comments at buffer-end within 3000 characters
;; limit (hopefully).
(point-max))))))))
(defun speck-min-of-list-and-point-max (list)
"Return minimum of elements of list LIST.
Ignores elements whose value is nil. When all elemensts are nil return
`point-max' of current buffer."
(let ((min (point-max)))
(dolist (elt list min)
(when elt (setq min (min elt min))))))
(defun speck-save-options ()
"Save speck options."
(unless (eq speck-dictionary speck-saved-dictionary)
(speck-save-variable
speck-save-dictionary-regexp speck-save-dictionary-string
speck-dictionary 2)
(setq speck-saved-dictionary speck-dictionary))
(unless (eq speck-filter-mode speck-saved-filter-mode)
(speck-save-variable
speck-save-filter-mode-regexp speck-save-filter-mode-string
(symbol-name speck-filter-mode) 3)
(setq speck-saved-filter-mode speck-filter-mode)))
(defun speck-save-variable (regexp string value elt)
"Save local variable.
REGEXP must denote the corresponding \"Local ...\" text, STRING the
\"Local ...\" string to insert, VALUE the value, and ELT the element
position \(counting from zero\) returned by `speck-local-positions'."
(save-excursion
(save-restriction
(widen)
(let* ((area (speck-local-positions))
(min-of (speck-min-of-list-and-point-max area))
at)
(narrow-to-region
(or (nth elt area) min-of)
(if (nth elt area)
(save-excursion
(goto-char (nth elt area))
(line-beginning-position 2))
min-of))
(goto-char (point-min))
(if (re-search-forward regexp nil t)
;; Replace old value.
(progn
(delete-region
(progn (skip-chars-forward " \t") (point))
(progn (skip-chars-forward "^ \t\n") (point)))
(setq at (point))
(insert value)
(with-buffer-prepared-for-specking
(speck-multi-set-region at (point) '--)))
;; Insert new value
(setq at (point))
(insert string " " value)
(let* ((comment-style 'plain)
(comment-start (or comment-start " ")))
(comment-region (line-beginning-position) (point))
(unless (bolp) (insert "\n"))
(with-buffer-prepared-for-specking
(speck-multi-set-region at (point) '--))))))))
(defun speck-restore-options (&optional placebo)
"Restore variables from file.
Optional argument `placebo' non-nil means just assign speck properties."
;; placebo non-nil might clash with confirming, not serious but ...
(let ((bound (- (point-max) 3000))
dictionary filter-mode)
(save-excursion
;; Dictionary.
(goto-char (point-max))
(when (and speck-save-confirmed
(re-search-backward
(concat "\\(?:" speck-save-dictionary-regexp
"\\) *\\([^ \t\f\n\"]+\\)") bound t)
(speck-save-confirm))
(with-buffer-prepared-for-specking
(add-text-properties
(line-beginning-position) (line-end-position)
'(specked t speck ==)))
(unless placebo
(setq dictionary (match-string-no-properties 1))
(cond
((assoc dictionary (speck-aspell-dictionary-names-and-aliases))
(setq speck-saved-dictionary (intern dictionary)))
((catch 'found
(dolist (dictionary (speck-aspell-dictionary-names-and-aliases))
(when (member speck-saved-dictionary (nth 2 dictionary))
(setq speck-saved-dictionary (intern (nth 0 dictionary)))
(throw 'found t)))))
((assoc dictionary (speck-ispell-dictionary-alist))
(setq speck-saved-dictionary (intern dictionary)))
((let ((entry (rassoc dictionary (speck-ispell-dictionary-alist))))
(when entry
(setq speck-saved-dictionary (intern (car entry))))))
(t
(message "Invalid local dictionary %s" dictionary)))))
;; Filter-mode.
(goto-char (point-max))
(when (and speck-save-confirmed
(re-search-backward
(concat "\\(?:" speck-save-filter-mode-regexp
"\\) *\\([^ \t\f\n\"]+\\)") bound t)
(speck-save-confirm))
(with-buffer-prepared-for-specking
(add-text-properties
(line-beginning-position) (line-end-position)
'(specked t speck ==)))
(unless placebo
;; Check for validity ..... <--------
(setq speck-saved-filter-mode (intern (match-string-no-properties 1))))))))
(defvar message-signature-separator)
(defun speck-email-region ()
"Reset regions for mail mode."
(interactive)
(let* ((body-start
(save-excursion
(goto-char (point-min))
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$") nil t)
(point)))
(subject-start
(when (> body-start (point-min))
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^Subject:" nil t)
(point)))))
(subject-end
(when subject-start
(save-excursion
(goto-char subject-start)
(line-end-position))))
(body-end
(save-excursion
(goto-char (point-max))
(re-search-backward message-signature-separator nil t)
(point))))
;;; (message "s-s %s ... s-e %s ... b-s %s ... b-e %s"
;;; subject-start subject-end body-start body-end)
(if subject-end
(progn
(speck-multi-set-region (point-min) subject-start '==)
(speck-multi-set-region subject-end body-start '==))
(speck-multi-set-region (point-min) body-start '==))
(speck-multi-set-region body-end (point-max) '==)))
(defun speck-put-speck (from to prop)
"Assign speck property PROP to text from FROM to TO."
(put-text-property from to 'speck prop))
(defun speck-get-speck (at)
"Return speck property at AT."
(get-text-property at 'speck))
;; _____________________________________________________________________________
;;
;;; Ispell
;; _____________________________________________________________________________
;;
(defgroup speck-ispell nil
"Ispell related options."
:group 'speck)
(defcustom speck-ispell-program
(locate-file "ispell" exec-path exec-suffixes 'file-executable-p)
"Name of Ispell executable."
:type 'file
:group 'speck-ispell)
(defun speck-ispell-vv ()
"Return Ispell settings.
0 ... library directory
1 ... default dictionary"
(condition-case nil
(with-temp-buffer
(let (v1 v2 v3)
(call-process speck-ispell-program nil t nil "-vv")
(goto-char (point-min))
(when (re-search-forward "BINDIR = \\\"\\([^ \t\n]*\\)\\\"" nil t)
(setq v1 (buffer-substring (match-beginning 1) (match-end 1))))
(when (re-search-forward "LIBDIR = \\\"\\([^ \t\n]*\\)\\\"" nil t)
(setq v2 (buffer-substring (match-beginning 1) (match-end 1))))
(goto-char (point-min))
(when (re-search-forward "DEFHASH = \\\"\\([^ \t\n]*\\)\\.hash?\\\"" nil t)
(setq v3 (buffer-substring (match-beginning 1) (match-end 1))))
(list v1 v2 v3)))
(error nil)))
(defvar speck-ispell-vv (speck-ispell-vv)
"Value returned by `speck-ispell-vv'.")
(defcustom speck-ispell-binary-directory
(let ((directory (nth 0 speck-ispell-vv)))
(cond
((file-directory-p directory)
directory)
((file-directory-p (file-name-directory speck-ispell-program))
(file-name-directory speck-ispell-program))))
"Name of Ispell binary directory."
:type 'file
:group 'speck-ispell)
(defcustom speck-ispell-library-subdirectories t
"Non-nil means search dictionaries in subdirectories of `speck-ispell-library-directory'.
Nil means search within `speck-ispell-library-directory'."
:type 'boolean
:group 'speck-ispell)
(defcustom speck-ispell-library-directory
(let ((directory (nth 1 speck-ispell-vv)))
(cond
((file-directory-p directory)
directory)
((file-directory-p (file-name-directory speck-ispell-program))
(file-name-directory speck-ispell-program))))
"Name of Ispell library directory.
Directory where Ispell dictionaries reside. If
`speck-ispell-library-subdirectories' is non-nil speck searches
dictionaries in subdirectories of this directory."
:type 'file
:group 'speck-ispell)
(defun speck-ispell-dictionary-alist ()
"Return alist of language codes and Ispell dictionary names."
(cond
((and speck-ispell-library-directory
(file-exists-p speck-ispell-library-directory)
(let ((names (directory-files
speck-ispell-library-directory nil "\\.hash?$"))
alist aname)
(dolist (name names)
(setq aname (downcase (file-name-sans-extension name)))
(setq alist
(cons (or (rassoc aname speck-iso-639-1-alist)
(cons (substring aname 0 2) aname))
alist)))
(nreverse alist))))
((and speck-ispell-binary-directory
(file-exists-p speck-ispell-binary-directory))
;; This assumes that speck-ispell-binary-directory contains directories with
;; each directory containing the respective .hash files.
(let ((files (directory-files speck-ispell-binary-directory t))
alist aname)
(dolist (file files)
(when (and (not (string-equal file "."))
(not (string-equal file ".."))
(file-directory-p file))
(let ((names (directory-files file nil "\\.hash?$")))
(dolist (name names)
(setq aname (downcase (file-name-sans-extension name)))
(setq alist
(cons (or (rassoc aname speck-iso-639-1-alist)
(cons (substring aname 0 2) aname))
alist))))))
(nreverse alist)))))
;; We need an update function for this, otherwise the entries get lost when user
;; installs a new dictionary !!!
(defcustom speck-ispell-dictionary-alist (speck-ispell-dictionary-alist)
"List associating language code with Ispell dictionary names.
This list is generated from the option `speck-iso-639-1-alist' and the
dictionaries installed in `speck-ispell-library-directory'. If this
list contains two or more entries for the same language code speck-mode
may display the wrong language code in the mode-line. Hence, you should
make sure that every language code occurs once only in this list. The
preferred way to do this is by adding the correct association to
`speck-iso-639-1-alist'."
:type '(repeat
(cons :format "%v\n"
;; We could use a symbol here.
(string :format " %v" :size 2)
(string :format " %v" :size 20)))
:group 'speck-ispell)
(defun speck-ispell-dictionary-names ()
"Return list of Ispell's dictionary names."
(let (list)
(dolist (entry speck-ispell-dictionary-alist)
(setq list (cons (car entry) list)))
(nreverse list)))
(defvar speck-ispell-dictionary-names (speck-ispell-dictionary-names)
"List of Ispell's dictionary names.")
(defvar speck-ispell-non-dictionary-names nil
"List of dictionary names asked for but not provided by Ispell.")
(defvar speck-ispell-dictionary-names-history (speck-ispell-dictionary-names)
"History of entered Ispell dictionary names.")
(defcustom speck-ispell-default-dictionary-name
(let ((name (nth 2 speck-ispell-vv)))
(car (rassoc name speck-ispell-dictionary-alist)))
"Name of Ispell default dictionary.
The default dictionary is used for specking a buffer unless you specify
another dictionary via `speck-buffer' or a file-local variable."
:type `(radio
:indent 2
,@(mapcar
(lambda (entry)
(list 'const :format "%v \n" (car entry)))
speck-ispell-dictionary-alist))
:group 'speck-ispell)
;;; (defun speck-ispell-charsets ()
;;; "Works iff `speck-ispell-library-subdirectories' is non-nil."
;;; (let ((files (directory-files speck-ispell-library-directory t)) ; full names
;;; ini-file alist aname dictionary charset)
;;; (dolist (file files)
;;; (when (and (not (string-equal file "."))
;;; (not (string-equal file ".."))
;;; (file-directory-p file)
;;; (file-readable-p (setq ini-file (concat file "/ispell.ini"))))
;;; (with-temp-buffer
;;; (insert-file-contents ini-file)
;;; (goto-char (point-min))
;;; (when (re-search-forward "^\\[")
;;; (when (looking-at "\\([a-zA-Z]+\\)\\]")
;;; (setq language (match-string-no-properties 1))))
;;; (let ((names (directory-files file nil "\\.hash?$")))
;;; (dolist (name names)
;;; (setq aname (downcase (file-name-sans-extension name)))
;;; (setq alist
;;; (cons (or (rassoc aname speck-iso-639-1-alist)
;;; (cons (substring aname 0 2) aname))
;;; alist))))))
;;; (nreverse alist)))))
(defcustom speck-ispell-language-options
'(("de" iso-8859-1 nil t)
("en" iso-8859-1 nil nil)
("fr" iso-8859-1 nil nil)
("it" iso-8859-1 nil nil)
("ru" koi8-r nil nil))
"Ispell language options.
Its value is a list of five entries for each language recognized by
`speck-mode'.
\(1) The two letter ISO-639 language code. For a correspondence of this
code to the names of dictionaries in `speck-ispell-library-directory'
confer the option `speck-ispell-dictionary-alist'.
\(2) The coding system for sending text to and receiving text from the
Ispell process for this language.
\(3) A mimimum word length which tells Ispell to ignore words shorter
than that.
\(4) A run-together words flag telling Ispell whether words can be
strung together.
\(5) Extra Arguments passed to Aspell.
Specifying a value of \"None\" \(nil) for \(2)-(4) means do not pass a
value for this option to Aspell."
:type '(repeat
(list :tag "" :format "%v"
(string :tag "Language" :format "%t: %v\n" :size 2)
(choice :tag "Coding System" :format "%t: %[Choice%] %v\n"
(const :tag "None" nil)
(coding-system :tag "Coding System" :size 10 :value utf-8)
;; Leave this in: it might be useful when a user changes
;; this option and installs a new dictionary later.
(const :tag "Aspell" t))
(choice :tag "Minimum Word Length" :format "%t: %[Choice%] %v\n"
(const :tag "None" :format "%t" nil)
(integer :tag "Length" :format "%t: %v " :size 2))
(boolean :tag "Run-together Words")
(repeat :tag "Extra Arguments"
(string :format "%v\n" :size 40))))
:group 'speck-ispell)
(defcustom speck-ispell-coding-system nil
"Language independent coding system for communicating with Ispell.
`None' means accept the setting from `speck-ispell-language-options'.
Specifying a value here will override those settings."
:type '(choice (cons :tag "None" nil)
(coding-system :tag "Coding System" utf-8))
:group 'speck-ispell)
(defcustom speck-ispell-minimum-word-length nil
"Language independent mimimum word length.
`None' means accept the setting from `speck-ispell-language-options'.
Specifying a value here will override those settings."
:type '(choice (cons :tag "None" nil)
(integer :tag "Length" :format "%t: %v " :size 2))
:group 'speck-ispell)
(defcustom speck-ispell-run-together nil
"Language independent maximum nmber of run-together words.
`None' means accept the setting from `speck-ispell-language-options'.
Specifying a value here will override those settings."
:type 'boolean
:group 'speck-ispell)
(defcustom speck-ispell-extra-arguments nil
"Language independent arguments passed to Ispell process.
These arguments are passed to Ispell regardless of any other arguments.
Language dependent arguments can be supplied by customizing
`speck-ispell-language-options'."
:type '(repeat (string :tag "Argument" :format "%t: %v\n" :size 40))
:group 'speck-ispell)
(defun speck-ispell-start-process ()
"Start Ispell process."
;; `speck-dictionary' is the language code.
(let* ((code-name (symbol-name speck-dictionary))
(dictionary-name
(cdr (assoc code-name speck-ispell-dictionary-alist)))
(options (assoc code-name speck-ispell-language-options))
(coding-system (nth 1 options))
(minimum-word-length
;; A value specified in `speck-ispell-minimum-word-length' overrides
;; anything else.
(or speck-ispell-minimum-word-length
(when options (nth 2 options))))
(run-together
;; A value specified in `speck-aspell-maximum-run-together' overrides
;; anything else.
(or speck-ispell-run-together (nth 3 options)))
(extra-arguments (nth 4 options))
(arguments
(append
;; Pipe option and dictionary-name.
(list "-a" "-d" dictionary-name)
;; Minimum word length.
(when minimum-word-length
(list (concat "-W" (number-to-string minimum-word-length))))
;; Run-together words.
(if run-together (list "-C") (list "-B"))
;;; ;; Filter-mode, hanle this eventually.
;;; (unless (eq speck-filter-mode 'URL)
;;; (list (concat "--mode=" (downcase (symbol-name speck-filter-mode)))))
;;; ;; Specify directory where personal word lists reside.
;;; (when speck-aspell-home-dir
;;; (list "--home-dir"
;;; (convert-standard-filename speck-aspell-home-dir)))
;;; ;; The name of the personal word list (dictionary file).
;;; (when speck-personal-dictionary-file
;;; (list "--personal" speck-personal-dictionary-file))
;;; ;; The following is the Aspell standard, hence it's commented out.
;;; ;;; (list "--personal" (concat dictionary-name ".pws")))
extra-arguments
speck-ispell-extra-arguments))
(process (rassoc arguments speck-process-argument-alist))
;; An options should exist when a process exists, but be paranoid here.
(options (when process (assq (car process) speck-process-buffer-alist)))
process-connection-type)
(if (and process options)
;; Process and options exist.
(progn
(setq speck-process (car process))
(setcdr options (cons (current-buffer) (cdr options))))
;; No suitable process exists.
;;; (message "... %s" arguments) (sit-for 1)
(let ((default-directory
(if (and (file-directory-p default-directory)
(file-readable-p default-directory))
;; Defend against bad `default-directory'.
default-directory
(expand-file-name "~/"))))
(setq speck-process
(apply 'start-process "speck"
(generate-new-buffer "*speck-process-buffer*") ; use leading space <---
speck-ispell-program arguments)))
(setq speck-process-buffer-alist
(cons (cons speck-process (list (current-buffer)))
speck-process-buffer-alist))
(setq speck-process-argument-alist
(cons (cons speck-process arguments)
speck-process-argument-alist))
(setq speck-process-dictionary-alist
;; Buffer local.
(cons (cons speck-process speck-dictionary)
speck-process-dictionary-alist))
(set-process-query-on-exit-flag speck-process nil)
(when coding-system
(set-process-coding-system
speck-process coding-system coding-system)))))
^ permalink raw reply [flat|nested] 42+ messages in thread