org-table: Simplify `org-table-sort-lines'

* lisp/org-table.el (org-table-sort-lines): Rely on `sort-subr'.
  Refactor code.
(org-table--do-sort): Remove function.

* testing/lisp/test-org-table.el (test-org-table/sort-lines): Fix test.

lisp/org-table.el

@@ -1658,125 +1658,90 @@ 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")
-  (let ((thiscol (org-table-current-column))
+  (when (org-region-active-p) (goto-char (region-beginning)))
-	(otc org-table-overlay-coordinates)
+  ;; Point must be either within a field or before a data line.
-	beg end column)
+  (save-excursion
-    (when (equal thiscol 0)
+    (skip-chars-backward " \t")
-      (if (org-called-interactively-p 'any)
+    (when (bolp) (search-forward "|" (line-end-position) t))
-	  (setq thiscol (read-number "Use column N for sorting: "))
+    (org-table-check-inside-data-field))
-	(setq thiscol 1))
+  ;; Set appropriate case sensitivity and column used for sorting.
-      (org-table-goto-column thiscol))
+  (let ((column (let ((c (org-table-current-column)))
-    (org-table-check-inside-data-field)
+		  (cond ((> c 0) c)
-    (save-excursion
+			((org-called-interactively-p 'any)
+			 (read-number "Use column N for sorting: "))
+			(t 1))))
+	(sorting-type
+	 (or sorting-type
+	     (read-char-exclusive "Sort Table: [a]lphabetic, [n]umeric, \
+\[t]ime, [f]unc.  A/N/T/F means reversed: "))))
+    (save-restriction
+      ;; Narrow buffer to appropriate sorting area.
       (if (org-region-active-p)
-	  (progn
+	  (progn (goto-char (region-beginning))
-	    (setq beg (region-beginning) end (region-end))
+		 (narrow-to-region
-	    (goto-char beg)
+		  (point)
-	    (setq column (org-table-current-column))
+		  (save-excursion (goto-char (region-end))
-	    (setq beg (line-beginning-position))
+				  (line-beginning-position 2))))
-	    (goto-char end)
+	(let ((start (org-table-begin))
-	    (setq end (copy-marker (line-beginning-position 2))))
+	      (end (org-table-end)))
-	(let ((tbeg (org-table-begin))
+	  (narrow-to-region
-	      (tend (org-table-end))
+	   (save-excursion
-	      (pos (point)))
+	     (if (re-search-backward org-table-hline-regexp start t)
-	  (setq column (org-table-current-column))
+		 (line-beginning-position 2)
-	  (setq beg
+	       start))
-		(if (re-search-backward org-table-hline-regexp tbeg t)
+	   (if (save-excursion (re-search-forward org-table-hline-regexp end t))
-		    (line-beginning-position 2)
+	       (match-beginning 0)
-		  tbeg))
+	     end))))
-	  (goto-char pos)
+      ;; Determine arguments for `sort-subr'.  Also record original
-	  (setq end
+      ;; position.  `org-table-save-field' cannot help here since
-		(copy-marker
+      ;; sorting is too much destructive.
-		 (if (re-search-forward org-table-hline-regexp tend t)
+      (let* ((sort-fold-case (not with-case))
-		     (match-beginning 0)
+	     (coordinates
-		   tend))))))
+	      (cons (count-lines (point-min) (line-beginning-position))
-    (let ((thisline (count-lines beg (line-beginning-position))))
+		    (current-column)))
-      (untabify beg end)
+	     (extract-key-from-field
-      (goto-char beg)
+	      ;; Function to be called on the contents of the field
-      (org-table-goto-column column)
+	      ;; used for sorting in the current row.
-      (let ((lines
+	      (case sorting-type
-	     (org-table--do-sort
+		((?n ?N) #'string-to-number)
-	      (mapcar (lambda (line)
+		((?a ?A) #'org-sort-remove-invisible)
-			(cons (org-sort-remove-invisible
+		((?t ?T)
-			       (nth (1- column)
+		 (lambda (f)
-				    (org-split-string line "[ \t]*|[ \t]*")))
+		   (cond ((string-match org-ts-regexp-both f)
-			      line))
+			  (org-float-time
-		      (org-split-string (buffer-substring beg end) "\n"))
+			   (org-time-string-to-time (match-string 0 f))))
-	      "Table" with-case sorting-type getkey-func compare-func)))
+			 ((string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" f)
-	(when org-table-overlay-coordinates
+			  (org-hh:mm-string-to-minutes f))
-	  (org-table-toggle-coordinate-overlays))
+			 (t 0))))
-	(delete-region beg end)
+		((?f ?F)
-	(move-marker end nil)
+		 (or getkey-func
-	(insert (mapconcat #'cdr lines "\n") "\n")
+		     (and (org-called-interactively-p 'any)
-	(goto-char beg)
+			  (intern
-	(forward-line thisline)
+			   (completing-read "Sort using function: "
-	(org-table-goto-column thiscol)
+					    obarray #'fboundp t)))
-	(when otc (org-table-toggle-coordinate-overlays))
+		     (error "Missing key extractor to sort rows")))
-	(message "%d lines sorted, based on column %d"
+		(t (user-error "Invalid sorting type `%c'" sorting-type))))
-		 (length lines)
+	     (predicate
-		 column)))))
+	      (case sorting-type
-
+		((?n ?N ?t ?T) #'<)
-(defun org-table--do-sort (table what &optional with-case sorting-type getkey-func compare-func)
+		((?a ?A) #'string<)
-  "Sort TABLE of WHAT according to SORTING-TYPE.
+		((?f ?F) compare-func))))
-The user will be prompted for the SORTING-TYPE if the call to this
+	(goto-char (point-min))
-function does not specify it.
+	(sort-subr (memq sorting-type '(?A ?N ?T ?F))
-WHAT is only for the prompt, to indicate what is being sorted.
+		   (lambda ()
-The sorting key will be extracted from the car of the elements of
+		     (forward-line)
-the table. If WITH-CASE is non-nil, the sorting will be case-sensitive.
+		     (while (and (not (eobp))
-
+				 (not (looking-at org-table-dataline-regexp)))
-If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
+		       (forward-line)))
-a function to be called to extract the key.  It must return either
+		   #'end-of-line
-a string or a number that should serve as the sorting key for that
+		   (lambda ()
-row.  It will then use COMPARE-FUNC to compare entries.  If GETKEY-FUNC
+		     (funcall extract-key-from-field
-is specified interactively, the comparison will be either a string or
+			      (org-trim (org-table-get-field column))))
-numeric compare based on the type of the first key in the table."
+		   nil
-  (unless sorting-type
+		   predicate)
-    (message
+	;; Move back to initial field.
-     "Sort %s: [a]lphabetic, [n]umeric, [t]ime, [f]unc.  A/N/T/F means reversed:"
+	(forward-line (car coordinates))
-     what)
+	(move-to-column (cdr coordinates))))))
-    (setq sorting-type (read-char-exclusive)))
-  (let (extractfun comparefun tempfun)
-    ;; Define the appropriate functions
-    (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)
-	  (lambda (a b) (funcall comparefun (car a) (car b))))))
 
 ;;;###autoload
 (defun org-table-cut-region (beg end)

testing/lisp/test-org-table.el

@@ -1604,7 +1604,7 @@ See also `test-org-table/copy-field'."
 	    (org-table-sort-lines t ?a)
 	    (buffer-string))))
   (should
-   (equal "| C |\n| b |\n| a |\n"
+   (equal "| b |\n| a |\n| C |\n"
 	  (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
 	    (org-table-sort-lines nil ?A)
 	    (buffer-string))))