From 13711d45836c6d7618184ed76e1bdd94a8c8087e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 20 Dec 2014 21:29:51 +0100 Subject: [PATCH] Fix table sorting with ?F key * lisp/org.el (org-do-sort): Properly reverse results when ?F and a compare function is provided. Small refactoring. * testing/lisp/test-org-table.el (test-org-table/sort-lines): New test. --- lisp/org.el | 76 ++++++++++++++++----------------- testing/lisp/test-org-table.el | 97 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 134 insertions(+), 39 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 03c278994..f1126287c 100755 --- a/lisp/org.el +++ b/lisp/org.el @@ -9076,46 +9076,44 @@ numeric compare based on the type of the first key in the table." "Sort %s: [a]lphabetic, [n]umeric, [t]ime, [f]unc. A/N/T/F means reversed:" what) (setq sorting-type (read-char-exclusive))) - (let ((dcst (downcase sorting-type)) - extractfun comparefun tempfun) + (let (extractfun comparefun tempfun) ;; Define the appropriate functions - (cond - ((= dcst ?n) - (setq extractfun 'string-to-number - comparefun (if (= dcst sorting-type) '< '>))) - ((= dcst ?a) - (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x)) - (lambda(x) (downcase (org-sort-remove-invisible x)))) - comparefun (if (= dcst sorting-type) - 'string< - (lambda (a b) (and (not (string< a b)) - (not (string= a b))))))) - ((= dcst ?t) - (setq extractfun - (lambda (x) - (cond ((or (string-match org-ts-regexp x) - (string-match org-ts-regexp-both x)) - (org-float-time - (org-time-string-to-time (match-string 0 x)))) - ((string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" x) - (org-hh:mm-string-to-minutes x)) - (t 0))) - comparefun (if (= dcst sorting-type) '< '>))) - ((= dcst ?f) - (setq tempfun (or getkey-func - (intern (org-icompleting-read - "Sort using function: " - obarray #'fboundp t nil nil)))) - (let* ((extract-string-p (stringp (funcall tempfun (caar table))))) - (setq extractfun (if (and extract-string-p (not with-case)) - (lambda (x) (downcase (funcall tempfun x))) - tempfun)) - (setq comparefun (cond (compare-func) - (extract-string-p - (if (= sorting-type ?f) #'string< - #'org-string>)) - (t (if (= sorting-type ?f) #'< #'>)))))) - (t (error "Invalid sorting type `%c'" sorting-type))) + (case sorting-type + ((?n ?N) + (setq extractfun #'string-to-number + comparefun (if (= sorting-type ?n) #'< #'>))) + ((?a ?A) + (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x)) + (lambda(x) (downcase (org-sort-remove-invisible x)))) + comparefun (if (= sorting-type ?a) #'string< #'org-string>))) + ((?t ?T) + (setq extractfun + (lambda (x) + (cond ((or (string-match org-ts-regexp x) + (string-match org-ts-regexp-both x)) + (org-float-time + (org-time-string-to-time (match-string 0 x)))) + ((string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" x) + (org-hh:mm-string-to-minutes x)) + (t 0))) + comparefun (if (= sorting-type ?t) '< '>))) + ((?f ?F) + (setq tempfun (or getkey-func + (intern (org-icompleting-read + "Sort using function: " + obarray #'fboundp t nil nil)))) + (let ((extract-string-p (stringp (funcall tempfun (caar table))))) + (setq extractfun (if (and extract-string-p (not with-case)) + (lambda (x) (downcase (funcall tempfun x))) + tempfun)) + (setq comparefun (cond (compare-func + (if (= sorting-type ?f) compare-func + (lambda (a b) (funcall compare-func b a)))) + (extract-string-p + (if (= sorting-type ?f) #'string< + #'org-string>)) + (t (if (= sorting-type ?f) #'< #'>)))))) + (t (error "Invalid sorting type `%c'" sorting-type))) (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x))) table) diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el index 885a62c5a..d9fc9e69a 100644 --- a/testing/lisp/test-org-table.el +++ b/testing/lisp/test-org-table.el @@ -1554,6 +1554,103 @@ See also `test-org-table/copy-field'." (progn (search-forward "# END RECEIVE ORGTBL table") (match-beginning 0))))))) + +;;; Sorting + +(ert-deftest test-org-table/sort-lines () + "Test `org-table-sort-lines' specifications." + ;; Sort numerically. + (should + (equal "| 1 | 2 |\n| 2 | 4 |\n| 5 | 3 |\n" + (org-test-with-temp-text "| 1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n" + (org-table-sort-lines nil ?n) + (buffer-string)))) + (should + (equal "| 5 | 3 |\n| 2 | 4 |\n| 1 | 2 |\n" + (org-test-with-temp-text "| 1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n" + (org-table-sort-lines nil ?N) + (buffer-string)))) + ;; Sort alphabetically. + (should + (equal "| a | x |\n| b | 4 |\n| c | 3 |\n" + (org-test-with-temp-text "| a | x |\n| c | 3 |\n| b | 4 |\n" + (org-table-sort-lines nil ?a) + (buffer-string)))) + (should + (equal "| c | 3 |\n| b | 4 |\n| a | x |\n" + (org-test-with-temp-text "| a | x |\n| c | 3 |\n| b | 4 |\n" + (org-table-sort-lines nil ?A) + (buffer-string)))) + ;; Sort alphabetically with case. + (should + (equal "| C |\n| a |\n| b |\n" + (org-test-with-temp-text "| a |\n| C |\n| b |\n" + (org-table-sort-lines t ?a) + (buffer-string)))) + (should + (equal "| C |\n| b |\n| a |\n" + (org-test-with-temp-text "| a |\n| C |\n| b |\n" + (org-table-sort-lines nil ?A) + (buffer-string)))) + ;; Sort by time (timestamps) + (should + (equal + "| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n| <2014-03-04 tue.> |\n" + (org-test-with-temp-text + "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n" + (org-table-sort-lines nil ?t) + (buffer-string)))) + (should + (equal + "| <2014-03-04 tue.> |\n| <2012-03-29 thu.> |\n| <2008-08-08 sat.> |\n" + (org-test-with-temp-text + "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n" + (org-table-sort-lines nil ?T) + (buffer-string)))) + ;; Sort by time (HH:MM values) + (should + (equal "| 1:00 |\n| 14:00 |\n| 17:00 |\n" + (org-test-with-temp-text "| 14:00 |\n| 17:00 |\n| 1:00 |\n" + (org-table-sort-lines nil ?t) + (buffer-string)))) + (should + (equal "| 17:00 |\n| 14:00 |\n| 1:00 |\n" + (org-test-with-temp-text "| 14:00 |\n| 17:00 |\n| 1:00 |\n" + (org-table-sort-lines nil ?T) + (buffer-string)))) + ;; Sort with custom functions. + (should + (equal "| 22 |\n| 15 |\n| 18 |\n" + (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n" + (org-table-sort-lines nil ?f + (lambda (s) (% (string-to-number s) 10)) + #'<) + (buffer-string)))) + (should + (equal "| 18 |\n| 15 |\n| 22 |\n" + (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n" + (org-table-sort-lines nil ?F + (lambda (s) (% (string-to-number s) 10)) + #'<) + (buffer-string)))) + ;; Sort according to current column. + (should + (equal "| 1 | 2 |\n| 7 | 3 |\n| 5 | 4 |\n" + (org-test-with-temp-text "| 1 | 2 |\n| 5 | 4 |\n| 7 | 3 |\n" + (org-table-sort-lines nil ?n) + (buffer-string)))) + ;; Sort between horizontal separators if possible. + (should + (equal + "| 9 | 8 |\n|---+---|\n| 5 | 3 |\n| 7 | 4 |\n|---+---|\n| 1 | 2 |\n" + (org-test-with-temp-text + "| 9 | 8 |\n|---+---|\n| 7 | 4 |\n| 5 | 3 |\n|---+---|\n| 1 | 2 |\n" + (org-table-sort-lines nil ?n) + (buffer-string))))) + + +;;; Field formulas + (ert-deftest test-org-table/field-formula-outside-table () "If `org-table-formula-create-columns' is nil, then a formula that references an out-of-bounds column should do nothing. If it -- 2.11.4.GIT