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

From: Sebastien Delafond <[email-masked]>
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)
========================================================================