401 lines
17 KiB
EmacsLisp
401 lines
17 KiB
EmacsLisp
;;; rw-hunspell.el --- special functions for Hunspell in ispell.el
|
|
;;
|
|
;; Copyright (C) 2009 Ralf Wachinger
|
|
;;
|
|
;; Author: Ralf Wachinger <rwachinger@gmx.de>
|
|
;; Version: 0.2
|
|
;; Keywords: ispell
|
|
;; Compatibility: GNU Emacs 23.x
|
|
;;
|
|
;; This file is NOT part of GNU Emacs.
|
|
;;
|
|
;; This program 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
|
|
;; of the License, or (at your option) any later version.
|
|
;;
|
|
;; This program 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.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
;;
|
|
;;; Commentary:
|
|
;;
|
|
;; Additions for Hunspell, which find all existing Hunspell dictionaries
|
|
;; in the given directories, generate a special alist for Hunspell, and
|
|
;; optionally create a special menu for selecting the dictionaries.
|
|
;;
|
|
;; Save rw-hunspell.el in a convenient directory, preferably in
|
|
;; your `load-path'. Add the following to your `user-init-file':
|
|
;;
|
|
;; (require 'rw-hunspell)
|
|
;;
|
|
;; When the creation starts:
|
|
;; a) keyboard: 'M-x rw-hunspell-setup RET'
|
|
;; b) menubar: Tools --> Spell Checking --> Set up Hunspell
|
|
;; c) automatically when Hunspell is used the first time
|
|
;; d) `user-init-file', after setting the user options: (rw-hunspell-setup)
|
|
;; e) when `rw-ispell-change-dictionary' (see rw-ispell.el) is called
|
|
;;
|
|
;; ESSENTIAL: `ispell-program-name' must be set to the Hunspell program name.
|
|
;; ATTENTION: Hunspell is not supported by ispell.el before GNU Emacs 23.x.
|
|
;; `ispell-dictionary' can be set, in addition to the default dictionary.
|
|
;; `ispell-local-dictionary-alist' can be set, as manual list in addition to
|
|
;; or overriding the automatically generated `rw-hunspell-dictionary' alist.
|
|
;;
|
|
;; Todo:
|
|
;; Make the program more dynamic, particularly the dictionary menu.
|
|
;; Parsing MS Windows locales from environmental variable LANG, e. g. "DEU".
|
|
;; Possibly full integration in ispell.el, analogous to the functions
|
|
;; ispell-find-aspell-dictionaries and ispell-aspell-find-dictionary.
|
|
;;
|
|
;;; Change Log:
|
|
;;
|
|
;; 2009-03-29 (0.2)
|
|
;;
|
|
;; * function definitions for `canonicalize-coding-system-name'
|
|
;; and `coding-system-from-name' added. These are new functions
|
|
;; in the CVS-Emacs from 2009-01-27, rw-hunspell.el needs it.
|
|
;; They will be removed, when the stable Emacs-23.1 comes out.
|
|
;;
|
|
;; 2009-03-20 (0.1)
|
|
;; Initial Release.
|
|
;;
|
|
;;; Code:
|
|
|
|
(require 'ispell)
|
|
(require 'easymenu)
|
|
|
|
;; User options.
|
|
;; This options must be set before Hunspell runs for the first time.
|
|
|
|
(defgroup rw-hunspell nil
|
|
"Hunspell customization options."
|
|
:group 'ispell)
|
|
|
|
(defcustom rw-hunspell-dicpath-list nil
|
|
"*List of dictionary directories for Hunspell.
|
|
If not set, the directories from environmental variable DICPATH are taken."
|
|
:type '(repeat string)
|
|
:group 'rw-hunspell)
|
|
|
|
(defcustom rw-hunspell-default-dictionary "en_US"
|
|
"*Default dictionary for Hunspell, e. g. \"en_US\" (basic file name)
|
|
or \"en_US_Hunspell\" (generated dictionary name). If not set,
|
|
the dictionary from environmental variables DICTIONARY or LANG are taken."
|
|
:type 'string
|
|
:group 'rw-hunspell)
|
|
|
|
(defcustom rw-hunspell-make-dictionary-menu nil
|
|
"*Make menu with all found dictionaries when non-nil.
|
|
Needs rw-language-and-country-codes.el for full language and country names."
|
|
:type 'boolean
|
|
:group 'rw-hunspell)
|
|
|
|
(defcustom rw-hunspell-use-rw-ispell nil
|
|
"*Use `rw-ispell-change-dictionary' when non-nil.
|
|
Needs rw-ispell.el when non-nil."
|
|
:type 'boolean
|
|
:group 'rw-hunspell)
|
|
|
|
(defcustom rw-hunspell-delete-dictionary-base-alist t
|
|
"*Delete `ispell-dictionary-base-alist' for the emacs session when non-nil.
|
|
That alist is not useful for Hunspell, because it needs other parameters."
|
|
:type 'boolean
|
|
:group 'rw-hunspell)
|
|
|
|
;; Internal.
|
|
|
|
(defvar rw-hunspell-dictionary-alist nil
|
|
"Automatically set, do not set manually.
|
|
List of automatically generated dictionaries with recognized encoding.
|
|
It has the same format as `ispell-dictionary-alist'.")
|
|
|
|
(defvar rw-hunspell-no-encoding-recognized-alist nil
|
|
"Automatically set, do not set manually.
|
|
List of dictionaries, for which emacs can't recognize the encoding.
|
|
It has the same format as `ispell-dictionary-alist'.")
|
|
|
|
;; For Emacs-23.0-Versions before 2009-01-27.
|
|
;; CVSWeb URLs:
|
|
;; http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/international/mule-cmds.el?cvsroot=emacs&r1=1.355&r2=1.356
|
|
(when (not (and (fboundp 'canonicalize-coding-system-name)
|
|
(fboundp 'coding-system-from-name)))
|
|
;; Canonicalize the coding system name NAME by removing some prefixes
|
|
;; and delimiter characters. Support function of
|
|
;; coding-system-from-name.
|
|
(defun canonicalize-coding-system-name (name)
|
|
(if (string-match "^iso[-_ ]?[0-9]" name)
|
|
;; "iso-8859-1" -> "8859-1", "iso-2022-jp" ->"2022-jp"
|
|
(setq name (substring name (1- (match-end 0)))))
|
|
(let ((idx (string-match "[-_ /]" name)))
|
|
;; Delete "-", "_", " ", "/" but do distinguish "16-be" and "16be".
|
|
(while idx
|
|
(if (and (>= idx 2)
|
|
(eq (string-match "16-[lb]e$" name (- idx 2))
|
|
(- idx 2)))
|
|
(setq idx (string-match "[-_ /]" name (match-end 0)))
|
|
(setq name (concat (substring name 0 idx) (substring name (1+ idx)))
|
|
idx (string-match "[-_ /]" name idx))))
|
|
name))
|
|
|
|
(defun coding-system-from-name (name)
|
|
"Return a coding system whose name matches with NAME (string or symbol)."
|
|
(let (sym)
|
|
(if (stringp name) (setq sym (intern name))
|
|
(setq sym name name (symbol-name name)))
|
|
(if (coding-system-p sym)
|
|
sym
|
|
(let ((eol-type
|
|
(if (string-match "-\\(unix\\|dos\\|mac\\)$" name)
|
|
(prog1 (intern (match-string 1 name))
|
|
(setq name (substring name 0 (match-beginning 0)))))))
|
|
(setq name (canonicalize-coding-system-name (downcase name)))
|
|
(catch 'tag
|
|
(dolist (elt (coding-system-list))
|
|
(if (string= (canonicalize-coding-system-name (symbol-name elt))
|
|
name)
|
|
(throw 'tag (if eol-type (coding-system-change-eol-conversion
|
|
elt eol-type)
|
|
elt))))))))))
|
|
|
|
(defun rw-hunspell-find-dictionaries ()
|
|
"Find Hunspell's dictionaries."
|
|
(if (and (boundp 'ispell-really-hunspell)
|
|
ispell-really-hunspell)
|
|
(let ((dictionary-directories
|
|
(if rw-hunspell-dicpath-list
|
|
(mapcar #'file-name-as-directory
|
|
rw-hunspell-dicpath-list)
|
|
(if (getenv "DICPATH")
|
|
(mapcar #'file-name-as-directory
|
|
(split-string (getenv "DICPATH") path-separator))
|
|
(list))))
|
|
(hunspell-program-directory
|
|
(if (file-name-absolute-p ispell-program-name)
|
|
(file-name-directory ispell-program-name)
|
|
(if (executable-find ispell-program-name)
|
|
(file-name-directory (executable-find ispell-program-name))
|
|
nil)))
|
|
(dictionaries (list)))
|
|
(add-to-list 'dictionary-directories hunspell-program-directory)
|
|
(dolist (directory dictionary-directories)
|
|
(setq dictionaries
|
|
(append
|
|
dictionaries
|
|
(mapcar #'file-name-sans-extension
|
|
(directory-files directory t ".+\\.dic")))))
|
|
dictionaries)
|
|
nil))
|
|
|
|
(defun rw-hunspell-make-dictionary-alist ()
|
|
"Make `rw-hunspell-dictionary-alist' for Hunspell."
|
|
(dolist (dictionary (rw-hunspell-find-dictionaries))
|
|
(condition-case ()
|
|
;; Only for *.dic files with *.aff files.
|
|
;; In the OpenOffice dictionary directory there are
|
|
;; spellchecker dictionaries with files *.aff und *.dic
|
|
;; for every dictionary, this dictionaries are included.
|
|
;; Moreover, there are hyphenation dictionaries with files hyph*.dic
|
|
;; without files *.aff, this dictionaries are not included.
|
|
(when (file-exists-p (concat dictionary ".aff"))
|
|
(let (;; Encoding and wordchars are read from the *.aff file.
|
|
(encoding "")
|
|
(wordchars "")
|
|
;; Unique dictionary name
|
|
(dictionary-name
|
|
(concat (file-name-nondirectory dictionary)
|
|
"_" (file-name-nondirectory
|
|
(directory-file-name
|
|
(file-name-directory dictionary))))))
|
|
(with-temp-buffer
|
|
(insert-file-contents (concat dictionary ".aff"))
|
|
;; Encoding declaration line, e. g. "SET ISO8859-1"
|
|
(when (search-forward-regexp "^SET " nil t)
|
|
(setq encoding
|
|
(car (last (split-string
|
|
(buffer-substring
|
|
(point)
|
|
(progn (end-of-line) (point)))))))))
|
|
(when (coding-system-from-name encoding)
|
|
(with-temp-buffer
|
|
(let ((coding-system-for-read
|
|
(coding-system-from-name encoding)))
|
|
(insert-file-contents (concat dictionary ".aff")))
|
|
(setq wordchars
|
|
;; Wordchars (correspond to otherchars) declaration line.
|
|
;; There are *.aff-files which do not define wordchars.
|
|
(if (search-forward-regexp "^WORDCHARS " nil t)
|
|
(regexp-opt
|
|
(mapcar
|
|
'char-to-string
|
|
(car (last (split-string
|
|
(buffer-substring
|
|
(point)
|
|
(progn (end-of-line) (point))))))))
|
|
""))))
|
|
;; Entry for every found dictionary with recognized encoding.
|
|
(when (coding-system-from-name encoding)
|
|
(add-to-list
|
|
'rw-hunspell-dictionary-alist
|
|
(list dictionary-name
|
|
"[[:alpha:]]"
|
|
"[^[:alpha:]]"
|
|
wordchars
|
|
t
|
|
(list "-d" dictionary)
|
|
nil
|
|
(coding-system-from-name encoding))))
|
|
;; Encoding, that emacs can't recognize.
|
|
(unless (coding-system-from-name encoding)
|
|
(add-to-list
|
|
'rw-hunspell-no-encoding-recognized-alist
|
|
(list (concat dictionary-name "_" encoding)
|
|
"[[:alpha:]]"
|
|
"[^[:alpha:]]"
|
|
wordchars
|
|
t
|
|
(list "-d" dictionary)
|
|
nil
|
|
'raw-text)))))
|
|
(file-error
|
|
nil)))
|
|
(rw-hunspell-make-default-dictionary-entry)
|
|
(when (and rw-hunspell-dictionary-alist
|
|
rw-hunspell-delete-dictionary-base-alist)
|
|
(setq ispell-dictionary-base-alist nil)))
|
|
|
|
(defun rw-hunspell-make-default-dictionary-entry ()
|
|
"Make a default dictionary entry for the specified dictionary."
|
|
(catch 'found
|
|
(let ((locale (car (split-string (getenv "LANG") "[.@]"))))
|
|
(dolist (entry (append ispell-local-dictionary-alist
|
|
rw-hunspell-dictionary-alist))
|
|
(let* ((name (or (car entry) "default"))
|
|
(full-file-name (car (last (nth 5 entry))))
|
|
(file-name (file-name-nondirectory full-file-name))
|
|
(wordchars (nth 3 entry))
|
|
(encoding (nth 7 entry)))
|
|
(when (or (string= name "default")
|
|
(string= rw-hunspell-default-dictionary name)
|
|
(string= rw-hunspell-default-dictionary file-name)
|
|
(and (not rw-hunspell-default-dictionary)
|
|
(string= (or (getenv "DICTIONARY") locale)
|
|
file-name)))
|
|
(add-to-list
|
|
'rw-hunspell-dictionary-alist
|
|
(list nil
|
|
"[[:alpha:]]"
|
|
"[^[:alpha:]]"
|
|
wordchars
|
|
t
|
|
(list "-d" full-file-name)
|
|
nil
|
|
(coding-system-from-name encoding)))
|
|
(throw 'found t)))))))
|
|
|
|
(defun rw-hunspell-make-dictionary-menu ()
|
|
"Make menu with all automatically found and manually set dictionaries."
|
|
(let (menu-local
|
|
menu-global)
|
|
;; Automatically generated and manually set dictionaries.
|
|
(dolist (entry (append ispell-local-dictionary-alist
|
|
rw-hunspell-dictionary-alist))
|
|
(let* ((name (or (car entry) "default"))
|
|
(file-name (file-name-nondirectory (car (last (nth 5 entry)))))
|
|
;; Long names for dictionaries in the menu.
|
|
(long-name
|
|
(concat
|
|
(if (string= name "default") "- " "")
|
|
(if (fboundp 'rw-lacc-replace-code-in-string)
|
|
(concat (capitalize
|
|
(rw-lacc-replace-code-in-string file-name))
|
|
" (" name ")")
|
|
name)
|
|
(if (string= name "default") " -" ""))))
|
|
(setq menu-global
|
|
(append menu-global
|
|
(list
|
|
(vector
|
|
long-name
|
|
(if (and rw-hunspell-use-rw-ispell
|
|
(fboundp 'rw-ispell-change-dictionary))
|
|
(list 'rw-ispell-change-dictionary name t)
|
|
(list 'ispell-change-dictionary name t))
|
|
:style 'toggle
|
|
:selected (list
|
|
'string= 'ispell-dictionary name)))))
|
|
(setq menu-local
|
|
(append menu-local
|
|
(list
|
|
(vector
|
|
long-name
|
|
(if (and rw-hunspell-use-rw-ispell
|
|
(fboundp 'rw-ispell-change-dictionary))
|
|
(list 'rw-ispell-change-dictionary name)
|
|
(list 'ispell-change-dictionary name))
|
|
:style 'toggle
|
|
:selected (list
|
|
'string= 'ispell-local-dictionary name)))))))
|
|
(setq menu-global (sort menu-global
|
|
#'(lambda (element1 element2)
|
|
(string< (aref element1 0) (aref element2 0)))))
|
|
(push "Select global dictionary" menu-global)
|
|
(setq menu-local (sort menu-local
|
|
#'(lambda (element1 element2)
|
|
(string< (aref element1 0) (aref element2 0)))))
|
|
(push "Select local dictionary" menu-local)
|
|
(easy-menu-add-item ispell-menu-map '() menu-global)
|
|
(easy-menu-add-item ispell-menu-map '() menu-local)
|
|
(easy-menu-add-item
|
|
ispell-menu-map '("Select global dictionary")
|
|
["" nil
|
|
:label (format "Global personal dictionary: %s"
|
|
(file-name-nondirectory
|
|
(or ispell-personal-dictionary "none")))])
|
|
(easy-menu-add-item
|
|
ispell-menu-map '("Select local dictionary")
|
|
["" nil
|
|
:label (format "Local personal dictionary: %s"
|
|
(file-name-nondirectory
|
|
(or ispell-local-pdict "none")))])))
|
|
|
|
;; User functions.
|
|
|
|
(defun rw-hunspell-setup ()
|
|
"Generate hunspell dictionary alist and menu, if they don't exist."
|
|
(interactive)
|
|
(unless rw-hunspell-dictionary-alist
|
|
(ispell-check-version)
|
|
(unless (boundp 'ispell-really-hunspell)
|
|
(error "Hunspell is not supported on %s" (emacs-version)))
|
|
(unless (and (boundp 'ispell-really-hunspell) ispell-really-hunspell)
|
|
(error "Current spellchecker is not Hunspell, ispell-program-name is %s"
|
|
ispell-program-name))
|
|
(rw-hunspell-make-dictionary-alist)
|
|
(when rw-hunspell-make-dictionary-menu
|
|
(rw-hunspell-make-dictionary-menu))))
|
|
|
|
(easy-menu-add-item
|
|
ispell-menu-map '()
|
|
["Set up Hunspell" rw-hunspell-setup
|
|
:visible (not rw-hunspell-dictionary-alist)])
|
|
|
|
;; Hooks.
|
|
|
|
(defun rw-hunspell-setup-hook ()
|
|
"Set up all for hunspell.
|
|
This hook is run when hunspell is used for the first time."
|
|
(rw-hunspell-setup)
|
|
(setq ispell-base-dicts-override-alist rw-hunspell-dictionary-alist))
|
|
|
|
(add-hook 'ispell-initialize-spellchecker-hook
|
|
'rw-hunspell-setup-hook)
|
|
|
|
(provide 'rw-hunspell)
|
|
|
|
;;; rw-hunspell.el ends here.
|