aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1992-08-18 03:12:53 +0000
committerRichard M. Stallman1992-08-18 03:12:53 +0000
commita08caf950dba6185770c229ca8af98a0f6b86722 (patch)
treeb8e0c08e15026daa0c45ed7bc027b11ae0514500
parentf8db4c013a9a3fbedf42809c0dad3ace056f101e (diff)
downloademacs-a08caf950dba6185770c229ca8af98a0f6b86722.tar.gz
emacs-a08caf950dba6185770c229ca8af98a0f6b86722.zip
*** empty log message ***
-rw-r--r--lisp/sort.el78
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.
29Arguments are REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN. 29Arguments are REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN.
30 30
31We consider this portion of the buffer to be divided into disjoint pieces 31We divide the accessible portion of the buffer into disjoint pieces
32called sort records. A portion of each sort record (perhaps all of it) 32called sort records. A portion of each sort record (perhaps all of it)
33is designated as the sort key. The records are rearranged in the buffer 33is designated as the sort key. The records are rearranged in the buffer
34in order by their sort keys. The records may or may not be contiguous. 34in 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
51STARTKEYFUN may moves from the start of the record to the start of the key. 51STARTKEYFUN may moves from the start of the record to the start of the key.
52It may return either return a non-nil value to be used as the key, or 52It may return either return a non-nil value to be used as the key, or
53else the key will be the substring between the values of point after 53else the key is the substring between the values of point after
54STARTKEYFUN and ENDKEYFUN are called. If STARTKEYFUN is nil, the key 54STARTKEYFUN and ENDKEYFUN are called. If STARTKEYFUN is nil, the key
55starts at the beginning of the record. 55starts at the beginning of the record.
56 56
57ENDKEYFUN moves from the start of the sort key to the end of the sort key. 57ENDKEYFUN moves from the start of the sort key to the end of the sort key.
58ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the 58ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the
59same as ENDRECFUN." 59same 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;