Re: [O] [PATCH v2] org-sort: Read compare-func in interactive calls

[Kyle Meyer]

Nicolas Goaziou <address@hidden> writes:

> Kyle Meyer <address@hidden> writes:

[...]

>> So I'm fine removing called-interactively-p from org-table-sort-lines,
>> but I'm not sure how it should behave, particularly with respect to the
>> column prompt.
>>
>> Thoughts?
>
> Couldn't we use (interactive "p") instead, as suggested in
> `called-interactively-p' docstring, in order to tell if we need to ask
> for a function or not?

I think (interactive "p"), or (interactive "P\np"), would be undesirable
because we'd be 1) changing the call signatures in a way that's not
backward compatible and 2) positioning an argument that shouldn't
concern most users toward the front of the argument list.

But the below patch is similar in spirit.

-- >8 --
Subject: [PATCH v2] org-sort: Read compare-func in interactive calls

* lisp/org-macs.el (org-read-function): New function.
* lisp/org-table.el (org-table-sort-lines): Make WITH-CASE an optional
argument to match org-sort-entries and org-sort-list.
* lisp/org.el (org-sort-entries):
* lisp/org-table.el (org-table-sort-lines):
* lisp/org-list.el (org-sort-list): Read COMPARE-FUNC when called
interactively rather than being restricted to the default behavior of
sort-subr's PREDICATE parameter.  Only prompt for for GETKEY-FUNC and
COMPARE-FUNC during an interactive call, like org-table-sort-lines
already did for GETKEY-FUNC, but use an argument rather than relying
on the brittle called-interactively-p.

Suggested-by: Zhitao Gong <address@hidden>
<https://lists.gnu.org/archive/html/emacs-orgmode/2017-05/msg00040.html>
---
 lisp/org-list.el  | 45 ++++++++++++++++++++++++++++-----------------
 lisp/org-macs.el  | 10 ++++++++++
 lisp/org-table.el | 32 +++++++++++++++++++-------------
 lisp/org.el       | 54 +++++++++++++++++++++++++++++++++---------------------
 4 files changed, 90 insertions(+), 51 deletions(-)

diff --git a/lisp/org-list.el b/lisp/org-list.el
index b49bff8b9..92c57ae5e 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -2837,7 +2837,8 @@ (defun org-cycle-item-indentation ()
           (t (user-error "Cannot move item"))))
        t))))
 
-(defun org-sort-list (&optional with-case sorting-type getkey-func 
compare-func)
+(defun org-sort-list
+    (&optional with-case sorting-type getkey-func compare-func interactive?)
   "Sort list items.
 The cursor may be at any item of the list that should be sorted.
 Sublists are not sorted.  Checkboxes, if any, are ignored.
@@ -2863,13 +2864,15 @@ (defun org-sort-list (&optional with-case sorting-type 
getkey-func compare-func)
 
 If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
 a function to be called with point at the beginning of the
-record.  It must return either a string or a number that should
-serve as the sorting key for that record.  It will then use
-COMPARE-FUNC to compare entries.
+record.  It must return a value that is compatible with COMPARE-FUNC,
+the function used to compare entries.
 
 Sorting is done against the visible part of the headlines, it
-ignores hidden links."
-  (interactive "P")
+ignores hidden links.
+
+A non-nil value for INTERACTIVE? is used to signal that this
+function is being called interactively."
+  (interactive (list current-prefix-arg nil nil nil t))
   (let* ((case-func (if with-case 'identity 'downcase))
          (struct (org-list-struct))
          (prevs (org-list-prevs-alist struct))
@@ -2881,23 +2884,31 @@ (defun org-sort-list (&optional with-case sorting-type 
getkey-func compare-func)
                (message
                 "Sort plain list: [a]lpha  [n]umeric  [t]ime  [f]unc  
[x]checked  A/N/T/F/X means reversed:")
                (read-char-exclusive))))
+        (dcst (downcase sorting-type))
         (getkey-func
-         (or getkey-func
-             (and (= (downcase sorting-type) ?f)
-                  (intern (completing-read "Sort using function: "
-                                           obarray 'fboundp t nil nil))))))
+         (and (= dcst ?f)
+              (or getkey-func
+                  (and interactive?
+                       (org-read-function "Function for extracting keys: "))
+                  (error "Missing key extractor"))))
+        (sort-func
+         (cond
+          ((= dcst ?a) #'string<)
+          ((= dcst ?f)
+           (or compare-func
+               (and interactive?
+                    (org-read-function
+                     (concat "Function for comparing keys"
+                             "(empty for default `sort-subr' predicate): ")
+                     'allow-empty))))
+          ((= dcst ?t) #'<)
+          ((= dcst ?x) #'string<))))
     (message "Sorting items...")
     (save-restriction
       (narrow-to-region start end)
       (goto-char (point-min))
-      (let* ((dcst (downcase sorting-type))
-            (case-fold-search nil)
+      (let* ((case-fold-search nil)
             (now (current-time))
-            (sort-func (cond
-                        ((= dcst ?a) 'string<)
-                        ((= dcst ?f) compare-func)
-                        ((= dcst ?t) '<)
-                        ((= dcst ?x) 'string<)))
             (next-record (lambda ()
                            (skip-chars-forward " \r\t\n")
                            (or (eobp) (beginning-of-line))))
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index e4b39a2c2..ca47e5a5a 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -294,6 +294,16 @@ (defun org-unbracket-string (pre post string)
       (substring string (length pre) (- (length post)))
     string))
 
+(defun org-read-function (prompt &optional allow-empty?)
+  "Prompt for a function.
+If ALLOW-EMPTY? is non-nil, return nil rather than raising an
+error when the user input is empty."
+  (let ((func (completing-read prompt obarray #'fboundp t)))
+    (cond ((not (string= func ""))
+          (intern func))
+         (allow-empty? nil)
+         (t (user-error "Empty input is not valid")))))
+
 (provide 'org-macs)
 
 ;;; org-macs.el ends here
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 84e2b4d4e..40a715aeb 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -1647,7 +1647,8 @@ (defun org-table-kill-row ()
                              dline -1 dline))))
 
 ;;;###autoload
-(defun org-table-sort-lines (with-case &optional sorting-type getkey-func 
compare-func)
+(defun org-table-sort-lines
+    (&optional with-case sorting-type getkey-func compare-func interactive?)
   "Sort table lines according to the column at point.
 
 The position of point indicates the column to be used for
@@ -1671,12 +1672,13 @@ (defun org-table-sort-lines (with-case &optional 
sorting-type getkey-func compar
 sorting should be done in reverse order.
 
 If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
-a function to be called to extract the key.  It must return either
-a string or a number that should serve as the sorting key for that
-row.  It will then use COMPARE-FUNC to compare entries.  If GETKEY-FUNC
-is specified interactively, the comparison will be either a string or
-numeric compare based on the type of the first key in the table."
-  (interactive "P")
+a function to be called to extract the key.  It must return a value
+that is compatible with COMPARE-FUNC, the function used to compare
+entries.
+
+A non-nil value for INTERACTIVE? is used to signal that this
+function is being called interactively."
+  (interactive (list current-prefix-arg nil nil nil t))
   (when (org-region-active-p) (goto-char (region-beginning)))
   ;; Point must be either within a field or before a data line.
   (save-excursion
@@ -1686,7 +1688,7 @@ (defun org-table-sort-lines (with-case &optional 
sorting-type getkey-func compar
   ;; Set appropriate case sensitivity and column used for sorting.
   (let ((column (let ((c (org-table-current-column)))
                  (cond ((> c 0) c)
-                       ((called-interactively-p 'any)
+                       (interactive?
                         (read-number "Use column N for sorting: "))
                        (t 1))))
        (sorting-type
@@ -1734,17 +1736,21 @@ (defun org-table-sort-lines (with-case &optional 
sorting-type getkey-func compar
                         (t 0))))
                ((?f ?F)
                 (or getkey-func
-                    (and (called-interactively-p 'any)
-                         (intern
-                          (completing-read "Sort using function: "
-                                           obarray #'fboundp t)))
+                    (and interactive?
+                         (org-read-function "Function for extracting keys: "))
                     (error "Missing key extractor to sort rows")))
                (t (user-error "Invalid sorting type `%c'" sorting-type))))
             (predicate
              (cl-case sorting-type
                ((?n ?N ?t ?T) #'<)
                ((?a ?A) #'string<)
-               ((?f ?F) compare-func))))
+               ((?f ?F)
+                (or compare-func
+                    (and interactive?
+                         (org-read-function
+                          (concat "Fuction for comparing keys "
+                                  "(empty for default `sort-subr' predicate): 
")
+                          'allow-empty)))))))
        (goto-char (point-min))
        (sort-subr (memq sorting-type '(?A ?N ?T ?F))
                   (lambda ()
diff --git a/lisp/org.el b/lisp/org.el
index 20f130478..a400ba278 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -9090,7 +9090,8 @@ (defvar org-after-sorting-entries-or-items-hook nil
 will be in the first entry of the sorted region/list.")
 
 (defun org-sort-entries
-    (&optional with-case sorting-type getkey-func compare-func property)
+    (&optional with-case sorting-type getkey-func compare-func property
+              interactive?)
   "Sort entries on a certain level of an outline tree.
 If there is an active region, the entries in the region are sorted.
 Else, if the cursor is before the first entry, sort the top-level items.
@@ -9120,8 +9121,9 @@ (defun org-sort-entries
 Capital letters will reverse the sort order.
 
 If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
-called with point at the beginning of the record.  It must return either
-a string or a number that should serve as the sorting key for that record.
+called with point at the beginning of the record.  It must return a
+value that is compatible with COMPARE-FUNC, the function used to
+compare entries.
 
 Comparing entries ignores case by default.  However, with an optional argument
 WITH-CASE, the sorting considers case as well.
@@ -9129,8 +9131,11 @@ (defun org-sort-entries
 Sorting is done against the visible part of the headlines, it ignores hidden
 links.
 
-When sorting is done, call `org-after-sorting-entries-or-items-hook'."
-  (interactive "P")
+When sorting is done, call `org-after-sorting-entries-or-items-hook'.
+
+A non-nil value for INTERACTIVE? is used to signal that this
+function is being called interactively."
+  (interactive (list current-prefix-arg nil nil nil nil t))
   (let ((case-func (if with-case 'identity 'downcase))
        (cmstr
         ;; The clock marker is lost when using `sort-subr', let's
@@ -9199,21 +9204,22 @@ (defun org-sort-entries
                [t]ime [s]cheduled  [d]eadline  [c]reated  cloc[k]ing
                A/N/P/R/O/F/T/S/D/C/K means reversed:"
        what)
-      (setq sorting-type (read-char-exclusive))
-
-      (unless getkey-func
-       (and (= (downcase sorting-type) ?f)
-            (setq getkey-func
-                  (completing-read "Sort using function: "
-                                   obarray 'fboundp t nil nil))
-            (setq getkey-func (intern getkey-func))))
-
-      (and (= (downcase sorting-type) ?r)
-          (not property)
-           (setq property
-                 (completing-read "Property: "
-                                 (mapcar #'list (org-buffer-property-keys t))
-                                 nil t))))
+      (setq sorting-type (read-char-exclusive)))
+
+    (unless getkey-func
+      (and (= (downcase sorting-type) ?f)
+          (setq getkey-func
+                (or (and interactive?
+                         (org-read-function
+                          "Function for extracting keys: "))
+                    (error "Missing key extractor")))))
+
+    (and (= (downcase sorting-type) ?r)
+        (not property)
+        (setq property
+              (completing-read "Property: "
+                               (mapcar #'list (org-buffer-property-keys t))
+                               nil t)))
 
     (when (member sorting-type '(?k ?K)) (org-clock-sum))
     (message "Sorting entries...")
@@ -9297,7 +9303,13 @@ (defun org-sort-entries
          nil
          (cond
           ((= dcst ?a) 'string<)
-          ((= dcst ?f) compare-func)
+          ((= dcst ?f)
+          (or compare-func
+              (and interactive?
+                   (org-read-function
+                    (concat "Function for comparing keys "
+                            "(empty for default `sort-subr' predicate): ")
+                    'allow-empty))))
           ((member dcst '(?p ?t ?s ?d ?c ?k)) '<)))))
     (run-hooks 'org-after-sorting-entries-or-items-hook)
     ;; Reset the clock marker if needed
-- 
2.12.2