[elpa] externals/org 4131926984 1/2: org: New Org-wide custom option `org-sort-function'

[ELPA Syncer]

branch: externals/org
commit 4131926984fa8240a526a6cf3d8ef76c1df1dbbe
Author: Ihor Radchenko <yantar92@posteo.net>
Commit: Ihor Radchenko <yantar92@posteo.net>

    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       | 20 ++++++++++++++++
 lisp/oc-basic.el   |  2 +-
 lisp/org-agenda.el | 12 +++++-----
 lisp/org-list.el   |  2 +-
 lisp/org-macs.el   | 70 ++++++++++++++++++++++++++++++++++++++++++++----------
 lisp/org-mouse.el  | 13 ++++++----
 lisp/org-table.el  |  4 ++--
 lisp/org.el        |  6 ++---
 lisp/ox-publish.el |  9 +++----
 9 files changed, 102 insertions(+), 36 deletions(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 36eeddda1f..978882a7ad 100644
--- a/etc/ORG-NEWS
+++ b/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
diff --git a/lisp/oc-basic.el b/lisp/oc-basic.el
index 8959bb065c..6e3142fa12 100644
--- a/lisp/oc-basic.el
+++ b/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))))
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 00d48e7d4a..d591df2f16 100644
--- a/lisp/org-agenda.el
+++ b/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."
diff --git a/lisp/org-list.el b/lisp/org-list.el
index fca3758c84..d7559d2a7c 100644
--- a/lisp/org-list.el
+++ 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?
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 1254ddb541..96014a244c 100644
--- a/lisp/org-macs.el
+++ b/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))
-
-(defun org-string<= (a b)
-  (or (string= a b) (string-collate-lessp a b)))
-
-(defun org-string>= (a b)
-  (not (string-collate-lessp a b)))
-
-(defun org-string> (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.
+
+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.
+
+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'.
+
+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)
diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el
index 2904bad1f7..0b1ddaa6ef 100644
--- a/lisp/org-mouse.el
+++ b/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])
diff --git a/lisp/org-table.el b/lisp/org-table.el
index a1bd140fb0..0dbe6b0225 100644
--- a/lisp/org-table.el
+++ b/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?
diff --git a/lisp/org.el b/lisp/org.el
index 92fa575ca9..6210064a66 100644
--- a/lisp/org.el
+++ b/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?
diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el
index 3e526b8131..1b623ce9fb 100644
--- a/lisp/ox-publish.el
+++ b/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: