From mboxrd@z Thu Jan 1 00:00:00 1970 From: Kyle Meyer Subject: [PATCH] org-sort: Read compare-func in interactive calls Date: Tue, 9 May 2017 15:47:50 -0400 Message-ID: <20170509194750.8974-1-kyle@kyleam.com> References: <871srz5mbr.fsf@kyleam.com> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:59453) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d8B76-0001vk-Qd for emacs-orgmode@gnu.org; Tue, 09 May 2017 15:48:06 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d8B72-0003Iq-Gk for emacs-orgmode@gnu.org; Tue, 09 May 2017 15:48:04 -0400 Received: from pb-smtp2.pobox.com ([64.147.108.71]:64834 helo=sasl.smtp.pobox.com) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1d8B72-0003Hp-B6 for emacs-orgmode@gnu.org; Tue, 09 May 2017 15:48:00 -0400 In-Reply-To: <871srz5mbr.fsf@kyleam.com> List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: "Emacs-orgmode" To: Nicolas Goaziou Cc: Zhitao Gong , emacs-orgmode@gnu.org * 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 --- 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