From 53f1929b7a8c1b98230d60e5313e7550ab3d1b13 Mon Sep 17 00:00:00 2001 From: Jon Snader Date: Wed, 17 Dec 2014 11:52:23 -0500 Subject: [PATCH] org.el: Implement user specified sorting functions * lisp/org.el (org-do-sort): Implemented the ability for the user to specify custom extraction and comparison functions. Updated the DOC string. * lisp/org-table.el (org-table-sort-lines): Added GETKEY-FUNC and COMPARE-FUNC as optional arguments and passed them to `org-do-sort'. Updated DOC string to reflect the new functionality. * doc/org.texi (Structure editing): Document the ability for users to specify their own extraction and comparison functions. --- doc/org.texi | 6 ++++-- lisp/org-table.el | 15 +++++++++++---- lisp/org.el | 36 ++++++++++++++++++++++++++++++------ 3 files changed, 45 insertions(+), 12 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index d617259..f56e824 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -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} diff --git a/lisp/org-table.el b/lisp/org-table.el index 06a8ab7..9048ac9 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -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 letter 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) diff --git a/lisp/org.el b/lisp/org.el index bed5cb9..23f5b07 100755 --- a/lisp/org.el +++ b/lisp/org.el @@ -9051,21 +9051,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 extract-string-p) ;; Define the appropriate functions (cond ((= dcst ?n) @@ -9075,7 +9081,7 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." (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< + #'string< (lambda (a b) (and (not (string< a b)) (not (string= a b))))))) ((= dcst ?t) @@ -9089,6 +9095,24 @@ 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)))) + (setq 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 (or compare-func + (if extract-string-p + (if (= sorting-type ?f) + #'string< + (lambda (a b) (and (not (string< a b)) + (not (string= a b))))) + (if (= sorting-type ?f) + #'< + #'>))))) (t (error "Invalid sorting type `%c'" sorting-type))) (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x))) -- 1.9.3 (Apple Git-50)