comparison lisp/sort.el @ 135:e1b5a59d0f91

*** empty log message ***
author Richard M. Stallman <rms@gnu.org>
date Mon, 10 Dec 1990 18:52:37 +0000
parents 278f3b6206cc
children 4d8caa5e2cba
comparison
equal deleted inserted replaced
134:93491679e7e9 135:e1b5a59d0f91
46 It should move point to the end of the record. 46 It should move point to the end of the record.
47 47
48 STARTKEYFUN may moves from the start of the record to the start of the key. 48 STARTKEYFUN may moves from the start of the record to the start of the key.
49 It may return either return a non-nil value to be used as the key, or 49 It may return either return a non-nil value to be used as the key, or
50 else the key will be the substring between the values of point after 50 else the key will be the substring between the values of point after
51 STARTKEYFUNC and ENDKEYFUN are called. 51 STARTKEYFUN and ENDKEYFUN are called. If STARTKEYFUN is nil, the key
52 starts at the beginning of the record.
52 53
53 ENDKEYFUN moves from the start of the sort key to the end of the sort key. 54 ENDKEYFUN moves from the start of the sort key to the end of the sort key.
54 ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the 55 ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the
55 same as ENDRECFUN." 56 same as ENDRECFUN."
56 (save-excursion 57 (save-excursion
63 (or reverse (setq sort-lists (nreverse sort-lists))) 64 (or reverse (setq sort-lists (nreverse sort-lists)))
64 (message "Sorting records...") 65 (message "Sorting records...")
65 (setq sort-lists 66 (setq sort-lists
66 (if (fboundp 'sortcar) 67 (if (fboundp 'sortcar)
67 (sortcar sort-lists 68 (sortcar sort-lists
68 (cond ((floatp (car (car sort-lists))) 69 (cond ((numberp (car (car sort-lists)))
69 'f<) 70 ;; This handles both ints and floats.
70 ((numberp (car (car sort-lists)))
71 '<) 71 '<)
72 ((consp (car (car sort-lists))) 72 ((consp (car (car sort-lists)))
73 'buffer-substring-lessp) 73 'buffer-substring-lessp)
74 (t 74 (t
75 'string<))) 75 'string<)))
76 (sort sort-lists 76 (sort sort-lists
77 (cond ((floatp (car (car sort-lists))) 77 (cond ((numberp (car (car sort-lists)))
78 (function
79 (lambda (a b)
80 (f< (car a) (car b)))))
81 ((numberp (car (car sort-lists)))
82 (function 78 (function
83 (lambda (a b) 79 (lambda (a b)
84 (< (car a) (car b))))) 80 (< (car a) (car b)))))
85 ((consp (car (car sort-lists))) 81 ((consp (car (car sort-lists)))
86 (function 82 (function
133 ;; is same as record. 129 ;; is same as record.
134 (if (and (consp key) 130 (if (and (consp key)
135 (equal (car key) start-rec) 131 (equal (car key) start-rec)
136 (equal (cdr key) (point))) 132 (equal (cdr key) (point)))
137 (cons key key) 133 (cons key key)
138 (list key start-rec (point))) 134 (cons key (cons start-rec (point))))
139 sort-lists))) 135 sort-lists)))
140 (and (not done) nextrecfun (funcall nextrecfun))) 136 (and (not done) nextrecfun (funcall nextrecfun)))
141 sort-lists)) 137 sort-lists))
142 138
143 (defun sort-reorder-buffer (sort-lists old) 139 (defun sort-reorder-buffer (sort-lists old)
144 (let ((inhibit-quit t) 140 (let ((inhibit-quit t)
156 last 152 last
157 (nth 1 (car old))) 153 (nth 1 (car old)))
158 (goto-char (point-max)) 154 (goto-char (point-max))
159 (insert-buffer-substring (current-buffer) 155 (insert-buffer-substring (current-buffer)
160 (nth 1 (car sort-lists)) 156 (nth 1 (car sort-lists))
161 (nth 2 (car sort-lists))) 157 (cdr (cdr (car sort-lists))))
162 (setq last (nth 2 (car old)) 158 (setq last (cdr (cdr (car old)))
163 sort-lists (cdr sort-lists) 159 sort-lists (cdr sort-lists)
164 old (cdr old))) 160 old (cdr old)))
165 (goto-char (point-max)) 161 (goto-char (point-max))
166 (insert-buffer-substring (current-buffer) 162 (insert-buffer-substring (current-buffer)
167 last 163 last