summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKyle Meyer <kyle@kyleam.com>2017-05-09 14:57:40 -0400
committerKyle Meyer <kyle@kyleam.com>2017-05-18 14:46:33 -0400
commit9d9f5179e7c6b42ae89638c1f9b8bee523dec3c0 (patch)
treeffeb0f33417509a43a5d239439ebbea6bbd4103a
parent2c9f6fcef9dce2ace56e542f49f5f289dd741ce7 (diff)
downloadorg-mode-9d9f5179e7c6b42ae89638c1f9b8bee523dec3c0.tar.gz
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>
-rw-r--r--lisp/org-list.el45
-rw-r--r--lisp/org-macs.el10
-rw-r--r--lisp/org-table.el32
-rw-r--r--lisp/org.el54
4 files changed, 90 insertions, 51 deletions
diff --git a/lisp/org-list.el b/lisp/org-list.el
index b49bff8..92c57ae 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -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))))
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index e4b39a2..ca47e5a 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -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
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 84e2b4d..40a715a 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -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 ()
diff --git a/lisp/org.el b/lisp/org.el
index 079c089..1e28051 100644
--- a/lisp/org.el
+++ b/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))
-
- (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 @@ 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