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 <zhitaao.gong@gmail.com>
<https://lists.gnu.org/archive/html/emacs-orgmode/2017-05/msg00040.html>
This commit is contained in:
Kyle Meyer 2017-05-09 14:57:40 -04:00
parent 2c9f6fcef9
commit 9d9f5179e7
4 changed files with 88 additions and 49 deletions

View File

@ -2837,7 +2837,8 @@ Return t at each successful move."
(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 @@ 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. 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 @@ ignores hidden links."
(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))))

View File

@ -294,6 +294,16 @@ removed."
(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

View File

@ -1647,7 +1647,8 @@ In particular, this does handle wide and invisible characters."
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 @@ any of (?a ?A ?n ?N ?t ?T ?f ?F) where the capital letters indicate that
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 @@ numeric compare based on the type of the first key in the table."
;; 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 @@ numeric compare based on the type of the first key in the table."
(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 ()

View File

@ -9090,7 +9090,8 @@ hook gets called. When a region or a plain list is sorted, the cursor
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 @@ t By date/time, either the first active time stamp in the entry, or, if
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 @@ WITH-CASE, the sorting considers case as well.
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 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'."
[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))
(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))))
(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))))
(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 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'."
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