Mercurial > emacs
changeset 86:278f3b6206cc
*** empty log message ***
author | root <root> |
---|---|
date | Tue, 28 Aug 1990 11:59:54 +0000 |
parents | 253ec6b277ee |
children | d39407c00c09 |
files | lisp/sort.el |
diffstat | 1 files changed, 78 insertions(+), 14 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/sort.el Tue Aug 28 08:01:56 1990 +0000 +++ b/lisp/sort.el Tue Aug 28 11:59:54 1990 +0000 @@ -65,14 +65,20 @@ (setq sort-lists (if (fboundp 'sortcar) (sortcar sort-lists - (cond ((numberp (car (car sort-lists))) + (cond ((floatp (car (car sort-lists))) + 'f<) + ((numberp (car (car sort-lists))) '<) ((consp (car (car sort-lists))) 'buffer-substring-lessp) (t 'string<))) (sort sort-lists - (cond ((numberp (car (car sort-lists))) + (cond ((floatp (car (car sort-lists))) + (function + (lambda (a b) + (f< (car a) (car b))))) + ((numberp (car (car sort-lists))) (function (lambda (a b) (< (car a) (car b))))) @@ -221,7 +227,7 @@ "Sort lines in region numerically by the ARGth field of each line. Fields are separated by whitespace and numbered from 1 up. Specified field must contain a number in each line of the region. -With a negative arg, sorts by the -ARG'th field, in decending order. +With a negative arg, sorts by the ARGth field counted from the right. Called from a program, there are three arguments: FIELD, BEG and END. BEG and END specify region to sort." (interactive "p\nr") @@ -238,10 +244,30 @@ (point)))))) nil)) +(defun sort-float-fields (field beg end) + "Sort lines in region numerically by the ARGth field of each line. +Fields are separated by whitespace and numbered from 1 up. Specified field +must contain a floating point number in each line of the region. With a +negative arg, sorts by the ARGth field counted from the right. Called from a +program, there are three arguments: FIELD, BEG and END. BEG and END specify +region to sort." + (interactive "p\nr") + (sort-fields-1 field beg end + (function (lambda () + (sort-skip-fields (1- field)) + (string-to-float + (buffer-substring + (point) + (save-excursion + (re-search-forward + "[+-]?[0-9]*\.?[0-9]*\\([eE][+-]?[0-9]+\\)?") + (point)))))) + nil)) + (defun sort-fields (field beg end) "Sort lines in region lexicographically by the ARGth field of each line. Fields are separated by whitespace and numbered from 1 up. -With a negative arg, sorts by the -ARG'th field, in decending order. +With a negative arg, sorts by the ARGth field counted from the right. Called from a program, there are three arguments: FIELD, BEG and END. BEG and END specify region to sort." (interactive "p\nr") @@ -252,28 +278,32 @@ (function (lambda () (skip-chars-forward "^ \t\n"))))) (defun sort-fields-1 (field beg end startkeyfun endkeyfun) - (let ((reverse (< field 0)) - (tbl (syntax-table))) - (setq field (max 1 field (- field))) + (let ((tbl (syntax-table))) + (if (zerop field) (setq field 1)) (unwind-protect (save-excursion (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (set-syntax-table sort-fields-syntax-table) - (sort-subr reverse + (sort-subr nil 'forward-line 'end-of-line startkeyfun endkeyfun))) (set-syntax-table tbl)))) (defun sort-skip-fields (n) - (let ((eol (save-excursion (end-of-line 1) (point)))) - (forward-word n) - (if (> (point) eol) + (let ((bol (point)) + (eol (save-excursion (end-of-line 1) (point)))) + (if (> n 0) (forward-word n) + (end-of-line) + (forward-word (1+ n))) + (if (or (and (>= (point) eol) (> n 0)) + ;; this is marginally wrong; if the first line of the sort + ;; at bob has the wrong number of fields the error won't be + ;; reported until the next short line. + (and (< (point) bol) (< n 0))) (error "Line has too few fields: %s" - (buffer-substring (save-excursion - (beginning-of-line) (point)) - eol))) + (buffer-substring bol eol))) (skip-chars-forward " \t"))) @@ -294,6 +324,9 @@ For example: to sort lines in the region by the first word on each line starting with the letter \"f\", RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\=\\<f\\w*\\>\"" + ;; using negative prefix arg to mean "reverse" is now inconsistent with + ;; other sort-.*fields functions but then again this was before, since it + ;; didn't use the magnitude of the arg to specify anything. (interactive "P\nsRegexp specifying records to sort: sRegexp specifying key within record: \nr") (cond ((or (equal key-regexp "") (equal key-regexp "\\&")) @@ -376,3 +409,34 @@ (sort-subr reverse 'forward-line 'end-of-line (function (lambda () (move-to-column col-start) nil)) (function (lambda () (move-to-column col-end) nil))))))))) + +(defun reverse-region (beg end) + "Reverse the order of lines in a region. +From a program takes two point or marker arguments, BEG and END." + (interactive "r") + (if (> beg end) + (let (mid) (setq mid end end beg beg mid))) + (save-excursion + ;; put beg at the start of a line and end and the end of one -- + ;; the largest possible region which fits this criteria + (goto-char beg) + (or (bolp) (forward-line 1)) + (setq beg (point)) + (goto-char end) + ;; the test for bolp is for those times when end is on an empty line; + ;; it is probably not the case that the line should be included in the + ;; reversal; it isn't difficult to add it afterward. + (or (and (eolp) (not (bolp))) (progn (forward-line -1) (end-of-line))) + (setq end (point-marker)) + ;; the real work. this thing cranks through memory on large regions. + (let (ll (do t)) + (while do + (goto-char beg) + (setq ll (cons (buffer-substring (point) (progn (end-of-line) (point))) + ll)) + (setq do (/= (point) end)) + (delete-region beg (if do (1+ (point)) (point)))) + (while (cdr ll) + (insert (car ll) "\n") + (setq ll (cdr ll))) + (insert (car ll)))))