Mercurial > emacs
comparison lisp/textmodes/=ispell4.el @ 4895:7c2d90ff5849
(ispell-look-command): New user variable.
(ispell-do-look, ispell-lookup-build-list): Use it as
PROGRAM for call-process instead of just "look".
(ispell-complete-word-interior-frag): New command.
(ispell-complete-word): New command.
(ispell-menu-map): Add bindings for them.
(ispell-gnu-look-still-broken-p, ispell-look-dictionary): New vars.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 26 Oct 1993 20:01:56 +0000 |
parents | 8b896067d6fb |
children | c639a86ac9f1 |
comparison
equal
deleted
inserted
replaced
4894:1574c6c6561f | 4895:7c2d90ff5849 |
---|---|
42 (defvar ispell-command-options nil | 42 (defvar ispell-command-options nil |
43 "*String (or list of strings) to pass to Ispell as command arguments. | 43 "*String (or list of strings) to pass to Ispell as command arguments. |
44 You can use this to specify the name of your private dictionary. | 44 You can use this to specify the name of your private dictionary. |
45 The -S option is always passed to Ispell as the last parameter, | 45 The -S option is always passed to Ispell as the last parameter, |
46 and need not be mentioned here.") | 46 and need not be mentioned here.") |
47 | |
48 (defvar ispell-look-command "look" | |
49 "*Command for running look.") | |
47 | 50 |
48 ;Each marker in this list points to the start of a word that | 51 ;Each marker in this list points to the start of a word that |
49 ;ispell thought was bad last time it did the :file command. | 52 ;ispell thought was bad last time it did the :file command. |
50 ;Notice that if the user accepts or inserts a word into his | 53 ;Notice that if the user accepts or inserts a word into his |
51 ;private dictionary, then some "good" words will be on the list. | 54 ;private dictionary, then some "good" words will be on the list. |
213 (defun ispell-tex-buffer-p () | 216 (defun ispell-tex-buffer-p () |
214 (memq major-mode '(plain-TeX-mode LaTeX-mode))) | 217 (memq major-mode '(plain-TeX-mode LaTeX-mode))) |
215 | 218 |
216 (defvar ispell-menu-map (make-sparse-keymap "Spell")) | 219 (defvar ispell-menu-map (make-sparse-keymap "Spell")) |
217 (defalias 'ispell-menu-map ispell-menu-map) | 220 (defalias 'ispell-menu-map ispell-menu-map) |
221 | |
222 (define-key ispell-menu-map [ispell-complete-word-interior-frag] | |
223 '("Complete Interior Fragment" . ispell-complete-word-interior-frag)) | |
224 | |
225 (define-key ispell-menu-map [ispell-complete-word] | |
226 '("Complete Word" . ispell-complete-word)) | |
218 | 227 |
219 (define-key ispell-menu-map [reload-ispell] | 228 (define-key ispell-menu-map [reload-ispell] |
220 '("Reload Dictionary" . reload-ispell)) | 229 '("Reload Dictionary" . reload-ispell)) |
221 | 230 |
222 (define-key ispell-menu-map [ispell-next] | 231 (define-key ispell-menu-map [ispell-next] |
570 (setq buf (get-buffer-create "*ispell look*")) | 579 (setq buf (get-buffer-create "*ispell look*")) |
571 (save-excursion | 580 (save-excursion |
572 (set-buffer buf) | 581 (set-buffer buf) |
573 (delete-region (point-min) (point-max)) | 582 (delete-region (point-min) (point-max)) |
574 (if ispell-have-new-look | 583 (if ispell-have-new-look |
575 (call-process "look" nil buf nil "-r" regex) | 584 (call-process ispell-look-command nil buf nil "-r" regex) |
576 (call-process "look" nil buf nil regex)) | 585 (call-process ispell-look-command nil buf nil regex)) |
577 (goto-char (point-min)) | 586 (goto-char (point-min)) |
578 (forward-line 10) | 587 (forward-line 10) |
579 (delete-region (point) (point-max)) | 588 (delete-region (point) (point-max)) |
580 (goto-char (point-min)) | 589 (goto-char (point-min)) |
581 (while (not (= (point-min) (point-max))) | 590 (while (not (= (point-min) (point-max))) |
605 (texinfo-format-buffer)) | 614 (texinfo-format-buffer)) |
606 (Info-validate) | 615 (Info-validate) |
607 (if (get-buffer " *problems in info file*") | 616 (if (get-buffer " *problems in info file*") |
608 (kill-emacs 1)) | 617 (kill-emacs 1)) |
609 (write-region (point-min) (point-max) "ispell.info")) | 618 (write-region (point-min) (point-max) "ispell.info")) |
619 | |
620 ;;;; ispell-complete-word | |
621 | |
622 ;;; Brief Description: | |
623 ;;; Complete word fragment at point using dictionary and replace with full | |
624 ;;; word. Expansion done in current buffer like lisp-complete-symbol. | |
625 ;;; Completion of interior word fragments possible with prefix argument. | |
626 | |
627 ;;; Known Problem: | |
628 ;;; Does not use private dictionary because GNU `look' does not use it. It | |
629 ;;; would be nice if GNU `look' took standard input; this would allow gzip'ed | |
630 ;;; dictionaries to be used. GNU `look' also has a bug, see | |
631 ;;; `ispell-gnu-look-still-broken-p'. | |
632 | |
633 ;;; Motivation: | |
634 ;;; The `l', "regular expression look up", keymap option of ispell-word | |
635 ;;; (ispell-do-look) can only be run after finding a misspelled word. So | |
636 ;;; ispell-do-look can not be used to look for words starting with `cat' to | |
637 ;;; find `catechetical' since `cat' is a correctly spelled word. Furthermore, | |
638 ;;; ispell-do-look does not return the entire list returned by `look'. | |
639 ;;; | |
640 ;;; ispell-complete-word allows you to get a completion list from the system | |
641 ;;; dictionary and expand a word fragment at the current position in a buffer. | |
642 ;;; These examples assume ispell-complete-word is bound to M-TAB as it is in | |
643 ;;; text-mode; the `Complete Word' and `Complete Interior Fragment' entries of | |
644 ;;; the "Spell" submenu under the "Edit" menu may also be used instead of | |
645 ;;; M-TAB and C-u M-TAB, respectively. | |
646 ;;; | |
647 ;;; EXAMPLE 1: The word `Saskatchewan' needs to be spelled. The user may | |
648 ;;; type `Sas' and hit M-TAB and a completion list will be built using the | |
649 ;;; shell command `look' and displayed in the *Completions* buffer: | |
650 ;;; | |
651 ;;; Possible completions are: | |
652 ;;; sash sashay | |
653 ;;; sashayed sashed | |
654 ;;; sashes sashimi | |
655 ;;; Saskatchewan Saskatoon | |
656 ;;; sass sassafras | |
657 ;;; sassier sassing | |
658 ;;; sasswood sassy | |
659 ;;; | |
660 ;;; By viewing this list the user will hopefully be motivated to insert the | |
661 ;;; letter `k' after the `sas'. When M-TAB is hit again the word `Saskat' | |
662 ;;; will be inserted in place of `sas' (note case) since this is a unique | |
663 ;;; substring completion. The narrowed completion list can be viewed with | |
664 ;;; another M-TAB | |
665 ;;; | |
666 ;;; Possible completions are: | |
667 ;;; Saskatchewan Saskatoon | |
668 ;;; | |
669 ;;; Inserting the letter `c' and hitting M-TAB will narrow the completion | |
670 ;;; possibilities to just `Saskatchewan' and this will be inserted in the | |
671 ;;; buffer. At any point the user may click the mouse on a completion to | |
672 ;;; select it. | |
673 ;;; | |
674 ;;; EXAMPLE 2: The user has typed `Sasaquane' and M-$ (ispell-word) gives no | |
675 ;;; "near-misses" in which case you back up to `Sas' and hit M-TAB and find | |
676 ;;; the correct word as above. The `Sas' will be replaced by `Saskatchewan' | |
677 ;;; and the remaining word fragment `aquane' can be deleted. | |
678 ;;; | |
679 ;;; EXAMPLE 3: If a version of `look' is used that supports regular | |
680 ;;; expressions, then `ispell-have-new-look' should be t (its default) and | |
681 ;;; interior word fragments may also be used for the search. The word | |
682 ;;; `pneumonia' needs to be spelled. The user can only remember the | |
683 ;;; interior fragment `mon' in which case `C-u M-TAB' on `mon' gives a list | |
684 ;;; of all words containing the interior word fragment `mon'. Typing `p' | |
685 ;;; and M-TAB will narrow this list to all the words starting with `p' and | |
686 ;;; containing `mon' from which `pneumonia' can be found as above. | |
687 | |
688 ;;; The user-defined variables are: | |
689 ;;; | |
690 ;;; ispell-look-command | |
691 ;;; ispell-look-dictionary | |
692 ;;; ispell-gnu-look-still-broken-p | |
693 | |
694 ;;; Algorithm (some similarity to lisp-complete-symbol): | |
695 ;;; | |
696 ;;; * call-process on command ispell-look-command (default: "look") to find | |
697 ;;; words in ispell-look-dictionary matching `string' (or `regexp' if | |
698 ;;; ispell-have-new-look is t). Parse output and store results in | |
699 ;;; ispell-lookup-completions-alist. | |
700 ;;; | |
701 ;;; * Build completion list using try-completion and `string' | |
702 ;;; | |
703 ;;; * Replace `string' in buffer with matched common substring completion. | |
704 ;;; | |
705 ;;; * Display completion list only if there is no matched common substring. | |
706 ;;; | |
707 ;;; * Rebuild ispell-lookup-completions-alist, on a next call, only when | |
708 ;;; beginning of word fragment has changed. | |
709 ;;; | |
710 ;;; * Interior fragments searches are performed similarly with the exception | |
711 ;;; that the entire fragment at point is initially removed from the buffer, | |
712 ;;; the STRING passed to try-completion and all-completions is just "" and | |
713 ;;; not the interior fragment; this allows all completions containing the | |
714 ;;; interior fragment to be shown. The location in the buffer is stored to | |
715 ;;; decide whether future completion narrowing of the current list should be | |
716 ;;; done or if a new list should be built. See interior fragment example | |
717 ;;; above. | |
718 ;;; | |
719 ;;; * Robust searches are done using a `look' with -r (regular expression) | |
720 ;;; switch if ispell-have-new-look is t. | |
721 | |
722 ;;;; User-defined variables. | |
723 | |
724 (defvar ispell-look-dictionary nil | |
725 "*If non-nil then spelling dictionary as string for `ispell-complete-word'. | |
726 Overrides default dictionary file such as \"/usr/dict/words\" or GNU look's | |
727 \"${prefix}/lib/ispell/ispell.words\"") | |
728 | |
729 (defvar ispell-gnu-look-still-broken-p nil | |
730 "*t if GNU look -r can give different results with and without trialing `.*'. | |
731 Example: `look -dfr \"^ya\" foo' returns nothing, while `look -dfr \"^ya.*\" foo' | |
732 returns `yacc', where `foo' is a dictionary file containing the three lines | |
733 | |
734 y | |
735 y's | |
736 yacc | |
737 | |
738 Both commands should return `yacc'. If `ispell-complete-word' erroneously | |
739 states that no completions exist for a string, then setting this variable to t | |
740 will help find those completions.") | |
741 | |
742 ;;;; Internal variables. | |
743 | |
744 ;;; Possible completions for last word fragment. | |
745 (defvar ispell-lookup-completions-alist nil) | |
746 | |
747 ;;; Last word fragment processed by `ispell-complete-word'. | |
748 (defvar ispell-lookup-last-word nil) | |
749 | |
750 ;;; Buffer local variables. | |
751 | |
752 ;;; Value of interior-frag in last call to `ispell-complete-word'. | |
753 (defvar ispell-lookup-last-interior-p nil) | |
754 (make-variable-buffer-local 'ispell-lookup-last-interior-p) | |
755 (put 'ispell-lookup-last-interior-p 'permanent-local t) | |
756 | |
757 ;;; Buffer position in last call to `ispell-complete-word'. | |
758 (defvar ispell-lookup-last-bow nil) | |
759 (make-variable-buffer-local 'ispell-lookup-last-bow) | |
760 (put 'ispell-lookup-last-bow 'permanent-local t) | |
761 | |
762 ;;;; Interactive functions. | |
763 ;;;###autoload | |
764 (defun ispell-complete-word (&optional interior-frag) | |
765 "Complete word using letters at point to word beginning using `look'. | |
766 With optional argument INTERIOR-FRAG, word fragment at point is assumed to be | |
767 an interior word fragment in which case `ispell-have-new-look' should be t. | |
768 See also `ispell-look-dictionary' and `ispell-gnu-look-still-broken-p'." | |
769 | |
770 (interactive "P") | |
771 | |
772 ;; `look' must support regexp expressions in order to perform an interior | |
773 ;; fragment search. | |
774 (if (and interior-frag (not ispell-have-new-look)) | |
775 (error (concat "Sorry `ispell-have-new-look' is nil. " | |
776 "You also will need GNU Ispell's `look'."))) | |
777 | |
778 (let* ((completion-ignore-case t) | |
779 | |
780 ;; Get location of beginning of word fragment. | |
781 (bow (save-excursion (skip-chars-backward "a-zA-Z'") (point))) | |
782 | |
783 ;; Get the string to look up. | |
784 (string (buffer-substring bow (point))) | |
785 | |
786 ;; Get regexp for which we search and, if necessary, an interior word | |
787 ;; fragment. | |
788 (regexp (if interior-frag | |
789 (concat "^.*" string ".*") | |
790 ;; If possible use fast binary search: no trailing `.*'. | |
791 (concat "^" string | |
792 (if ispell-gnu-look-still-broken-p ".*")))) | |
793 | |
794 ;; We want all completions for case of interior fragments so set | |
795 ;; prefix to an empty string. | |
796 (prefix (if interior-frag "" string)) | |
797 | |
798 ;; Are we continuing from a previous interior fragment search? | |
799 ;; Check last value of interior-word and if the point has moved. | |
800 (continuing-an-interior-frag-p | |
801 (and ispell-lookup-last-interior-p | |
802 (equal ispell-lookup-last-bow bow))) | |
803 | |
804 ;; Are we starting a unique word fragment search? Always t for | |
805 ;; interior word fragment search. | |
806 (new-unique-string-p | |
807 (or interior-frag (null ispell-lookup-last-word) | |
808 (let ((case-fold-search t)) | |
809 ;; Can we locate last word fragment as a substring of current | |
810 ;; word fragment? If the last word fragment is larger than | |
811 ;; the current string then we will have to rebuild the list | |
812 ;; later. | |
813 (not (string-match | |
814 (concat "^" ispell-lookup-last-word) string))))) | |
815 | |
816 completion) | |
817 | |
818 ;; Check for perfect completion already. That is, maybe the user has hit | |
819 ;; M-x ispell-complete-word one too many times? | |
820 (if (string-equal string "") | |
821 (if (string-equal (concat ispell-lookup-last-word " ") | |
822 (buffer-substring | |
823 (save-excursion (forward-word -1) (point)) (point))) | |
824 (error "Perfect match...still. Please move on.") | |
825 (error "No word fragment at point."))) | |
826 | |
827 ;; Create list of words from system dictionary starting with `string' if | |
828 ;; new string and not continuing from a previous interior fragment search. | |
829 (if (and (not continuing-an-interior-frag-p) new-unique-string-p) | |
830 (setq ispell-lookup-completions-alist | |
831 (ispell-lookup-build-list string regexp))) | |
832 | |
833 ;; Check for a completion of `string' in the list and store `string' and | |
834 ;; other variables for the next call. | |
835 (setq completion (try-completion prefix ispell-lookup-completions-alist) | |
836 ispell-lookup-last-word string | |
837 ispell-lookup-last-interior-p interior-frag | |
838 ispell-lookup-last-bow bow) | |
839 | |
840 ;; Test the completion status. | |
841 (cond | |
842 | |
843 ;; * Guess is a perfect match. | |
844 ((eq completion t) | |
845 (insert " ") | |
846 (message "Perfect match.")) | |
847 | |
848 ;; * No possibilities. | |
849 ((null completion) | |
850 (message "Can't find completion for \"%s\"" string) | |
851 (beep)) | |
852 | |
853 ;; * Replace string fragment with matched common substring completion. | |
854 ((and (not (string-equal completion "")) | |
855 ;; Fold case so a completion list is built when `string' and common | |
856 ;; substring differ only in case. | |
857 (let ((case-fold-search t)) | |
858 (not (string-match (concat "^" completion "$") string)))) | |
859 (search-backward string bow) | |
860 (replace-match completion nil t) ; FIXEDCASE doesn't work? or LITERAL? | |
861 (message "Proposed unique substring. Repeat for completions list.")) | |
862 | |
863 ;; * String is a common substring completion already. Make list. | |
864 (t | |
865 (message "Making completion list...") | |
866 (if (string-equal completion "") (delete-region bow (point))) | |
867 (let ((list (all-completions prefix ispell-lookup-completions-alist))) | |
868 (with-output-to-temp-buffer " *Completions*" | |
869 (display-completion-list list))) | |
870 (message "Making completion list...done"))))) | |
871 | |
872 ;;;###autoload | |
873 (defun ispell-complete-word-interior-frag () | |
874 "Runs `ispell-complete-word' with a non-nil INTERIOR-FRAG. | |
875 A completion list is built for word fragment at point which is assumed to be | |
876 an interior word fragment. `ispell-have-new-look' should be t." | |
877 (interactive) | |
878 (ispell-complete-word t)) | |
879 | |
880 ;;;; Internal Function. | |
881 | |
882 ;;; Build list of words using ispell-look-command from dictionary | |
883 ;;; ispell-look-dictionary (if this is a non-nil string). Look for words | |
884 ;;; starting with STRING if ispell-have-new-look is nil or look for REGEXP if | |
885 ;;; ispell-have-new-look is t. Returns result as an alist suitable for use by | |
886 ;;; try-completion, all-completions, and completing-read. | |
887 (defun ispell-lookup-build-list (string regexp) | |
888 (save-excursion | |
889 (message "Building list...") | |
890 (set-buffer (get-buffer-create " *ispell look*")) | |
891 (erase-buffer) | |
892 | |
893 (if (stringp ispell-look-dictionary) | |
894 (if ispell-have-new-look | |
895 (call-process ispell-look-command nil t nil "-fr" regexp | |
896 ispell-look-dictionary) | |
897 (call-process ispell-look-command nil t nil "-f" string | |
898 ispell-look-dictionary)) | |
899 (if ispell-have-new-look | |
900 (call-process ispell-look-command nil t nil "-fr" regexp) | |
901 (call-process ispell-look-command nil t nil "-f" string))) | |
902 | |
903 ;; Build list for try-completion and all-completions by storing each line | |
904 ;; of output starting from bottom of buffer and deleting upwards. | |
905 (let (list) | |
906 (goto-char (point-min)) | |
907 (while (not (= (point-min) (point-max))) | |
908 (end-of-line) | |
909 (setq list (cons (buffer-substring (point-min) (point)) list)) | |
910 (forward-line) | |
911 (delete-region (point-min) (point))) | |
912 | |
913 ;; Clean. | |
914 (erase-buffer) | |
915 (message "Building list...done") | |
916 | |
917 ;; Make the list into an alist and return. | |
918 (mapcar 'list (nreverse list))))) | |
610 | 919 |
611 (defvar ispell-message-cite-regexp "^ " | 920 (defvar ispell-message-cite-regexp "^ " |
612 "*Regular expression to match lines cited from one message into another.") | 921 "*Regular expression to match lines cited from one message into another.") |
613 | 922 |
614 (defun ispell-message () | 923 (defun ispell-message () |