mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2025-01-20 19:24:20 +00:00
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
parent
2c9f6fcef9
commit
9d9f5179e7
@ -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))))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 ()
|
||||
|
||||
50
lisp/org.el
50
lisp/org.el
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user