diff options
| author | root | 1990-08-28 11:59:54 +0000 |
|---|---|---|
| committer | root | 1990-08-28 11:59:54 +0000 |
| commit | 2af3a0e39b7c2adaadc1f565cb87a30af79e479a (patch) | |
| tree | 28879e7b942ffe69685caf4391170e702e1bacaa | |
| parent | 869bff3176d3d5389838d864e50479d99c0cefd7 (diff) | |
| download | emacs-2af3a0e39b7c2adaadc1f565cb87a30af79e479a.tar.gz emacs-2af3a0e39b7c2adaadc1f565cb87a30af79e479a.zip | |
*** empty log message ***
| -rw-r--r-- | lisp/sort.el | 92 |
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. |
| 222 | Fields are separated by whitespace and numbered from 1 up. | 228 | Fields are separated by whitespace and numbered from 1 up. |
| 223 | Specified field must contain a number in each line of the region. | 229 | Specified field must contain a number in each line of the region. |
| 224 | With a negative arg, sorts by the -ARG'th field, in decending order. | 230 | With a negative arg, sorts by the ARGth field counted from the right. |
| 225 | Called from a program, there are three arguments: | 231 | Called from a program, there are three arguments: |
| 226 | FIELD, BEG and END. BEG and END specify region to sort." | 232 | FIELD, 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. | ||
| 249 | Fields are separated by whitespace and numbered from 1 up. Specified field | ||
| 250 | must contain a floating point number in each line of the region. With a | ||
| 251 | negative arg, sorts by the ARGth field counted from the right. Called from a | ||
| 252 | program, there are three arguments: FIELD, BEG and END. BEG and END specify | ||
| 253 | region 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. |
| 243 | Fields are separated by whitespace and numbered from 1 up. | 269 | Fields are separated by whitespace and numbered from 1 up. |
| 244 | With a negative arg, sorts by the -ARG'th field, in decending order. | 270 | With a negative arg, sorts by the ARGth field counted from the right. |
| 245 | Called from a program, there are three arguments: | 271 | Called from a program, there are three arguments: |
| 246 | FIELD, BEG and END. BEG and END specify region to sort." | 272 | FIELD, 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. | |||
| 294 | For example: to sort lines in the region by the first word on each line | 324 | For 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: |
| 298 | sRegexp specifying key within record: \nr") | 331 | sRegexp 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. | ||
| 415 | From 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))))) | ||