Flyspell patch - Provide users with a way to specify their own sort function

[Sebastien Delafond]

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)
========================================================================