gspell.el - german spell and grammar checking

[Sebastian Meisel]

flyspell in connection with either ispell or aspell is good.
But the spell-checking commands have some shortcommings.
In german there are e.g. many possibilities to create combounds.
Good luck there is flyspell-incorrect-hook. I started from that point
to enhance spellchecking in emacs.

As I use emacs mostly for typing LaTeX-files, I used the possibility to
mark the hyphenation of words. (Excuse my poor english. I use to speak
and write german generally.) So I check each part of the word.

Well I added some stuff, like the highlighting of the sentence, commata, 
the
checking of suffixes and prefixes and common mistakes.

Take a look at it, and give comments. I have good experiences with it 
for allmost
a year now. But there are probably a lot of things that can be done better.

;; gspell.el -- german spell an grammar checking

;; Copyright (C) 2007

;; Author: Sebastian Meisel <address@hidden>
;; Keywords: spell grammar german

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;; Usage:
;; This is alphacode but it works for me 'n' maybe for you.
;; Put (load "gspell") to your .emacs file.
;; Works with flyspell-mode using german8 dictionary.
;; Mark combounds by "-: Regierungs"-sitz
;; Words rejected by flyspell, but accepted by gspell are mark with green.
;; Fast switching between usenglish an german dictionary by <C-c i>.
;; Hide hyphenationmarks ("-, "=, \-) by <C-c C-o C-g>
;; Highlight sentences with some help for grammar checking toggled by 
<C-c C-g C-k>
;; Help with correct spacing of abbrevations an numbers toggled by <C-c 
C-g C-d>
;;

;; TODO:
;; doppelte Artikel in Relativsätzen.
;; lot's of other stuff.
;; better documentation

;; Code:

(message "Loading gspell: flyspell addon for german languague in 
(La)TeX-mode.")

(add-hook 'flyspell-incorrect-hook 'flyspell-zusammen())
;; Customize
(defgroup Gspell nil
"Flyspell addon for german languague in (La)TeX-mode."
:group 'Local)

(defcustom gspell-conjunction-list
'("der" "die" "das"
"was" "wie" "wer"
"wieso" "weshalb" "warum"
"dass" "denn" "weil" "damit" "um"
"wenn" "ob" "als" "indem"
"aber" "sondern" "dennoch" "trotzdem" "während"
"welche" "welcher" "welches"
"und"
"ja" "nein" "nun")
"List of conjunctions to highlight with commas"
:type '(repeat :tag "Konjunktion" (string))
:group 'Gspell)

(defcustom gspell-common-mistakes-list
'("in dem" "das selbe" "der selbe" "die selbe")
"List of conjunctions to highlight with commas"
:type '(repeat :tag "Fehler" (string))
:group 'Gspell)

(defcustom gspell-common-abbrevations-list
'("usw." "etc." "bzw.")
"List of three-letter-abbrevations to put secured space after them."
:type '(repeat :tag "Abkürzung" (string))
:group 'Gspell)

(defcustom gspell-suffix-list
'("keit" "heit" "tum" "ung" "schaft"
"ig" "ige" "iges" "igen"
"lich" "liche" "liches" "lichen"
"haft" "hafte" "haftes")
"List of common german suffixes."
:type '(repeat :tag "Suffix" (string))
:group 'Gspell)

(defcustom gspell-prefix-list
'("un" "anti" "prä" "post" "inter" "meta" "sub" "super" "ur")
"List of common prefixes."
:type '(repeat :tag "Präfix" (string))
:group 'Gspell)

(defcustom gspell-switch-dictionary-alt-dictionary
"english"
"Alternative dictionary to switch to by gspell-switch-dictionary"
:type '(:tag "Dictionary" (string))
:group 'Gspell)

(defface gspell-accepted-face
'((((class color)) (:foreground "DarkGreen" :bold nil : underline: t)) 
(t (:bold t)))
"Face used for a word accepted by Gspell."
:group 'Gspell)

;; Hack
(defun gspell-force-no-combining ()
"Forces disabling of -C flags for ispell german8 dictionary and load it."
(flyspell-mode 0)
(dolist (Woerterbuch ispell-dictionary-alist)
(if (string= (car Woerterbuch) "german8")
(dolist (Element Woerterbuch)
(if (listp Element)
(if (string= (car Element) "-C")
(setcar Element "-S")
))
)))
(setq ispell-dictionary "german8")
(flyspell-mode 1))

;; Functions
(defun gspell-switch-dictionary ()
"Switch between german and english dictionary."
(interactive)
(if (equal (symbol-value 'ispell-dictionary) "german8")
(setq ispell-dictionary gspell-switch-dictionary-alt-dictionary)
(setq ispell-dictionary "german8"))
(ispell-kill-ispell))


(defun flyspell-zusammen (beg end poss)
"This function is to be called by 'flyspell-incorrect-hook. It looks for 
german hyphenationmarks (\"-) and
checks if the 'misspelled words could be correct parts of combined word 
in german language."
(let ((temp-buffer (get-buffer-create " *flyspell-temp*")) accepted)
(if (consp poss)
(save-excursion
(copy-to-buffer temp-buffer beg end)
(goto-char beg)
(if (or (re-search-backward "\"-" (- beg 2) t)
(re-search-forward "\"-" (+ end 2) t)) ;; look for '"-
(save-excursion
(set-buffer temp-buffer)
(goto-char (point-min))
(setq word (buffer-string))
(when (or (member (capitalize word) (nth 2 poss))
(member word gspell-suffix-list)) (setq accepted t))
))
;; If part of the rejected word ends on '-s' or '-e' this might be
;; a "Bindelaut", try without it, or with -e replacing s:
;; Versicherung-s-betrug
;;
(progn (goto-char end)
(if (and (not accepted)
(re-search-forward "-" (+ end 2) t)
(re-search-backward "[se]" (1- end) t))
(save-excursion
(set-buffer temp-buffer)
(goto-char (point-min))
(setq word (capitalize (substring (buffer-string) 0 -1)))
(if (when (member word (nth 2 poss)) (setq accepted t))
t (when (member (concat word "e") (nth 2 poss))(setq accepted t)))
)))
(progn (goto-char end)
(if (and (re-search-forward "-" (+ end 2) t) ;;
(re-search-backward "[bcdfghjklmnpqrstvwx]" (1- end) t)) ;;
(save-excursion
(set-buffer temp-buffer)
(goto-char (point-min))
(setq word (capitalize (buffer-string)))
(when (member (concat word "e") (nth 2 poss)) (setq accepted t)))))
))
(when accepted
(let ((gspell-overlay (make-overlay beg end nil t nil)))
(overlay-put gspell-overlay 'face 'gspell-accepted-face)
) t)))

(defun gspell-hide-hyphens-buffer ()
"Show '|' instate of a hyphen, and '-' instate of '\"='."
(interactive)
(TeX-fold-buffer)
(save-excursion (re-search-forward "\\end{document}")
(while (re-search-backward "\\(\\\"-\\|\\\\-\\|\\\"=\\|--\\|\\\\,\\|\\\\ 
\\|\\\"`\\|\\\"'\\|\\\\\\\\\\|\\\\glq\\|\\\\grq\\)" nil t)
(let ((ov-start (match-beginning 0))
(ov-end (match-end 0))
(ov-string (match-string 0)))
(let ((priority (TeX-overlay-prioritize ov-start ov-end))
(ov (make-overlay ov-start ov-end (current-buffer) t nil)))
(overlay-put ov 'category 'TeX-fold)
(overlay-put ov 'priority priority)
(overlay-put ov 'evaporate t)
(overlay-put ov 'TeX-fold-type 'macro)
(when (string= ov-string "\\\\")
(progn (overlay-put ov 'TeX-fold-display-string-spec "¶")
(overlay-put ov 'display "¶")))
(when (or (string= ov-string "\"-")
(string= ov-string "\\-"))
(progn (overlay-put ov 'TeX-fold-display-string-spec "|")
(overlay-put ov 'display "|")))
(when (string= ov-string "\"=")
(progn (overlay-put ov 'TeX-fold-display-string-spec "-")
(overlay-put ov 'display "-")))
(when (string= ov-string "--")
(progn (overlay-put ov 'TeX-fold-display-string-spec "–")
(overlay-put ov 'display "–")))
(when (or (string= ov-string "\\,")
(string= ov-string "\\ "))
(progn (overlay-put ov 'TeX-fold-display-string-spec "_")
(overlay-put ov 'display "_")))
(when (string= ov-string "\"`")
(progn (overlay-put ov 'TeX-fold-display-string-spec "„")
(overlay-put ov 'display "„")))
(when (string= ov-string "\"'")
(progn (overlay-put ov 'TeX-fold-display-string-spec "“")
(overlay-put ov 'display "“")))
(when (string= ov-string "\\glq")
(progn (overlay-put ov 'TeX-fold-display-string-spec ",")
(overlay-put ov 'display ",")))
(when (string= ov-string "\\grq")
(progn (overlay-put ov 'TeX-fold-display-string-spec "‘")
(overlay-put ov 'display "‘")))
(when font-lock-mode
(overlay-put ov 'face TeX-fold-folded-face))
ov))
)))

;; hightlight commatas
(defface gspell-highlight-sentence-face
'((((class color)) (:background "LightGreen")) (t ()))
"Face used to highlight sentences with gspell."
:group 'Gspell)

(defface gspell-highlight-commata-face
'((((class color)) (:foreground "Red" :background "LightYellow" :bold t 
: underline: t)) (t (:bold t)))
"Face used to highlight commas with gspell."
:group 'Gspell)

(defvar gspell-overlay-list nil "List off overlays for comma highlighting")

(defvar gspell-comma-map
(let ((map (make-sparse-keymap)))
(define-key map "f" 'gspell-move-comma-forward)
map)
"Keymap for gspell minor-mode.")

(defconst gspell-satz-grenze 
"\\(\\.\\|\\?\\|\\!\\|\\:\\)\\([[:space:]]\\|\\\"\\)\\|[[:cntrl:]][[:cntrl:]]" 

"Regex to determin the border of a sentence.")

(defface gspell-highlight-conjuctions-face
'((((class color)) (:background "LightYellow" :bold t)) (t (:bold t)))
"Face used to highlight conjuctions by Gspell."
:group 'Gspell)

(defface gspell-highlight-common-mistakes-face
'((((class color)) (:background "Green" :box "Red" :bold t)) (t (:bold t)))
"Face used to highlight common mistakes from the 
gspell-common-mistakes-list by Gspell."
:group 'Gspell)


(defvar gspell-satz-ende (buffer-end 1)
"End of sentence.")

(defvar gspell-satz-anfang 1
"Beginning of sentence.")

(defun gspell-highlight-sentence ()
"Hightlight commatas, conjunctions and common mistakes in the current 
senctence"
(interactive)
(let ((hier (point)))
(save-excursion
(if (re-search-backward gspell-satz-grenze nil t 1)
(setq gspell-satz-anfang (match-end 0))
(setq gspell-satz-anfang 1))
(goto-char hier)
(if (re-search-forward gspell-satz-grenze nil t 1)
(setq gspell-satz-ende (+ (match-beginning 0) 1))
(setq gspell-satz-ende (buffer-end 1)))
(goto-char gspell-satz-ende)
(gspell-remove-overlays)
;; highligh sentence
(let ((ov (make-overlay gspell-satz-anfang gspell-satz-ende 
(current-buffer) t nil)))
(overlay-put ov 'face 'gspell-highlight-sentence-face)
(add-to-list 'gspell-overlay-list ov))
;; highlight commas
(while (re-search-backward "\\w\\(,[[:space:]]\\|;[[:space:]]\\)" 
gspell-satz-anfang t)
(let ((ov-start (match-beginning 1))
(ov-end (match-end 1)))
(let ((ov (make-overlay ov-start ov-end (current-buffer) t nil)))
(overlay-put ov 'face 'gspell-highlight-commata-face)
(overlay-put ov 'keymap 'gspell-comma-map)
(add-to-list 'gspell-overlay-list ov))))
;; highlight conjunctions
(dolist (conjunction gspell-conjunction-list)
(goto-char gspell-satz-ende)
(let ((this-conjunction (concat "\\b" conjunction "\\b")))
(while (re-search-backward this-conjunction gspell-satz-anfang t)
(let ((ov-start (match-beginning 0))
(ov-end (match-end 0)))
(let ((ov (make-overlay ov-start ov-end (current-buffer) t nil)))
(overlay-put ov 'face 'gspell-highlight-conjuctions-face)
(overlay-put ov 'keymap 'gspell-comma-map)
(add-to-list 'gspell-overlay-list ov))))
))
;; highlight common-mistakes
(dolist (mistakes gspell-common-mistakes-list)
(goto-char gspell-satz-ende)
(let ((this-mistake (concat "\\b" mistakes "\\b")))
(while (re-search-backward this-mistake gspell-satz-anfang t)
(let ((ov-start (match-beginning 0))
(ov-end (match-end 0)))
(let ((ov (make-overlay ov-start ov-end (current-buffer) t nil)))
(overlay-put ov 'face 'gspell-highlight-common-mistakes-face)
(overlay-put ov 'keymap 'gspell-comma-map)
(add-to-list 'gspell-overlay-list ov))))
))
)))

(defun gspell-move-comma-forward ()
"Move comma forward by word."
(interactive)
(message "Not yet impemented."))

(defun gspell-remove-overlays ()
"Remove all sentence-overlays from buffer."
(interactive)
(while gspell-overlay-list
(delete-overlay (car gspell-overlay-list))
(setq gspell-overlay-list (cdr gspell-overlay-list))))

(defvar gspell-sentence-highlighting nil)

(defun toggle-gspell-highlight-sentence ()
"Turn sentence highlighting on for checking"
(interactive)
(if (not gspell-sentence-highlighting)
(progn
(add-hook 'post-command-hook 'gspell-highlight-sentence nil t)
(setq gspell-sentence-highlighting t)
(message "%s" "Sentences are highlighted.")
)
(progn
(remove-hook 'post-command-hook 'gspell-highlight-sentence t)
(gspell-remove-overlays)
(setq gspell-sentence-highlighting nil)
(message "%s" "Sentence highlighting of.")
)))


;; set small spaces
(defun gspell-handle-spaces ()
"There are rules in german Punctation that require a special spacing. 
This function saves you a lot of typing:
E.g. it puts reduced space ('\,') in and a secured space after 
abbrevation (e.g. 'z.\,B.\ '), dates (2.\,2.\,2000\ ) and
ordinaries ('2.\ )."
(let ((hier (point)))
;; put '\,' between dot and ascii-chars."
(save-excursion
(if (re-search-backward "\\.\\([[:alpha:]]\\)" (- hier 2) t 1)
(replace-match ".\\\\,\\1")
))
;; put '\ ' after abbrevations like 'z.\,B.\ ' or 'd.\,h\ '.
(save-excursion
(if (and (eq (char-before) 32)
(re-search-backward "\\.\\\\," (- hier 6) t 1))
(progn
(goto-char (- hier 1))
(insert "\\"))
))
;; put '\ ' after dots after ordiniaries."
(save-excursion
(if (re-search-backward "\\([[:digit:]]+\\)\\.[[:space:]]" (- hier 3) t 1)
(replace-match "\\1.\\\\ ")
))
;; put '\,' after dots in dates."
(save-excursion
(if (re-search-backward 
"\\([[:digit:]]\\{1,2\\}\\)\\.\\([[:digit:]]\\{1,2\\}\\)\\.\\([[:digit:]]\\{4,4\\}\\)[[:space:]]" 

(- hier 11) t 1)
(replace-match "\\1.\\\\,\\2.\\\\,\\3\\\\ ")
))
;; put '\ ' after abbrevations like 'z.\,B.\ ' or 'd.\,h\ '.
(save-excursion
(if (re-search-backward "\\.\\.\\." (- hier 3) t 1)
(replace-match "\\\\dots")
))
;; put "\," between alpha-chars and digits
(save-excursion
(if (re-search-backward "\\([[:alpha:]]\\|-\\)\\([[:digit:]]\\)" (- hier 
2) t 1)
(replace-match "\\1\\\\,\\2")
))
(save-excursion
(if (re-search-backward "\\([[:digit:]]\\)\\([[:alpha:]]\\|-\\)" (- hier 
2) t 1)
(replace-match "\\1\\\\,\\2")
))
;; put '\ ' after know abbrevations from the 
gspell-common-abbrevations-list.
(dolist (abbrevations gspell-common-abbrevations-list)
(save-excursion
(let ((this-abbrevation (concat "\\b" abbrevations)))
(if (and (eq (char-before) 32)
(re-search-backward this-abbrevation (- hier 5) t))
(let ((abbrev-end (match-end 0)))
(goto-char abbrev-end)
(insert "\\"))
))))
))


(defvar gspell-handle-spaces nil "Is gspell's space-handling on or off?")

(defun toggle-gspell-handle-spaces ()
"Turn handling of dots on/off."
(interactive)
(if (not gspell-handle-spaces)
(progn
(add-hook 'post-command-hook 'gspell-handle-spaces nil t)
(setq gspell-handle-spaces t)
(message "Individueller Freiraum.")
)
(progn
(remove-hook 'post-command-hook 'gspell-handle-spaces t)
(setq gspell-handle-spaces nil)
(message "Schaff dir selber Raum!")
)))



;; Mode
(defvar gspell-minor-mode-map
(let ((map (make-sparse-keymap)))
;; (define-key map "." 'gspell-handle-dots)
(define-key map "\C-c\C-o\C-g" 'gspell-hide-hyphens-buffer)
(define-key map "\C-ci" 'gspell-switch-dictionary)
(define-key map "\C-c\C-g\C-k" 'toggle-gspell-highlight-sentence)
(define-key map "\C-c\C-g\C-d" 'toggle-gspell-handle-spaces)
map)
"Keymap for gspell minor-mode.")

(define-minor-mode gspell-mode
"Minor mode improving spellchecking and typing german text in (La)TeX-mode

It builds on flyspell using the 'flyspell-incorrect-hook and on AUCTeX 
using TeX-fold.

It makes typing of correct german abbrevations easier by inserting '\\,' 
after '.'
if no space or quotation mark ist following.

Basic Commands
===== ========
\\[gspell-switch-dictionary]\tswitch between german and english dictionary.
\\[gspell-hide-hypens-buffer]\thide hypens and some other symbols using 
TeX-fold.
\\[toggle-gspell-highlight-sentence]\t toggle sentence highlighting.
\\[toggle-gspell-handle-spaces]\ttoggle helper function for correct 
spaces for abbrevation and some other things.
"
:lighter " G"
:keymap gspell-minor-mode-map
(gspell-force-no-combining)
)