Browse Source

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.
Nicolas Goaziou 10 năm trước cách đây
mục cha
commit
13711d4583
2 tập tin đã thay đổi với 134 bổ sung39 xóa
  1. 37 39
      lisp/org.el
  2. 97 0
      testing/lisp/test-org-table.el

+ 37 - 39
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)

+ 97 - 0
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 "| <point>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 "| <point>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 "| <point>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 "| <point>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 "| <point>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 "| <point>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 | <point>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| <point>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