|
@@ -9057,21 +9057,27 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'."
|
|
|
(move-marker org-clock-marker (point))))
|
|
|
(message "Sorting entries...done")))
|
|
|
|
|
|
-(defun org-do-sort (table what &optional with-case sorting-type)
|
|
|
+(defun org-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."
|
|
|
+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. A/N/T means reversed:"
|
|
|
+ "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)
|
|
|
+ extractfun comparefun tempfun)
|
|
|
;; Define the appropriate functions
|
|
|
(cond
|
|
|
((= dcst ?n)
|
|
@@ -9095,13 +9101,26 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive."
|
|
|
(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)))
|
|
|
|
|
|
(sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x)))
|
|
|
table)
|
|
|
(lambda (a b) (funcall comparefun (car a) (car b))))))
|
|
|
|
|
|
-
|
|
|
;;; The orgstruct minor mode
|
|
|
|
|
|
;; Define a minor mode which can be used in other modes in order to
|