1 ;;; ndspell.el --- Lookup spell checker
2 ;; Copyright (C) 1999 Lookup Development Team <lookup@ring.gr.jp>
4 ;; Author: Keisuke Nishida <kei@psn.net>
5 ;; Version: $Id: ndspell.el,v 1.4 1999/05/24 02:44:14 yoshimi Exp $
7 ;; This file is part of Lookup.
9 ;; Lookup is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2 of the License, or
12 ;; (at your option) any later version.
14 ;; Lookup is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with Lookup; if not, write to the Free Software Foundation,
21 ;; Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
27 (defconst ndspell-version "1.0")
30 ;:: Customizable variables
34 "Lookup spell checker."
35 :group 'lookup-agents)
37 (defcustom ndspell-ispell-program "ispell"
38 "*Program name of Ispell."
42 (defcustom ndspell-grep-program "grep"
43 "*Program name of grep."
47 (defcustom ndspell-words-dictionary "/usr/share/dict/words"
52 (defcustom ndspell-dictionary-title "Spell Checker"
53 "*Title of ndspell dictionary."
57 (defcustom ndspell-search-dictionaries t
58 "*List of dictionary ID to be searched by dynamic reference.
59 `t' means all selected dictionaries are used."
60 :type '(radio (const :tag "Selected dictionaries" t)
61 (repeat :tag "Specific dictionaries" (string :tag "ID")))
64 (defcustom ndspell-process-coding-system lookup-process-coding-system
65 "*Coding system for Ispell process."
74 (put 'ndspell ':methods '(exact prefix suffix substring regexp))
77 ;:: Interface functions
80 (put 'ndspell 'setup 'ndspell-setup)
81 (defun ndspell-setup (agent)
82 (list (lookup-new-dictionary agent nil ndspell-ispell-program
83 ndspell-dictionary-title)))
85 (put 'ndspell 'clear 'ndspell-clear)
86 (defun ndspell-clear (agent)
87 (ndspell-process-kill))
89 (put 'ndspell 'search 'ndspell-dictionary-search)
90 (defun ndspell-dictionary-search (dictionary query)
91 (when (or (not lookup-search-found) lookup-force-update)
92 (let ((string (lookup-query-string query)))
93 (when (or (not (fboundp 'find-charset-string))
94 (equal (find-charset-string string) '(ascii))
95 (equal (find-charset-string string) 'nil))
96 (mapcar (lambda (candidate)
97 (let* ((heading (format "[%s -> %s]" string candidate))
98 (reference (lookup-make-reference dictionary
100 (lookup-reference-make-dynamic reference
101 'ndspell-dynamic-search)
103 (if (eq (lookup-query-method query) 'exact)
104 (ndspell-check-spelling string)
105 (ndspell-search-spelling
106 (lookup-query-to-regexp query))))))))
108 (defun ndspell-dynamic-search (reference)
109 (let ((self (lookup-entry-dictionary reference))
110 (query (lookup-make-query 'exact (lookup-entry-code reference)))
111 (lookup-proceeding-message "Rechecking") entries)
112 (lookup-proceeding-message nil)
116 (mapcar (lambda (dic)
117 (when (and (not (eq dic self))
118 (if (eq ndspell-search-dictionaries t)
119 (lookup-dictionary-selected-p dic)
120 (member (lookup-dictionary-id dic)
121 ndspell-search-dictionaries)))
122 (lookup-proceeding-message
124 (lookup-dictionary-title dic)))
125 (lookup-vse-search-query dic query)))
126 (lookup-module-dictionaries
127 (lookup-session-module lookup-current-session)))))
130 (mapcar (lambda (entry)
131 (let ((heading (lookup-entry-heading reference)))
132 (string-match "->" heading)
133 (setq heading (concat (substring heading 0 (match-end 0))
134 "] " (lookup-entry-heading entry)))
135 (lookup-make-entry (lookup-entry-dictionary entry)
136 (lookup-entry-code entry) heading)))
138 (lookup-proceeding-message t)
143 ;:: Internal functions
146 (defun ndspell-check-spelling (string)
147 (let ((check (ndspell-spell-check string)))
148 (cond ((consp check) (nreverse check))
149 ((stringp check) (list check)))))
151 (defun ndspell-spell-check (string)
152 (let ((output (ndspell-process-require string)))
154 ((string= output "") nil) ; empty
155 ((eq (aref output 0) ?*) t) ; match
156 ((eq (aref output 0) ?-) 'compound) ; compound
157 ((eq (aref output 0) ?#) nil) ; no match
158 ((string-match "^\\+ \\(.*\\)" output) ; root match
159 (downcase (match-string 1 output)))
160 ((string-match "^&[^:]*: " output) ; some candidates
161 (lookup-split-string (substring output (match-end 0)) "[,\n] ?")))))
163 (defun ndspell-search-spelling (regexp)
165 (call-process ndspell-grep-program nil t nil
166 regexp ndspell-words-dictionary)
167 (let ((candidates nil))
169 (setq candidates (cons (buffer-substring-no-properties
170 (1- (point)) (progn (forward-line -1) (point)))
174 (defun lookup-split-string (string &optional separators)
175 (let ((rexp (or separators "[ \f\t\n\r\v]+"))
176 (start 0) (list nil))
177 (while (string-match rexp string start)
178 (or (eq (match-beginning 0) 0)
179 (setq list (cons (substring string start (match-beginning 0))
181 (setq start (match-end 0)))
182 (or (eq start (length string))
183 (setq list (cons (substring string start) list)))
190 (defvar ndspell-process nil)
192 (defun ndspell-get-process ()
193 (unless (and ndspell-process (eq (process-status ndspell-process) 'run))
194 (if ndspell-process (lookup-process-kill ndspell-process))
195 (let ((buffer (lookup-open-process-buffer " *ndspell*")))
196 (setq ndspell-process
197 (start-process "ndspell" buffer ndspell-ispell-program
199 (process-kill-without-query ndspell-process)
200 (accept-process-output ndspell-process)
201 (let ((coding ndspell-process-coding-system))
203 (set-process-coding-system ndspell-process coding coding)))))
206 (defun ndspell-process-require (string)
207 (lookup-process-require (ndspell-get-process) (concat string "\n") "^\n"))
209 (defun ndspell-process-kill ()
210 (if ndspell-process (lookup-process-kill ndspell-process)))
214 ;;; ndspell.el ends here