From: Kyle Meyer <kyle@kyleam.com>
To: Nicolas Goaziou <mail@nicolasgoaziou.fr>
Cc: Zhitao Gong <zhitaao.gong@gmail.com>, emacs-orgmode@gnu.org
Subject: [PATCH] org-sort: Read compare-func in interactive calls
Date: Tue, 9 May 2017 15:47:50 -0400 [thread overview]
Message-ID: <20170509194750.8974-1-kyle@kyleam.com> (raw)
In-Reply-To: <871srz5mbr.fsf@kyleam.com>
* 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 <zhitaao.gong@gmail.com>
<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
next prev parent reply other threads:[~2017-05-09 19:48 UTC|newest]
Thread overview: 21+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-05-03 19:36 About org-sort -> org-sort-list with custom sort function Zhitao Gong
2017-05-07 2:55 ` Kyle Meyer
2017-05-07 10:00 ` Nicolas Goaziou
2017-05-07 14:20 ` Kyle Meyer
2017-05-07 15:37 ` Kyle Meyer
2017-05-08 9:48 ` Nicolas Goaziou
2017-05-08 15:24 ` Kyle Meyer
2017-05-08 16:23 ` Nicolas Goaziou
2017-05-08 16:45 ` Kyle Meyer
2017-05-08 16:48 ` Nicolas Goaziou
2017-05-09 19:47 ` Kyle Meyer [this message]
2017-05-11 21:47 ` [PATCH] org-sort: Read compare-func in interactive calls Nicolas Goaziou
2017-05-12 1:48 ` Kyle Meyer
2017-05-12 7:10 ` Nicolas Goaziou
2017-05-13 14:50 ` [PATCH v2] " Kyle Meyer
2017-05-14 8:24 ` Nicolas Goaziou
2017-05-14 13:45 ` Kyle Meyer
2017-05-14 16:51 ` Nicolas Goaziou
2017-05-14 20:54 ` Kyle Meyer
2017-05-17 12:32 ` Nicolas Goaziou
2017-05-09 4:10 ` About org-sort -> org-sort-list with custom sort function Kyle Meyer
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20170509194750.8974-1-kyle@kyleam.com \
--to=kyle@kyleam.com \
--cc=emacs-orgmode@gnu.org \
--cc=mail@nicolasgoaziou.fr \
--cc=zhitaao.gong@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).