-same as ENDRECFUN."
- (save-excursion
- (message "Finding sort keys...")
- (let* ((sort-lists (sort-build-lists nextrecfun endrecfun
- startkeyfun endkeyfun))
- (old (reverse sort-lists)))
- (if (null sort-lists)
- ()
- (or reverse (setq sort-lists (nreverse sort-lists)))
- (message "Sorting records...")
- (setq sort-lists
- (if (fboundp 'sortcar)
- (sortcar sort-lists
- (cond ((numberp (car (car sort-lists)))
- ;; This handles both ints and floats.
- '<)
- ((consp (car (car sort-lists)))
- 'buffer-substring-lessp)
- (t
- 'string<)))
- (sort sort-lists
- (cond ((numberp (car (car sort-lists)))
- (function
- (lambda (a b)
- (< (car a) (car b)))))
- ((consp (car (car sort-lists)))
- (function
- (lambda (a b)
- (buffer-substring-lessp (car a) (car b)))))
- (t
- (function
- (lambda (a b)
- (string< (car a) (car b)))))))))
- (if reverse (setq sort-lists (nreverse sort-lists)))
- (message "Reordering buffer...")
- (sort-reorder-buffer sort-lists old)))
- (message "Reordering buffer... Done"))
+same as ENDRECFUN.
+
+PREDICATE is the function to use to compare keys. If keys are numbers,
+it defaults to `<', otherwise it defaults to `string<'."
+ ;; Heuristically try to avoid messages if sorting a small amt of text.
+ (let ((messages (> (- (point-max) (point-min)) 50000)))
+ (save-excursion
+ (if messages (message "Finding sort keys..."))
+ (let* ((sort-lists (sort-build-lists nextrecfun endrecfun
+ startkeyfun endkeyfun))
+ (old (reverse sort-lists))
+ (case-fold-search sort-fold-case))
+ (if (null sort-lists)
+ ()
+ (or reverse (setq sort-lists (nreverse sort-lists)))
+ (if messages (message "Sorting records..."))
+ (setq sort-lists
+ (sort sort-lists
+ (cond (predicate
+ `(lambda (a b) (,predicate (car a) (car b))))
+ ((numberp (car (car sort-lists)))
+ 'car-less-than-car)
+ ((consp (car (car sort-lists)))
+ (lambda (a b)
+ (> 0 (compare-buffer-substrings
+ nil (car (car a)) (cdr (car a))
+ nil (car (car b)) (cdr (car b))))))
+ (t
+ (lambda (a b) (string< (car a) (car b)))))))
+ (if reverse (setq sort-lists (nreverse sort-lists)))
+ (if messages (message "Reordering buffer..."))
+ (sort-reorder-buffer sort-lists old)))
+ (if messages (message "Reordering buffer... Done"))))