org.el: Implement user-defined table sorting

* lisp/org.el (org-do-sort): Implement the ?f and ?F sorting options
  to allow user-defined table sorting.  Update the DOC string.

* lisp/org-table (org-table-sort-lines): Add the GETKEY-FUNC and
  COMPARE-FUNC optional parameters and pass them to the call to
  `org-do-sort'.  Update the DOC string.

* doc/org.texi (org-table-sort-lines): Update documentation to reflect
  the addition of the ?f and ?F options.

This patch implements user-defined extraction and comparison functions
for table sorting.  Thanks to Nicolas Goaziou for helpful suggestions.

This patch was discussed on the Org Mode mailing list:
http://article.gmane.org/gmane.emacs.orgmode/93334
This commit is contained in:
Jon Snader 2014-12-20 13:13:17 -05:00 committed by Nicolas Goaziou
parent 54dfb86719
commit 71b098702c
3 changed files with 40 additions and 12 deletions

View File

@ -2205,8 +2205,10 @@ point is before the first column, you will be prompted for the sorting
column. If there is an active region, the mark specifies the first line
and the sorting column, while point should be in the last line to be
included into the sorting. The command prompts for the sorting type
(alphabetically, numerically, or by time). When called with a prefix
argument, alphabetic sorting will be case-sensitive.
(alphabetically, numerically, or by time). You can sort in normal or
reverse order. You can also supply your own key extraction and comparison
functions. When called with a prefix argument, alphabetic sorting will be
case-sensitive.
@tsubheading{Regions}
@orgcmd{C-c C-x M-w,org-table-copy-region}

View File

@ -1657,7 +1657,7 @@ In particular, this does handle wide and invisible characters."
dline -1 dline))))
;;;###autoload
(defun org-table-sort-lines (with-case &optional sorting-type)
(defun org-table-sort-lines (with-case &optional sorting-type getkey-func compare-func)
"Sort table lines according to the column at point.
The position of point indicates the column to be used for
@ -1677,8 +1677,15 @@ With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive.
If SORTING-TYPE is specified when this function is called from a Lisp
program, no prompting will take place. SORTING-TYPE must be a character,
any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting
should be done in reverse order."
any of (?a ?A ?n ?N ?t ?T ?f ?F) where the capital letters indicate that
sorting should be done in reverse order.
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."
(interactive "P")
(let* ((thisline (org-current-line))
(thiscol (org-table-current-column))
@ -1730,7 +1737,7 @@ should be done in reverse order."
(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))
(setq lns (org-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)

View File

@ -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