org: New Org-wide custom option `org-sort-function'

* lisp/org-macs.el (org-sort-function): New customization defining how
Org mode should sort headlines, table lines, agenda lines, etc.
(org-string<):
(org-string<=):
(org-string>=):
(org-string>): Use the new customization.
(org-string<>): Add docstring.
(org-sort-function-fallback): New helper function to help users on
MacOS where `string-collate-lessp' is not reliable.
* lisp/oc-basic.el (org-cite-basic--field-less-p):
* lisp/org-agenda.el (org-cmp-category):
(org-cmp-alpha):
* lisp/org-list.el (org-sort-list):
* lisp/org-mouse.el (org-mouse-list-options-menu):
* lisp/org-table.el (org-table-sort-lines):
* lisp/org.el (org-tags-sort-function):
(org-sort-entries):
* lisp/ox-publish.el (org-publish-sitemap): Honor the new
customization.
* lisp/org-mouse.el (org-mouse-tag-menu):
(org-mouse-popup-global-menu):
* lisp/org-agenda.el (org-cmp-tag): Honor `org-tags-sort-function' and
falling back to `org-string<' if note set.
* etc/ORG-NEWS (New option controlling how Org mode sorts things
~org-sort-function~): Announce the change.

This change aims to standardize the way Org mode performs sorting of
user data.  In particular, it addresses issues with oddities of string
collation rules on MacOS and tricky language environments like
Turkish.

Link: https://orgmode.org/list/87jzleptcs.fsf@localhost

etc/ORG-NEWS

@@ -720,6 +720,26 @@ any more.  Run ~org-ctags-enable~ to setup hooks and advices:
 #+end_src
 
 ** New and changed options
+*** New option controlling how Org mode sorts things ~org-sort-function~
+
+Sorting of agenda items, tables, menus, headlines, etc can now be
+controlled using a new custom option ~org-sort-function~.
+
+By default, Org mode sorts things according to the operation system
+language.  However, language sorting rules may or may not produce good
+results depending on the use case.  For example, multi-language
+documents may be sorted weirdly when sorting rules for system language
+are applied on the text written using different language.  Also, some
+operations systems (e.g. MacOS), do not provide accurate string
+sorting rules.
+
+Org mode provides 3 possible values for ~org-sort-function~:
+1. (default) Sort using system language rules.
+2. Sort using string comparison (~compare-strings~), making use of UTF
+   case conversion.  This may work better for mixed-language documents
+   and on MacOS.
+3. Custom function, if the above does not fit the needs.
+
 *** =ob-latex= now uses a new option ~org-babel-latex-process-alist~ to generate png output
 
 Previously, =ob-latex= used ~org-preview-latex-default-process~ from

lisp/oc-basic.el

@@ -680,7 +680,7 @@ INFO is the export state as a property list."
 INFO is the export state, as a property list."
   (and field
        (lambda (a b)
-         (string-collate-lessp
+         (org-string<
           (org-cite-basic--get-field field a info 'raw)
           (org-cite-basic--get-field field b info 'raw)
           nil t))))

lisp/org-agenda.el

@@ -7490,8 +7490,8 @@ The optional argument TYPE tells the agenda type."
   "Compare the string values of categories of strings A and B."
   (let ((ca (or (get-text-property (1- (length a)) 'org-category a) ""))
 	(cb (or (get-text-property (1- (length b)) 'org-category b) "")))
-    (cond ((string-lessp ca cb) -1)
-	  ((string-lessp cb ca) +1))))
+    (cond ((org-string< ca cb) -1)
+	  ((org-string< cb ca) +1))))
 
 (defsubst org-cmp-todo-state (a b)
   "Compare the todo states of strings A and B."
@@ -7537,8 +7537,8 @@ The optional argument TYPE tells the agenda type."
     (cond ((not (or ta tb)) nil)
 	  ((not ta) +1)
 	  ((not tb) -1)
-	  ((string-lessp ta tb) -1)
-	  ((string-lessp tb ta) +1))))
+	  ((org-string< ta tb) -1)
+	  ((org-string< tb ta) +1))))
 
 (defsubst org-cmp-tag (a b)
   "Compare the string values of the first tags of A and B."
@@ -7547,8 +7547,8 @@ The optional argument TYPE tells the agenda type."
     (cond ((not (or ta tb)) nil)
 	  ((not ta) +1)
 	  ((not tb) -1)
-	  ((string-lessp ta tb) -1)
-	  ((string-lessp tb ta) +1))))
+	  ((funcall (or org-tags-sort-function #'org-string<) ta tb) -1)
+	  ((funcall (or org-tags-sort-function #'org-string<) tb ta) +1))))
 
 (defsubst org-cmp-time (a b)
   "Compare the time-of-day values of strings A and B."

lisp/org-list.el

@@ -2979,7 +2979,7 @@ function is being called interactively."
 		   (error "Missing key extractor"))))
 	 (sort-func
 	  (cond
-	   ((= dcst ?a) #'string-collate-lessp)
+	   ((= dcst ?a) #'org-string<)
 	   ((= dcst ?f)
 	    (or compare-func
 		(and interactive?

lisp/org-macs.el

@@ -113,7 +113,6 @@ Version mismatch is commonly encountered in the following situations:
 (declare-function org-fold-next-visibility-change "org-fold" (&optional pos limit ignore-hidden-p previous-p))
 (declare-function org-fold-core-with-forced-fontification "org-fold" (&rest body))
 (declare-function org-fold-folded-p "org-fold" (&optional pos limit ignore-hidden-p previous-p))
-(declare-function string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case))
 (declare-function org-time-convert-to-list "org-compat" (time))
 (declare-function org-buffer-text-pixel-width "org-compat" ())
 
@@ -982,20 +981,67 @@ return nil."
 
 ;;; String manipulation
 
-(defun org-string< (a b)
-  (string-collate-lessp a b))
+(defcustom org-sort-function #'string-collate-lessp
+  "Function used to compare strings when sorting.
+This function affects how Org mode sorts headlines, agenda items,
+table lines, etc.
 
-(defun org-string<= (a b)
-  (or (string= a b) (string-collate-lessp a b)))
+The function must accept either 2 or 4 arguments: strings to compare
+and, optionally, LOCALE and IGNORE-CASE - locale name and flag to make
+comparison case-insensitive.
 
-(defun org-string>= (a b)
-  (not (string-collate-lessp a b)))
+The default value uses sorting rules according to OS language.  Users
+who want to make sorting language-independent, may customize the value
+to `org-sort-function-fallback'.
 
-(defun org-string> (a b)
+Note that some string sorting rules are known to be not accurate on
+MacOS.  See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=59275.
+MacOS users may customize the value to
+`org-sort-function-fallback'."
+  :group 'org
+  :package-version '(Org . "9.7")
+  :type '(choice
+          (const :tag "According to OS language" string-collate-lessp)
+          (const :tag "Using string comparison" org-sort-function-fallback)
+          (function :tag "Custom function")))
+
+(defun org-sort-function-fallback (a b &optional _ ignore-case)
+  "Return non-nil when downcased string A < string B.
+Use `compare-strings' for comparison.  Honor IGNORE-CASE."
+  (let ((ans (compare-strings a nil nil b nil nil ignore-case)))
+    (cond
+     ((and (numberp ans) (< ans 0)) t)
+     (t nil))))
+
+(defun org-string< (a b &optional locale ignore-case)
+  "Return non-nil when string A < string B.
+LOCALE is the locale name.  IGNORE-CASE, when non-nil, makes comparison
+ignore case."
+  (if (= 4 (cdr (func-arity org-sort-function)))
+      (funcall org-sort-function a b locale ignore-case)
+    (funcall org-sort-function a b)))
+
+(defun org-string<= (a b &optional locale ignore-case)
+  "Return non-nil when string A <= string B.
+LOCALE is the locale name.  IGNORE-CASE, when non-nil, makes comparison
+ignore case."
+  (or (string= a b) (org-string< a b locale ignore-case)))
+
+(defun org-string>= (a b &optional locale ignore-case)
+  "Return non-nil when string A >= string B.
+LOCALE is the locale name.  IGNORE-CASE, when non-nil, makes comparison
+ignore case."
+  (not (org-string< a b locale ignore-case)))
+
+(defun org-string> (a b &optional locale ignore-case)
+  "Return non-nil when string A > string B.
+LOCALE is the locale name.  IGNORE-CASE, when non-nil, makes comparison
+ignore case."
   (and (not (string= a b))
-       (not (string-collate-lessp a b))))
+       (not (org-string< a b locale ignore-case))))
 
 (defun org-string<> (a b)
+  "Return non-nil when string A and string B are not equal."
   (not (string= a b)))
 
 (defsubst org-trim (s &optional keep-lead)

lisp/org-mouse.el

@@ -426,13 +426,14 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
   (append
    (let ((tags (org-get-tags nil t)))
      (org-mouse-keyword-menu
-      (sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
+      (sort (mapcar #'car (org-get-buffer-tags))
+            (or org-tags-sort-function #'org-string<))
       (lambda (tag)
 	(org-mouse-set-tags
 	 (sort (if (member tag tags)
 		   (delete tag tags)
 		 (cons tag tags))
-	       #'string-lessp)))
+	       (or org-tags-sort-function #'org-string<))))
       (lambda (tag) (member tag tags))
       ))
    '("--"
@@ -473,7 +474,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
 				    (sort (if (member ',name ',options)
 					      (delete ',name ',options)
 					    (cons ',name ',options))
-					  'string-lessp)
+					  #'org-string<)
 				    " ")
 			 nil nil nil 1)
 			(when (functionp ',function) (funcall ',function)))
@@ -502,7 +503,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
      ["Check TODOs" org-show-todo-tree t]
      ("Check Tags"
       ,@(org-mouse-keyword-menu
-	 (sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
+	 (sort (mapcar #'car (org-get-buffer-tags))
+               (or org-tags-sort-function #'org-string<))
          (lambda (tag) (org-tags-sparse-tree nil tag)))
       "--"
       ["Custom Tag ..." org-tags-sparse-tree t])
@@ -512,7 +514,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
      ["Display TODO List" org-todo-list t]
      ("Display Tags"
       ,@(org-mouse-keyword-menu
-	 (sort (mapcar #'car (org-get-buffer-tags)) #'string-lessp)
+	 (sort (mapcar #'car (org-get-buffer-tags))
+               (or org-tags-sort-function #'org-string<))
          (lambda (tag) (org-tags-view nil tag)))
       "--"
       ["Custom Tag ..." org-tags-view t])

lisp/org-table.el

@@ -4637,8 +4637,8 @@ function is being called interactively."
 	     (predicate
 	      (cl-case sorting-type
 		((?n ?N ?t ?T) #'<)
-		((?a ?A) (if with-case #'string-collate-lessp
-			   (lambda (s1 s2) (string-collate-lessp s1 s2 nil t))))
+		((?a ?A) (if with-case #'org-string<
+			   (lambda (s1 s2) (org-string< s1 s2 nil t))))
 		((?f ?F)
 		 (or compare-func
 		     (and interactive?

lisp/org.el

@@ -2944,8 +2944,8 @@ is better to limit inheritance to certain tags using the variables
   :group 'org-tags
   :type '(choice
 	  (const :tag "No sorting" nil)
-	  (const :tag "Alphabetical" string-collate-lessp)
-	  (const :tag "Reverse alphabetical" org-string-collate-greaterp)
+	  (const :tag "Alphabetical" org-string<)
+	  (const :tag "Reverse alphabetical" org-string>)
 	  (function :tag "Custom function" nil)))
 
 (defvar org-tags-history nil
@@ -7975,7 +7975,7 @@ function is being called interactively."
 	     (t (error "Invalid sorting type `%c'" sorting-type))))
 	  nil
 	  (cond
-	   ((= dcst ?a) 'string-collate-lessp)
+	   ((= dcst ?a) #'org-string<)
 	   ((= dcst ?f)
 	    (or compare-func
 		(and interactive?

lisp/ox-publish.el

@@ -794,17 +794,14 @@ Default for SITEMAP-FILENAME is `sitemap.org'."
 			      (concat (file-name-directory b)
 				      (org-publish-find-title b project))
 			    b)))
-		   (setq retval
-			 (if ignore-case
-			     (not (string-lessp (upcase B) (upcase A)))
-			   (not (string-lessp B A))))))
+		   (setq retval (org-string<= A B nil ignore-case))))
 		((or `anti-chronologically `chronologically)
 		 (let* ((adate (org-publish-find-date a project))
 			(bdate (org-publish-find-date b project)))
 		   (setq retval
 			 (not (if (eq sort-files 'chronologically)
-				  (time-less-p bdate adate)
-				(time-less-p adate bdate))))))
+				(time-less-p bdate adate)
+			      (time-less-p adate bdate))))))
 		(`nil nil)
 		(_ (user-error "Invalid sort value %s" sort-files)))
 	      ;; Directory-wise wins: