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

3 files changed, 40 insertions, 12 deletions

diff --git a/doc/org.texi b/doc/org.texi
index 7c464ca..33a6a0d 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 fa59113..9941160 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 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)
diff --git a/lisp/org.el b/lisp/org.el
index 1383d76..03c2789 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -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