Package: emacs;
Reported by: Sebastien Delafond <sdelafond <at> gmx.net>
Date: Fri, 20 Feb 2009 06:20:02 UTC
Severity: wishlist
Tags: patch
Fixed in version 26.1
Done: Lars Ingebrigtsen <larsi <at> gnus.org>
Bug is archived. No further changes may be made.
Message #5 received at quiet <at> emacsbugs.donarmstrong.com (full text, mbox):
From: Sebastien Delafond <sdelafond <at> gmx.net> To: quiet <at> debbugs.gnu.org Subject: Flyspell patch - Provide users with a way to specify their own sort function Date: Fri, 20 Feb 2009 03:45:11 +0000 (UTC)
Severity: wishlist
[ resent from
http://lists.gnu.org/archive/html/emacs-devel/2009-02/msg00757.html ]
Hi,
at the end of this message is my attempt at writing a patch for
flyspell, so users can define their own function to sort potential
corrections.
I type French on a US keyboard, so I personally use it to favor
accentuated corrections of the same length as the word to be corrected,
with the following in my .emacs:
(setq my-flyspell-regular-letters
(split-string "abcdefghijklmnoprstuvwxyz" "" t))
(setq my-flyspell-regular-letters
(append my-flyspell-regular-letters
(map 'list 'capitalize my-flyspell-regular-letters)))
(defun flyspell-word-distance (word1 word2)
"Difference in length between WORD1 and WORD2."
(abs (- (length word1) (length word2))))
(defun flyspell-accent-count (word)
(let ((count 0))
(dolist (x (split-string word "" t) count)
(when (not (member x my-flyspell-regular-letters))
(setq count (1+ count))))))
(defun my-flyspell-sort-corrections-function (word1 word2 word)
"Sort WORD1 and WORD2 as corrections of WORD: favor the
corrections having the same length as WORD, and use
number of 'special' characters as an additional
criteria."
(let ((distance1 (flyspell-word-distance word1 word))
(distance2 (flyspell-word-distance word2 word)))
(if (= distance1 distance2)
(let ((accents-count1 (flyspell-accent-count word1))
(accents-count2 (flyspell-accent-count word2)))
(> accents-count1 accents-count2))
(< distance1 distance2))))
(setq flyspell-sort-corrections-function 'my-flyspell-sort-corrections-function)
(setq flyspell-sort-corrections t)
All comments and remarks are *most* welcome, either on the general
coding style, or on the usefulness of the patch itself; probably on
other things too.
Cheers,
--Seb
========================================================================
--- flyspell.el 2009-02-18 21:53:52.000000000 -0800
+++ flyspell.el 2009-02-19 19:27:52.000000000 -0800
@@ -81,11 +81,34 @@
:type '(alist :key-type string :value-type (repeat string)))
(defcustom flyspell-sort-corrections nil
- "Non-nil means, sort the corrections alphabetically before popping them."
+ "Non-nil means, sort the corrections using
+flyspell-sort-corrections-function (which does alphabetical
+sorting by default) before popping them."
:group 'flyspell
:version "21.1"
:type 'boolean)
+(defcustom flyspell-sort-corrections-function
+ (lambda (correction1 correction2 corrected)
+ (string< correction1 correction2))
+ "Function used to sort the corrections when
+flyspell-sort-corrections is non-nil. It gets passed the 2
+corrections being sorted out, and the word to correct. By
+default, it simply sorts the corrections alphabetically,
+altogether ignoring the word to be corrected. If for instance you
+wanted to favor corrections of the same length as the corrected
+word, you could use:
+
+ (lambda (correction1 correction2 corrected)
+ (let ((distance1 (abs (- (length correction1) (length corrected))))
+ (distance2 (abs (- (length correction2) (length corrected)))))
+ (if (= distance1 distance2)
+ (string< correction1 correction2)
+ (< distance1 distance2))))"
+ :group 'flyspell
+ :version "21.1"
+ :type 'function)
+
(defcustom flyspell-duplicate-distance -1
"The maximum distance for finding duplicates of unrecognized words.
This applies to the feature that when a word is not found in the dictionary,
@@ -532,6 +555,16 @@
(and (consp ws) (window-minibuffer-p (car ws)))))
;;*---------------------------------------------------------------------*/
+;;* flyspell-sort-corrections-function-generator */
+;;* ------------------------------------------------------------- */
+;;* Return the corrections-sorting function for a specific word */
+;;* to be corrected */
+;;*---------------------------------------------------------------------*/
+(defun flyspell-sort-corrections-function-generator (word)
+ (lambda (word1 word2)
+ (funcall flyspell-sort-corrections-function word1 word2 word)))
+
+;;*---------------------------------------------------------------------*/
;;* flyspell-accept-buffer-local-defs ... */
;;*---------------------------------------------------------------------*/
(defvar flyspell-last-buffer nil
@@ -979,7 +1012,8 @@
(let ((replacements (if (stringp poss)
poss
(if flyspell-sort-corrections
- (sort (car (cdr (cdr poss))) 'string<)
+ (sort (car (cdr (cdr poss)))
+ (flyspell-sort-corrections-function-generator word))
(car (cdr (cdr poss)))))))
(if flyspell-issue-message-flag
(message "misspelling `%s' %S" word replacements))))
@@ -1926,7 +1960,8 @@
(t
;; the word is incorrect, we have to propose a replacement
(let ((replacements (if flyspell-sort-corrections
- (sort (car (cdr (cdr poss))) 'string<)
+ (sort (car (cdr (cdr poss)))
+ (flyspell-sort-corrections-function-generator word))
(car (cdr (cdr poss))))))
(setq flyspell-auto-correct-region nil)
(if (consp replacements)
@@ -2176,7 +2211,8 @@
(1+ (cdr (cdr mouse-pos))))
(car mouse-pos)))))
(let* ((corrects (if flyspell-sort-corrections
- (sort (car (cdr (cdr poss))) 'string<)
+ (sort (car (cdr (cdr poss)))
+ (flyspell-sort-corrections-function-generator word))
(car (cdr (cdr poss)))))
(cor-menu (if (consp corrects)
(mapcar (lambda (correct)
@@ -2209,7 +2245,8 @@
(defun flyspell-xemacs-popup (poss word cursor-location start end save)
"The XEmacs popup menu."
(let* ((corrects (if flyspell-sort-corrections
- (sort (car (cdr (cdr poss))) 'string<)
+ (sort (car (cdr (cdr poss)))
+ (flyspell-sort-corrections-function-generator word))
(car (cdr (cdr poss)))))
(cor-menu (if (consp corrects)
(mapcar (lambda (correct)
========================================================================
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.