|
@@ -1737,7 +1737,8 @@ numeric compare based on the type of the first key in the table."
|
|
|
(org-split-string x "[ \t]*|[ \t]*")))
|
|
|
x))
|
|
|
(org-split-string (buffer-substring beg end) "\n")))
|
|
|
- (setq lns (org-do-sort lns "Table" with-case sorting-type getkey-func compare-func))
|
|
|
+ (setq lns (org-table--do-sort
|
|
|
+ lns "Table" with-case sorting-type getkey-func compare-func))
|
|
|
(when org-table-overlay-coordinates
|
|
|
(org-table-toggle-coordinate-overlays))
|
|
|
(delete-region beg end)
|
|
@@ -1749,6 +1750,68 @@ numeric compare based on the type of the first key in the table."
|
|
|
(when otc (org-table-toggle-coordinate-overlays))
|
|
|
(message "%d lines sorted, based on column %d" (length lns) column)))
|
|
|
|
|
|
+(defun org-table--do-sort (table what &optional with-case sorting-type getkey-func compare-func)
|
|
|
+ "Sort TABLE of WHAT according to SORTING-TYPE.
|
|
|
+The user will be prompted for the SORTING-TYPE if the call to this
|
|
|
+function does not specify it.
|
|
|
+WHAT is only for the prompt, to indicate what is being sorted.
|
|
|
+The sorting key will be extracted from the car of the elements of
|
|
|
+the table. If WITH-CASE is non-nil, the sorting will be case-sensitive.
|
|
|
+
|
|
|
+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."
|
|
|
+ (unless sorting-type
|
|
|
+ (message
|
|
|
+ "Sort %s: [a]lphabetic, [n]umeric, [t]ime, [f]unc. A/N/T/F means reversed:"
|
|
|
+ what)
|
|
|
+ (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)
|
|
|
"Copy region in table to the clipboard and blank all relevant fields.
|