aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorroot1990-08-28 11:59:54 +0000
committerroot1990-08-28 11:59:54 +0000
commit2af3a0e39b7c2adaadc1f565cb87a30af79e479a (patch)
tree28879e7b942ffe69685caf4391170e702e1bacaa
parent869bff3176d3d5389838d864e50479d99c0cefd7 (diff)
downloademacs-2af3a0e39b7c2adaadc1f565cb87a30af79e479a.tar.gz
emacs-2af3a0e39b7c2adaadc1f565cb87a30af79e479a.zip
*** empty log message ***
-rw-r--r--lisp/sort.el92
1 files changed, 78 insertions, 14 deletions
diff --git a/lisp/sort.el b/lisp/sort.el
index 30dd6916ba9..235f53e57ba 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -65,14 +65,20 @@ same as ENDRECFUN."
65 (setq sort-lists 65 (setq sort-lists
66 (if (fboundp 'sortcar) 66 (if (fboundp 'sortcar)
67 (sortcar sort-lists 67 (sortcar sort-lists
68 (cond ((numberp (car (car sort-lists))) 68 (cond ((floatp (car (car sort-lists)))
69 'f<)
70 ((numberp (car (car sort-lists)))
69 '<) 71 '<)
70 ((consp (car (car sort-lists))) 72 ((consp (car (car sort-lists)))
71 'buffer-substring-lessp) 73 'buffer-substring-lessp)
72 (t 74 (t
73 'string<))) 75 'string<)))
74 (sort sort-lists 76 (sort sort-lists
75 (cond ((numberp (car (car sort-lists))) 77 (cond ((floatp (car (car sort-lists)))
78 (function
79 (lambda (a b)
80 (f< (car a) (car b)))))
81 ((numberp (car (car sort-lists)))
76 (function 82 (function
77 (lambda (a b) 83 (lambda (a b)
78 (< (car a) (car b))))) 84 (< (car a) (car b)))))
@@ -221,7 +227,7 @@ REVERSE (non-nil means reverse order), BEG and END (region to sort)."
221 "Sort lines in region numerically by the ARGth field of each line. 227 "Sort lines in region numerically by the ARGth field of each line.
222Fields are separated by whitespace and numbered from 1 up. 228Fields are separated by whitespace and numbered from 1 up.
223Specified field must contain a number in each line of the region. 229Specified field must contain a number in each line of the region.
224With a negative arg, sorts by the -ARG'th field, in decending order. 230With a negative arg, sorts by the ARGth field counted from the right.
225Called from a program, there are three arguments: 231Called from a program, there are three arguments:
226FIELD, BEG and END. BEG and END specify region to sort." 232FIELD, BEG and END. BEG and END specify region to sort."
227 (interactive "p\nr") 233 (interactive "p\nr")
@@ -238,10 +244,30 @@ FIELD, BEG and END. BEG and END specify region to sort."
238 (point)))))) 244 (point))))))
239 nil)) 245 nil))
240 246
247(defun sort-float-fields (field beg end)
248 "Sort lines in region numerically by the ARGth field of each line.
249Fields are separated by whitespace and numbered from 1 up. Specified field
250must contain a floating point number in each line of the region. With a
251negative arg, sorts by the ARGth field counted from the right. Called from a
252program, there are three arguments: FIELD, BEG and END. BEG and END specify
253region to sort."
254 (interactive "p\nr")
255 (sort-fields-1 field beg end
256 (function (lambda ()
257 (sort-skip-fields (1- field))
258 (string-to-float
259 (buffer-substring
260 (point)
261 (save-excursion
262 (re-search-forward
263 "[+-]?[0-9]*\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
264 (point))))))
265 nil))
266
241(defun sort-fields (field beg end) 267(defun sort-fields (field beg end)
242 "Sort lines in region lexicographically by the ARGth field of each line. 268 "Sort lines in region lexicographically by the ARGth field of each line.
243Fields are separated by whitespace and numbered from 1 up. 269Fields are separated by whitespace and numbered from 1 up.
244With a negative arg, sorts by the -ARG'th field, in decending order. 270With a negative arg, sorts by the ARGth field counted from the right.
245Called from a program, there are three arguments: 271Called from a program, there are three arguments:
246FIELD, BEG and END. BEG and END specify region to sort." 272FIELD, BEG and END. BEG and END specify region to sort."
247 (interactive "p\nr") 273 (interactive "p\nr")
@@ -252,28 +278,32 @@ FIELD, BEG and END. BEG and END specify region to sort."
252 (function (lambda () (skip-chars-forward "^ \t\n"))))) 278 (function (lambda () (skip-chars-forward "^ \t\n")))))
253 279
254(defun sort-fields-1 (field beg end startkeyfun endkeyfun) 280(defun sort-fields-1 (field beg end startkeyfun endkeyfun)
255 (let ((reverse (< field 0)) 281 (let ((tbl (syntax-table)))
256 (tbl (syntax-table))) 282 (if (zerop field) (setq field 1))
257 (setq field (max 1 field (- field)))
258 (unwind-protect 283 (unwind-protect
259 (save-excursion 284 (save-excursion
260 (save-restriction 285 (save-restriction
261 (narrow-to-region beg end) 286 (narrow-to-region beg end)
262 (goto-char (point-min)) 287 (goto-char (point-min))
263 (set-syntax-table sort-fields-syntax-table) 288 (set-syntax-table sort-fields-syntax-table)
264 (sort-subr reverse 289 (sort-subr nil
265 'forward-line 'end-of-line 290 'forward-line 'end-of-line
266 startkeyfun endkeyfun))) 291 startkeyfun endkeyfun)))
267 (set-syntax-table tbl)))) 292 (set-syntax-table tbl))))
268 293
269(defun sort-skip-fields (n) 294(defun sort-skip-fields (n)
270 (let ((eol (save-excursion (end-of-line 1) (point)))) 295 (let ((bol (point))
271 (forward-word n) 296 (eol (save-excursion (end-of-line 1) (point))))
272 (if (> (point) eol) 297 (if (> n 0) (forward-word n)
298 (end-of-line)
299 (forward-word (1+ n)))
300 (if (or (and (>= (point) eol) (> n 0))
301 ;; this is marginally wrong; if the first line of the sort
302 ;; at bob has the wrong number of fields the error won't be
303 ;; reported until the next short line.
304 (and (< (point) bol) (< n 0)))
273 (error "Line has too few fields: %s" 305 (error "Line has too few fields: %s"
274 (buffer-substring (save-excursion 306 (buffer-substring bol eol)))
275 (beginning-of-line) (point))
276 eol)))
277 (skip-chars-forward " \t"))) 307 (skip-chars-forward " \t")))
278 308
279 309
@@ -294,6 +324,9 @@ With a negative prefix arg sorts in reverse order.
294For example: to sort lines in the region by the first word on each line 324For example: to sort lines in the region by the first word on each line
295 starting with the letter \"f\", 325 starting with the letter \"f\",
296 RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\=\\<f\\w*\\>\"" 326 RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\=\\<f\\w*\\>\""
327 ;; using negative prefix arg to mean "reverse" is now inconsistent with
328 ;; other sort-.*fields functions but then again this was before, since it
329 ;; didn't use the magnitude of the arg to specify anything.
297 (interactive "P\nsRegexp specifying records to sort: 330 (interactive "P\nsRegexp specifying records to sort:
298sRegexp specifying key within record: \nr") 331sRegexp specifying key within record: \nr")
299 (cond ((or (equal key-regexp "") (equal key-regexp "\\&")) 332 (cond ((or (equal key-regexp "") (equal key-regexp "\\&"))
@@ -376,3 +409,34 @@ Use \\[untabify] to convert tabs to spaces before sorting."
376 (sort-subr reverse 'forward-line 'end-of-line 409 (sort-subr reverse 'forward-line 'end-of-line
377 (function (lambda () (move-to-column col-start) nil)) 410 (function (lambda () (move-to-column col-start) nil))
378 (function (lambda () (move-to-column col-end) nil))))))))) 411 (function (lambda () (move-to-column col-end) nil)))))))))
412
413(defun reverse-region (beg end)
414 "Reverse the order of lines in a region.
415From a program takes two point or marker arguments, BEG and END."
416 (interactive "r")
417 (if (> beg end)
418 (let (mid) (setq mid end end beg beg mid)))
419 (save-excursion
420 ;; put beg at the start of a line and end and the end of one --
421 ;; the largest possible region which fits this criteria
422 (goto-char beg)
423 (or (bolp) (forward-line 1))
424 (setq beg (point))
425 (goto-char end)
426 ;; the test for bolp is for those times when end is on an empty line;
427 ;; it is probably not the case that the line should be included in the
428 ;; reversal; it isn't difficult to add it afterward.
429 (or (and (eolp) (not (bolp))) (progn (forward-line -1) (end-of-line)))
430 (setq end (point-marker))
431 ;; the real work. this thing cranks through memory on large regions.
432 (let (ll (do t))
433 (while do
434 (goto-char beg)
435 (setq ll (cons (buffer-substring (point) (progn (end-of-line) (point)))
436 ll))
437 (setq do (/= (point) end))
438 (delete-region beg (if do (1+ (point)) (point))))
439 (while (cdr ll)
440 (insert (car ll) "\n")
441 (setq ll (cdr ll)))
442 (insert (car ll)))))