40 |
:type 'boolean) |
:type 'boolean) |
41 |
|
|
42 |
;;;###autoload |
;;;###autoload |
43 |
(defun sort-subr (reverse nextrecfun endrecfun &optional startkeyfun endkeyfun) |
(defun sort-subr (reverse nextrecfun endrecfun |
44 |
|
&optional startkeyfun endkeyfun predicate) |
45 |
"General text sorting routine to divide buffer into records and sort them. |
"General text sorting routine to divide buffer into records and sort them. |
46 |
|
|
47 |
We divide the accessible portion of the buffer into disjoint pieces |
We divide the accessible portion of the buffer into disjoint pieces |
75 |
|
|
76 |
ENDKEYFUN moves from the start of the sort key to the end of the sort key. |
ENDKEYFUN moves from the start of the sort key to the end of the sort key. |
77 |
ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the |
ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the |
78 |
same as ENDRECFUN." |
same as ENDRECFUN. |
79 |
|
|
80 |
|
PREDICATE is the function to use to compare keys. If keys are numbers, |
81 |
|
it defaults to `<', otherwise it defaults to `string<'." |
82 |
;; Heuristically try to avoid messages if sorting a small amt of text. |
;; Heuristically try to avoid messages if sorting a small amt of text. |
83 |
(let ((messages (> (- (point-max) (point-min)) 50000))) |
(let ((messages (> (- (point-max) (point-min)) 50000))) |
84 |
(save-excursion |
(save-excursion |
92 |
(or reverse (setq sort-lists (nreverse sort-lists))) |
(or reverse (setq sort-lists (nreverse sort-lists))) |
93 |
(if messages (message "Sorting records...")) |
(if messages (message "Sorting records...")) |
94 |
(setq sort-lists |
(setq sort-lists |
95 |
(if (fboundp 'sortcar) |
(sort sort-lists |
96 |
(sortcar sort-lists |
(cond (predicate |
97 |
(cond ((numberp (car (car sort-lists))) |
`(lambda (a b) (,predicate (car a) (car b)))) |
98 |
;; This handles both ints and floats. |
((numberp (car (car sort-lists))) |
99 |
'<) |
'car-less-than-car) |
100 |
((consp (car (car sort-lists))) |
((consp (car (car sort-lists))) |
101 |
(function |
(lambda (a b) |
102 |
(lambda (a b) |
(> 0 (compare-buffer-substrings |
103 |
(> 0 (compare-buffer-substrings |
nil (car (car a)) (cdr (car a)) |
104 |
nil (car a) (cdr a) |
nil (car (car b)) (cdr (car b)))))) |
105 |
nil (car b) (cdr b)))))) |
(t |
106 |
(t |
(lambda (a b) (string< (car a) (car b))))))) |
|
'string<))) |
|
|
(sort sort-lists |
|
|
(cond ((numberp (car (car sort-lists))) |
|
|
'car-less-than-car) |
|
|
((consp (car (car sort-lists))) |
|
|
(function |
|
|
(lambda (a b) |
|
|
(> 0 (compare-buffer-substrings |
|
|
nil (car (car a)) (cdr (car a)) |
|
|
nil (car (car b)) (cdr (car b))))))) |
|
|
(t |
|
|
(function |
|
|
(lambda (a b) |
|
|
(string< (car a) (car b))))))))) |
|
107 |
(if reverse (setq sort-lists (nreverse sort-lists))) |
(if reverse (setq sort-lists (nreverse sort-lists))) |
108 |
(if messages (message "Reordering buffer...")) |
(if messages (message "Reordering buffer...")) |
109 |
(sort-reorder-buffer sort-lists old))) |
(sort-reorder-buffer sort-lists old))) |
140 |
(cond ((prog1 done (setq done nil))) |
(cond ((prog1 done (setq done nil))) |
141 |
(endrecfun (funcall endrecfun)) |
(endrecfun (funcall endrecfun)) |
142 |
(nextrecfun (funcall nextrecfun) (setq done t))) |
(nextrecfun (funcall nextrecfun) (setq done t))) |
143 |
(if key (setq sort-lists (cons |
(if key (push |
144 |
;; consing optimization in case in which key |
;; consing optimization in case in which key is same as record. |
145 |
;; is same as record. |
(if (and (consp key) |
146 |
(if (and (consp key) |
(equal (car key) start-rec) |
147 |
(equal (car key) start-rec) |
(equal (cdr key) (point))) |
148 |
(equal (cdr key) (point))) |
(cons key key) |
149 |
(cons key key) |
(cons key (cons start-rec (point)))) |
150 |
(cons key (cons start-rec (point)))) |
sort-lists)) |
|
sort-lists))) |
|
151 |
(and (not done) nextrecfun (funcall nextrecfun))) |
(and (not done) nextrecfun (funcall nextrecfun))) |
152 |
sort-lists)) |
sort-lists)) |
153 |
|
|
535 |
|
|
536 |
(provide 'sort) |
(provide 'sort) |
537 |
|
|
538 |
|
;;; arch-tag: fbac12be-2a7b-4c8a-9665-264d61f70bd9 |
539 |
;;; sort.el ends here |
;;; sort.el ends here |