diff options
| author | Richard M. Stallman | 1992-08-18 03:12:53 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1992-08-18 03:12:53 +0000 |
| commit | a08caf950dba6185770c229ca8af98a0f6b86722 (patch) | |
| tree | b8e0c08e15026daa0c45ed7bc027b11ae0514500 | |
| parent | f8db4c013a9a3fbedf42809c0dad3ace056f101e (diff) | |
| download | emacs-a08caf950dba6185770c229ca8af98a0f6b86722.tar.gz emacs-a08caf950dba6185770c229ca8af98a0f6b86722.zip | |
*** empty log message ***
| -rw-r--r-- | lisp/sort.el | 78 |
1 files changed, 40 insertions, 38 deletions
diff --git a/lisp/sort.el b/lisp/sort.el index b03e9947824..dd238d326e5 100644 --- a/lisp/sort.el +++ b/lisp/sort.el | |||
| @@ -28,7 +28,7 @@ | |||
| 28 | "General text sorting routine to divide buffer into records and sort them. | 28 | "General text sorting routine to divide buffer into records and sort them. |
| 29 | Arguments are REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN. | 29 | Arguments are REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN. |
| 30 | 30 | ||
| 31 | We consider this portion of the buffer to be divided into disjoint pieces | 31 | We divide the accessible portion of the buffer into disjoint pieces |
| 32 | called sort records. A portion of each sort record (perhaps all of it) | 32 | called sort records. A portion of each sort record (perhaps all of it) |
| 33 | is designated as the sort key. The records are rearranged in the buffer | 33 | is designated as the sort key. The records are rearranged in the buffer |
| 34 | in order by their sort keys. The records may or may not be contiguous. | 34 | in order by their sort keys. The records may or may not be contiguous. |
| @@ -50,49 +50,51 @@ It should move point to the end of the record. | |||
| 50 | 50 | ||
| 51 | STARTKEYFUN may moves from the start of the record to the start of the key. | 51 | STARTKEYFUN may moves from the start of the record to the start of the key. |
| 52 | It may return either return a non-nil value to be used as the key, or | 52 | It may return either return a non-nil value to be used as the key, or |
| 53 | else the key will be the substring between the values of point after | 53 | else the key is the substring between the values of point after |
| 54 | STARTKEYFUN and ENDKEYFUN are called. If STARTKEYFUN is nil, the key | 54 | STARTKEYFUN and ENDKEYFUN are called. If STARTKEYFUN is nil, the key |
| 55 | starts at the beginning of the record. | 55 | starts at the beginning of the record. |
| 56 | 56 | ||
| 57 | ENDKEYFUN moves from the start of the sort key to the end of the sort key. | 57 | ENDKEYFUN moves from the start of the sort key to the end of the sort key. |
| 58 | ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the | 58 | ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the |
| 59 | same as ENDRECFUN." | 59 | same as ENDRECFUN." |
| 60 | (save-excursion | 60 | ;; Heuristically try to avoid messages if sorting a small amt of text. |
| 61 | (message "Finding sort keys...") | 61 | (let ((messages (> (- (point-max) (point-min)) 50000))) |
| 62 | (let* ((sort-lists (sort-build-lists nextrecfun endrecfun | 62 | (save-excursion |
| 63 | startkeyfun endkeyfun)) | 63 | (if messages (message "Finding sort keys...")) |
| 64 | (old (reverse sort-lists))) | 64 | (let* ((sort-lists (sort-build-lists nextrecfun endrecfun |
| 65 | (if (null sort-lists) | 65 | startkeyfun endkeyfun)) |
| 66 | () | 66 | (old (reverse sort-lists))) |
| 67 | (or reverse (setq sort-lists (nreverse sort-lists))) | 67 | (if (null sort-lists) |
| 68 | (message "Sorting records...") | 68 | () |
| 69 | (setq sort-lists | 69 | (or reverse (setq sort-lists (nreverse sort-lists))) |
| 70 | (if (fboundp 'sortcar) | 70 | (if messages (message "Sorting records...")) |
| 71 | (sortcar sort-lists | 71 | (setq sort-lists |
| 72 | (cond ((numberp (car (car sort-lists))) | 72 | (if (fboundp 'sortcar) |
| 73 | ;; This handles both ints and floats. | 73 | (sortcar sort-lists |
| 74 | '<) | 74 | (cond ((numberp (car (car sort-lists))) |
| 75 | ((consp (car (car sort-lists))) | 75 | ;; This handles both ints and floats. |
| 76 | 'buffer-substring-lessp) | 76 | '<) |
| 77 | (t | 77 | ((consp (car (car sort-lists))) |
| 78 | 'string<))) | 78 | 'buffer-substring-lessp) |
| 79 | (sort sort-lists | 79 | (t |
| 80 | (cond ((numberp (car (car sort-lists))) | 80 | 'string<))) |
| 81 | (function | 81 | (sort sort-lists |
| 82 | (lambda (a b) | 82 | (cond ((numberp (car (car sort-lists))) |
| 83 | (< (car a) (car b))))) | 83 | (function |
| 84 | ((consp (car (car sort-lists))) | 84 | (lambda (a b) |
| 85 | (function | 85 | (< (car a) (car b))))) |
| 86 | (lambda (a b) | 86 | ((consp (car (car sort-lists))) |
| 87 | (buffer-substring-lessp (car a) (car b))))) | 87 | (function |
| 88 | (t | 88 | (lambda (a b) |
| 89 | (function | 89 | (buffer-substring-lessp (car a) (car b))))) |
| 90 | (lambda (a b) | 90 | (t |
| 91 | (string< (car a) (car b))))))))) | 91 | (function |
| 92 | (if reverse (setq sort-lists (nreverse sort-lists))) | 92 | (lambda (a b) |
| 93 | (message "Reordering buffer...") | 93 | (string< (car a) (car b))))))))) |
| 94 | (sort-reorder-buffer sort-lists old))) | 94 | (if reverse (setq sort-lists (nreverse sort-lists))) |
| 95 | (message "Reordering buffer... Done")) | 95 | (if messages (message "Reordering buffer...")) |
| 96 | (sort-reorder-buffer sort-lists old))) | ||
| 97 | (if messages (message "Reordering buffer... Done")))) | ||
| 96 | nil) | 98 | nil) |
| 97 | 99 | ||
| 98 | ;; Parse buffer into records using the arguments as Lisp expressions; | 100 | ;; Parse buffer into records using the arguments as Lisp expressions; |