Subject: bug#13041: 24.2; diacritic-fold-search

From: martin rudalics <[email-masked]>
Date: Tue, 04 Dec 2012 18:54:59 +0100

> Yes, you can modify the table set up by uni-decomposition.el.  I
 > think.

Seems to work well.  The function I came up with goes as below.

Thanks for the hints, martin

(defun decomposed-string-lessp (string1 string2)
   "Return t if STRING1 is decomposition-less than STRING2."
   (let* ((length1 (length string1))
	 (length2 (length string2))
	 (min-length (min length1 length2))
	 (index1 0)
	 (index2 0)
	 prop1 prop2 type1 type2 compat1 compat2)
     (catch 'found
       (while (and (< index1 length1) (< index2 length2))
	(setq prop1 (get-char-code-property
		     (downcase (elt string1 index1)) 'decomposition))
	(setq type1 (car prop1))
	(setq prop2 (get-char-code-property
		     (downcase (elt string2 index2)) 'decomposition))
	(setq type2 (car prop2))
	(cond
	 ((and (eq type1 'compat) (eq type2 'compat))
	  (setq compat1 (concat (cdr prop1)))
	  (setq compat2 (concat (cdr prop2)))
	  (let ((value (compare-strings compat1 0 nil compat2 0 nil t)))
	    (cond
	     ((eq value t)
	      (setq index1 (1+ index1))
	      (setq index2 (1+ index2)))
	     ((< value 0)
	      (throw 'found t))
	     ((< value 0)
	      (throw 'found nil)))))
	 ((eq type1 'compat)
	  (setq compat1 (concat (cdr prop1)))
	  (let ((value
		 (compare-strings
		  compat1 0 nil
		  string2 index2 (min (+ index2 (length compat1)) length2) t)))
	    (cond
	     ((eq value t)
	      (setq index1 (1+ index1))
	      (setq index2 (+ index2 (length compat1))))
	     ((< value 0)
	      (throw 'found t))
	     ((< value 0)
	      (throw 'found nil)))))
	 ((eq type2 'compat)
	  (setq compat2 (concat (cdr prop2)))
	  (let ((value
		 (compare-strings
		  string1 index1 (min (+ index1 (length compat2)) length1)
		  compat2 0 nil t)))
	    (cond
	     ((eq value t)
	      (setq index1 (+ index1 (length compat2)))
	      (setq index2 (1+ index2)))
	     ((< value 0)
	      (throw 'found t))
	     ((< value 0)
	      (throw 'found nil)))))
	 ((< type1 type2)
	  (throw 'found t))
	 ((> type1 type2)
	  (throw 'found nil))
	 (t
	  (setq index1 (1+ index1))
	  (setq index2 (1+ index2)))))
       ;; Shorter is less.
       (< length1 length2))))