/* Part of XPCE --- The SWI-Prolog GUI toolkit Author: Jan Wielemaker and Anjo Anjewierden E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org/packages/xpce/ Copyright (c) 1995-2015, University of Amsterdam VU University Amsterdam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ :- module(ispell, [ ispell/0 , ispell/1 ]). :- use_module(library(pce)). :- require([ send_list/3 ]). /** An ispell interface for XPCE This file defines a window-based interfaced to the GNU distributed ispell program. It has been written with the following goals in mind: - Test-case for editor/fragment handling, processes and regular expressions - Demo of text facilities, browsers, dialog-windows and process interface - A useful tool for correcting spelling errors ## Functionality The UI consists of a view (text-window) for the text to be corrected, two browsers, one with an alphabetical list of errors detected by the spelling checker and one with a list of words that are close to the error currently selected. Finally, there is a dialog window that allows for various commands. When a file is loaded (using `load'), it may be checked by pressing `spell'. This will run `ispell -l -t | sort -u' to get a sorted list of errors. Each error is displayed in the error browser and each occurrence of the error in the text is marked with bold font. Next, errors may be selected by clicking them in the error browser, or double-clicking them in the text-window. In both cases, the error will be highlighted in the error-browser and underlined in the text. The error will appear in the `word' and `correction' fields of the dialog-window and near-misses of the dictionary will be shown in the corrections-browser. Next, the user has several options: - `Next' Don't change this occurrence, but search for the next. - `Replace' Replace this occurrence with the value of `correction' and search for the next. - `Replace All' Replace all occurrences of this error by the value of `correction' . - `Dict' Remove this error from the text and error-browser and add the word to the user's personal dictionary. Clicking a correction of the correction-browser sets the text entry field `correction'. This field may also be edited directly. Finally, the text-window is an EMACS-like editor and errors may be corrected directly. */ %! ispell is det. %! ispell(+File) is det. % % Open the ispell interface. The predicate ispell/1 loads a file % into the interface. ispell :- new(S, ispell), send(S, open). ispell(File) :- new(S, ispell(File)), send(S, open). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Tell PCE/Prolog that class finder is defined in the library and @finder is a global unique instance of it. PCE will generate an exception when @finder is referred to the first time. This exception will force PCE/Prolog to load `library(find_file)' and create an instance of the finder. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_autoload(finder, library(find_file)). :- pce_global(@finder, new(finder)). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The entire ispell program is implemented as a single user-defined class, which is a subclass of class frame. Class frame is well suited for this purpose as it provides easy access to its parts and parts have easy access to their overall frame. In this example there is no need to create subclasses for the various parts. All specialisation needed can easily be achieved by setting options and attaching message objects. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_begin_class(ispell, frame). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Create a class-variable defining the spell program used to get an initial list of errors. The user may choose another spell program by adding the following line to his/her ~/.xpce/Defaults file: ispell.spell_program: myspell The variables `word' and `fragment' define the word currently examined/replaced and the current fragment. They are manipulated by `ispell ->select'. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ class_variable(ispell_program, name, 'ispell', "ISpell command with common options"). class_variable(error_style, style, style(colour := red), "Style used to highlight errors"). variable(word, name*, get, "Currently handled word"). variable(fragment, fragment*, get, "Currently handled fragment"). variable(ispell, process*, none, "The ispell -a process"). /******************************** * CREATE/DESTROY * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The ispell UI consists of a view to display the text to be corrected, a browser for an errors, one for alternatives suggested by the ispell unix program (corrections) and a dialog for invoking commands such as loading a file, running spell, replacing, etc. The first section of the method below creates the frame, attaches all the windows and defines the layout of the windows. Next, the two browsers are given a label and a name, so we can easily find them using the `frame <-member' facility. Next, the view is prepared. It will display fragments of style `error' in bold face, underline the current fragment (= error) and select the current fragment on a double click. Note that the click_gesture is attached to the image of the editor, so that it will only be invoked when the user double-clicks in the text-area of the editor and not in the scrollbar. Finally, the dialog is filled and the browser's actions on selection are setup. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ initialise(F, File:[file]) :-> "Create from file":: send(F, send_super, initialise, 'Ispell'), send(F, append, new(V, view)), send(F, append, new(D, dialog)), send(F, append, new(B, browser)), send(F, append, new(C, browser)), send(C, below, B), send(B, left, V), send(D, below, V), send(B, name, errors), send(C, name, corrections), send(B?list_browser, label, 'Errors'), send(C?list_browser, label, 'Corrections'), get(F, error_style, ErrorStyle), send(V, style, error, ErrorStyle), send(V, selected_fragment_style, style(underline := @on)), send(V?image, recogniser, click_gesture(left, '', double, message(F, select_current_fragment))), fill_dialog(D), send(B, select_message, message(F, select, @arg1?key)), send(C, select_message, message(F, correction, @arg1?key)), send(F, clear_errors), ( File \== @default -> send(F, file, File) ; true ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The method ->unlink is called when the ispell frame is destroyed. It will destroy the inferior ispell process when it has been created. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ unlink(F) :-> "Destroy the ispell program when running":: send(F, clear_errors), get(F, slot, ispell, Ispell), ( Ispell \== @nil -> send(Ispell, close) ; true ), send(F, send_super, unlink). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Fill the dialog window. Most of the dialog items simply send a message to the ispell frame. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ fill_dialog(D) :- get(D, frame, F), send(D, append, label(reporter)), send(D, append, button(load, message(F, file))), send(D, append, button(save, message(F, save))), send(D, append, button(spell, message(F, spell))), send(D, append, button(quit, message(F, wm_delete))), send(D, append, new(W, text_item(word, ''))), send(D, append, new(C, text_item(correction, ''))), send(W, editable, @off), send(W, pen, 0), send(D, append, button(next, message(F, next))), send(D, append, button(replace, message(F, replace, C?selection))), send(D, append, button(replace_all, message(F, action, C?selection))), send(D, append, button(dict, message(F, action, @default, @on))), send(D, append, button(undo, message(F?view, undo))). /******************************** * GETTING THE PARTS * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - These methods obtain the various parts of the ispell application. This makes it easy to modify the organisation of the application and allows us to write expressions as: send(F?view, undo). to invoke some method on a part. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ view(F, View) :<- "View part":: get(F, member, view, View). errors(F, Browser) :<- "Browser for errors":: get(F, member, errors, Browser). corrections(F, Browser) :<- "Browser for corrections":: get(F, member, corrections, Browser). dialog(F, Dialog) :<- "Dialog window":: get(F, member, dialog, Dialog). /******************************** * FEEDBACK * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - This method deactivates a number of dialog items. It uses the catch_all mechanism of class device to find the references: get(Device, member, Name, Reference) is equivalent to get(Device, Name_member, Reference) but the latter allows us to use the ?/2 infix notation. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ activate_replacement_items(F, Val:bool) :-> "(De)activate items used for replacement":: get(F, dialog, D), send_list([ D?word_member , D?correction_member , D?replace_member , D?replace_all_member , D?dict_member , D?next_member ], active, Val). /******************************* * USER-DEFINED SAVE * *******************************/ save(F) :-> "->save_buffer the <-view":: send(F?view, save_buffer). save_action(F, Action:code, Label:[name]) :-> "Modify the save action":: get(F, dialog, D), get(D, member, save, SaveButton), send(SaveButton, message, Action), ( Label \== @default -> send(SaveButton, selection, Label?label_name) ; true ). /******************************* * LOADING BUFFER * *******************************/ buffer(F, TB:text_buffer) :-> "Load text-buffer (cooperation with editors)":: send(F?view, text_buffer, TB), send(F, confirm_done, @off), get(F, dialog, Dialog), get(Dialog, member, load, BL), send(BL, active, @off), get(Dialog, member, save, BS), send(BS, active, @off). /******************************** * LOADING FILES * ********************************/ file(F, File:[file]) :-> "Load file (or ask for one)":: send(F, clear_errors), ( File == @default -> get(@finder, file, open, LoadName), new(LoadFile, file(LoadName)) ; LoadFile = File ), send(F?view, load, LoadFile), send(F, label, string('Ispell: %s', LoadFile?base_name), 'Ispell'). /******************************** * RUN SPELL AND MARK ALL * ********************************/ clear_errors(F) :-> "Reset all error info":: send(F, select, @nil), get(F?view, text_buffer, TB), get(TB, find_all_fragments, @arg1?style == error, ErrorFrags), send(ErrorFrags, for_all, message(@arg1, free)), send(ErrorFrags, done), send(F?errors, clear), send(F?corrections, clear). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - The method below runs the spell program and marks all words returned by it. First, a process object for the spell process is created. As we want to use the pipe (|) shell construct, we'll use /bin/sh to run the process. Each line of input from the process is passed to the method `ispell ->mark_word'. Next, the contents of the view is sent to the process and we wait until all input from the process is handled using `process ->wait'. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ spell(F) :-> send(F, clear_errors), get(F?view, contents, String), ( send(String, is_wide) -> send(F, report, error, 'Cannot spell Unicode data (yet)'), fail ; true ), get(F, ispell_program, Prog), new(P, process('/bin/sh', '-c', string('%s -l | sort -u', Prog))), send(P, use_tty, @off), send(P, input_message, message(F, mark_word, @arg1)), send(F, report, progress, 'Running "%s" ...', Prog), send(P, open), send(P, append, String), send(P, close), send(P, wait), % wait for completion send(P, free), get(F?errors?dict?members, size, Errors), send(F, report, done, 'Spelling done. %d Errors', Errors). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Mark all occurrences of an error. First, the error is appended to the `errors' browser. The `dict_item <->object' slot is used to store a chain of fragments for this error. Next a regular expression is created and all occurrences of the regular expression are marked using a fragment. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_global(@ispell_mark_re, new(regex(''))). mark_word(F, S:string) :-> "Mark all occurrences of word":: send(S, strip), get(S, value, Word), ( Word == '' -> true ; send(F, report, progress, 'Marking %s ...', Word), get(F, errors, B), send(B, append, dict_item(Word, @default, new(Errors, chain))), get(F, view, View), get(View, text_buffer, TB), get(@ispell_mark_re, quote, S, Q), send(Q, prepend, '\\y'), send(Q, append, '\\y'), send(@ispell_mark_re, pattern, Q), mark_all(TB, 0, @ispell_mark_re, Errors, error), send(F, report, done) ). mark_all(TB, Index, Re, Errors, Kind) :- send(Re, search, TB, Index), !, get(Re, register_start, RS), get(Re, register_end, RE), L is RE - RS, new(Fragment, fragment(TB, RS, L, Kind)), send(Errors, append, Fragment), mark_all(TB, RE, Re, Errors, Kind). mark_all(_, _, _, _, _). /******************************** * SELECT WORDS * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Select the word after a double click. The first click (of the double) has positioned the caret, so we find all fragments overlapping the caret position and take the smallest. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ select_current_fragment(F) :-> "Select fragment of caret":: get(F, view, View), get(View, caret, Caret), get(View, find_all_fragments, message(@arg1, overlap, Caret), Fragments), send(Fragments, sort, @arg1?length < @arg2?length), get(Fragments, head, Fragment), get(Fragment, string, Word), send(F, select, Word, Fragment), send(F?errors, selection, Word), send(F?errors, normalise, Word). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Set the `selection' of ispell. When `word' is @nil, the selection is cleared. Otherwise the word is send to ispell to list the alternatives (ispell will invoke `ispell ->ispell_utterance' for each line of output). The word is selected in the `errors' browser and the view. The dialog is updated. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ select(F, Word:name*, Fragment:[fragment]) :-> "Select some word":: get(F, dialog, Dialog), ( Word == @nil % clear selection -> send(F, slot, word, @nil), send(F, slot, fragment, @nil), send(Dialog?word_member, selection, ''), send(Dialog?correction_member, selection, ''), send(F?corrections, clear), send(F, activate_replacement_items, @off) ; send(F?ispell, append_line, Word), get(F, errors, Browser), get(Browser, member, Word, DI), get(DI, object, Errors), ( get(F, word, Word) % same word -> true ; send(Dialog?word_member, selection, Word), send(Dialog?correction_member, selection, Word), send(F, report, status, '%d occurrences of "%s"', Errors?size, Word), send(F, slot, word, Word) ), send(F, activate_replacement_items, @on), ( Fragment \== @default -> send(F, slot, fragment, Fragment) ; ( send(Errors, empty) -> fail ; send(F, slot, fragment, Errors?head) ) ), get(F, fragment, Frag), get(F, view, View), send(View, caret, Frag?start), send(View, selected_fragment, Frag) ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Activated if the user clicks a word in the `corrections' browser. It updates the `correction' text_item. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ correction(F, Word:name) :-> "Put value in correction field":: get(F?dialog, correction_member, TI), send(TI, selection, Word). /******************************** * ISPELL PROGRAM * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Interface to the interactive inferior ispell program to generate possible alternatives and to add words to the user's personal dictionary. `ispell <-ispell' returns the ispell process if this already running or creates one otherwise. The ispell process will invoke `ispell ->ispell_utterance' for each input record, which is by default a line. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ ispell(F, Ispell) :<- "Get the ispell process or start it":: ( get(F, slot, ispell, Ispell), Ispell \== @nil -> true ; get(F, ispell_program, CMD), new(Ispell, process('/bin/sh', '-c', string('%s -a', CMD))), send(Ispell, use_tty, @off), send(Ispell, input_message, message(F, ispell_utterance, @arg1)), send(Ispell, open), send(F, slot, ispell, Ispell) ). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - If Ispell utters `& alternative ...' the alternatives should be added to the `corrections' browser. First the & prefix is tested. A regular expression is used to filter the individual words from the line. `regex ->for_all' invokes its argument code object for each match it can find in the argument text. @arg1 is the regex, @arg2 is the object searched. Register 0 of a regular expression refers to the entire match. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- pce_global(@re_word_ispell_3, new(regex('[:,] ([^,]*)'))). :- pce_global(@re_word_ispell_4, new(regex('\\s+(\\S+)'))). ispell_utterance(F, Line:string) :-> "Handle line of output from ispell":: get(F, corrections, Corrections), ( get(Line, size, 1) -> true ; send(Corrections, clear) ), ( send(Line, prefix, '& ') -> send(Line, strip), ( get(Line, index, ':', _) -> Re = @re_word_ispell_3 ; Re = @re_word_ispell_4 ), send(Re, for_all, Line, message(Corrections, append, ?(@arg1, register_value, @arg2, 1))) ; send(Line, prefix, '#'), send(F, report, warning, 'No suggestions') ). /******************************** * REPLACEMENTS * ********************************/ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - `ispell ->action' handles the current word for all matching fragments. If `R' is non-default, all fragments are replaced with this text. If `AddToDict' is non-default, the word is added to the dictionary and its matches are removed from the view and browser. Note the use of `view ->mark_undo' (actually implemented at class editor). Normally, an editor will mark all changes made to it under a single event as a `undo-unit'. As the editor is not receiving any events here, we'll have to indicate the unit of undo ourselves. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ action(F, R:[name], AddToDict:[bool]) :-> "Replace and/or add to dictionary":: get(F, errors, Browser), get(F, word, Word), get(Browser, member, Word, DI), get(DI, object, Errors), ( R \== @default -> send(Errors, for_all, message(@arg1, string, R)), send(F?view, mark_undo), ToDict = R ; ToDict = Word ), ( AddToDict == @on -> send(F?ispell, format, '*%s\\n#\\n', ToDict), send(F, report, status, 'Added "%s" to dictionary', ToDict) ; true ), send(Errors, for_all, message(@arg1, free)), send(Errors, free), send(DI, free), send(F, select, @nil). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - `ispell ->replace' replaces the current (underlined) fragment and selects the next fragment. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ replace(F, R:name) :-> "Replace current fragment":: get(F, view, View), get(View, selected_fragment, Fr), send(Fr, string, R), send(F?view, mark_undo), send(F, next). /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - `ispell ->next' will unmark the current fragment and skip to the next. The first section gathers the current word, fragment and chain of fragments belonging to this word. Next, we gather the index in the fragment chain of the current fragment and delete the current fragment. Finally, there are various possibilities: there are no more errors in the chain, there is a next, or we have to wrap around to the first. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ next(F) :-> "Select next fragment, deleting this one":: get(F, word, Word), get(F, fragment, F1), get(F, errors, Browser), get(Browser, member, Word, DI), get(DI, object, Errors), get(Errors, index, F1, IF1), send(Errors, delete, F1), send(F1, free), ( send(Errors, empty) -> send(Browser, delete, Word), send(F, select, @nil) ; ( get(Errors, nth1, IF1, F2) ; get(Errors, head, F2) ) -> send(F, select, Word, F2) ). :- pce_end_class.