emacs-orgmode
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

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


From: Kyle Meyer
Subject: [O] [PATCH] org-sort: Read compare-func in interactive calls
Date: Tue, 9 May 2017 15:47:50 -0400

* lisp/org-macs.el (org-read-function): New function.
* 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.  Guard prompts for GETKEY-FUNC and
COMPARE-FUNCTION with called-interactively-p, like
org-table-sort-lines already did for GETKEY-FUNC.

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

diff --git a/lisp/org-list.el b/lisp/org-list.el
index b49bff8b9..17ff5d160 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -2863,9 +2863,8 @@ (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."
@@ -2881,23 +2880,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 (called-interactively-p 'any)
+                       (org-read-function "Function for extracting keys: "))
+                  (error "Missing key extractor"))))
+        (sort-func
+         (cond
+          ((= dcst ?a) #'string<)
+          ((= dcst ?f)
+           (or compare-func
+               (and (called-interactively-p 'any)
+                    (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..d37edbe83 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -1671,11 +1671,9 @@ (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."
+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."
   (interactive "P")
   (when (org-region-active-p) (goto-char (region-beginning)))
   ;; Point must be either within a field or before a data line.
@@ -1735,16 +1733,20 @@ (defun org-table-sort-lines (with-case &optional 
sorting-type getkey-func compar
                ((?f ?F)
                 (or getkey-func
                     (and (called-interactively-p 'any)
-                         (intern
-                          (completing-read "Sort using function: "
-                                           obarray #'fboundp t)))
+                         (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 (called-interactively-p 'any)
+                         (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..251b19cb7 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -9120,8 +9120,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.
@@ -9199,21 +9200,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 (called-interactively-p 'any)
+                         (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 +9299,13 @@ (defun org-sort-entries
          nil
          (cond
           ((= dcst ?a) 'string<)
-          ((= dcst ?f) compare-func)
+          ((= dcst ?f)
+          (or compare-func
+              (and (called-interactively-p 'any)
+                   (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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]