sort.el 16.7 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1 2
;;; sort.el --- commands to sort text in an Emacs buffer.

Eric S. Raymond's avatar
Eric S. Raymond committed
3 4
;; Copyright (C) 1986, 1987 Free Software Foundation, Inc.

Eric S. Raymond's avatar
Eric S. Raymond committed
5 6
;; Author: Howie Kaye
;; Maintainer: FSF
Eric S. Raymond's avatar
Eric S. Raymond committed
7
;; Keywords: unix
Eric S. Raymond's avatar
Eric S. Raymond committed
8

Richard M. Stallman's avatar
Richard M. Stallman committed
9 10 11 12
;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
Eric S. Raymond's avatar
Eric S. Raymond committed
13
;; the Free Software Foundation; either version 2, or (at your option)
Richard M. Stallman's avatar
Richard M. Stallman committed
14 15 16 17 18 19 20 21 22 23 24
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

Eric S. Raymond's avatar
Eric S. Raymond committed
25
;;; Code:
Richard M. Stallman's avatar
Richard M. Stallman committed
26 27 28 29 30

(defun sort-subr (reverse nextrecfun endrecfun &optional startkeyfun endkeyfun)
  "General text sorting routine to divide buffer into records and sort them.
Arguments are REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN.

31
We divide the accessible portion of the buffer into disjoint pieces
Richard M. Stallman's avatar
Richard M. Stallman committed
32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
called sort records.  A portion of each sort record (perhaps all of it)
is designated as the sort key.  The records are rearranged in the buffer
in order by their sort keys.  The records may or may not be contiguous.

Usually the records are rearranged in order of ascending sort key.
If REVERSE is non-nil, they are rearranged in order of descending sort key.

The next four arguments are functions to be called to move point
across a sort record.  They will be called many times from within sort-subr.

NEXTRECFUN is called with point at the end of the previous record.
It moves point to the start of the next record.
It should move point to the end of the buffer if there are no more records.
The first record is assumed to start at the position of point when sort-subr
is called.

ENDRECFUN is is called with point within the record.
It should move point to the end of the record.

STARTKEYFUN may moves from the start of the record to the start of the key.
It may return either return a non-nil value to be used as the key, or
53
else the key is the substring between the values of point after
54 55
STARTKEYFUN and ENDKEYFUN are called.  If STARTKEYFUN is nil, the key
starts at the beginning of the record.
Richard M. Stallman's avatar
Richard M. Stallman committed
56 57 58 59

ENDKEYFUN moves from the start of the sort key to the end of the sort key.
ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the
same as ENDRECFUN."
60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
  ;; Heuristically try to avoid messages if sorting a small amt of text.
  (let ((messages (> (- (point-max) (point-min)) 50000)))
    (save-excursion
      (if messages (message "Finding sort keys..."))
      (let* ((sort-lists (sort-build-lists nextrecfun endrecfun
					   startkeyfun endkeyfun))
	     (old (reverse sort-lists)))
	(if (null sort-lists)
	    ()
	  (or reverse (setq sort-lists (nreverse sort-lists)))
	  (if messages (message "Sorting records..."))
	  (setq sort-lists
		(if (fboundp 'sortcar)
		    (sortcar sort-lists
			     (cond ((numberp (car (car sort-lists)))
				    ;; This handles both ints and floats.
				    '<)
				   ((consp (car (car sort-lists)))
				    'buffer-substring-lessp)
				   (t
				    'string<)))
		    (sort sort-lists
			  (cond ((numberp (car (car sort-lists)))
				 (function
				  (lambda (a b)
				    (< (car a) (car b)))))
				((consp (car (car sort-lists)))
				 (function
				  (lambda (a b)
				    (buffer-substring-lessp (car a) (car b)))))
				(t
				 (function
				  (lambda (a b)
				    (string< (car a) (car b)))))))))
	  (if reverse (setq sort-lists (nreverse sort-lists)))
	  (if messages (message "Reordering buffer..."))
	  (sort-reorder-buffer sort-lists old)))
      (if messages (message "Reordering buffer... Done"))))
Richard M. Stallman's avatar
Richard M. Stallman committed
98 99 100
  nil)

;; Parse buffer into records using the arguments as Lisp expressions;
root's avatar
root committed
101
;; return a list of records.  Each record looks like (KEY STARTPOS . ENDPOS)
Richard M. Stallman's avatar
Richard M. Stallman committed
102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
;; where KEY is the sort key (a number or string),
;; and STARTPOS and ENDPOS are the bounds of this record in the buffer.

;; The records appear in the list lastmost first!

(defun sort-build-lists (nextrecfun endrecfun startkeyfun endkeyfun)
  (let ((sort-lists ())
	(start-rec nil)
	done key)
    ;; Loop over sort records.
    ;(goto-char (point-min)) -- it is the caller's responsibility to
    ;arrange this if necessary
    (while (not (eobp))
      (setq start-rec (point))		;save record start
      (setq done nil)
      ;; Get key value, or move to start of key.
      (setq key (catch 'key
		  (or (and startkeyfun (funcall startkeyfun))
		      ;; If key was not returned as value,
		      ;; move to end of key and get key from the buffer.
		      (let ((start (point)))
			(funcall (or endkeyfun
				     (prog1 endrecfun (setq done t))))
			(if (fboundp 'buffer-substring-lessp)
			    (cons start (point))
			  (buffer-substring start (point)))))))
      ;; Move to end of this record (start of next one, or end of buffer).
      (cond ((prog1 done (setq done nil)))
	    (endrecfun (funcall endrecfun))
	    (nextrecfun (funcall nextrecfun) (setq done t)))
      (if key (setq sort-lists (cons
				 ;; consing optimization in case in which key
				 ;; is same as record.
				 (if (and (consp key)
					  (equal (car key) start-rec)
					  (equal (cdr key) (point)))
				     (cons key key)
139 140
				   (cons key (cons start-rec (point))))
				 sort-lists)))
Richard M. Stallman's avatar
Richard M. Stallman committed
141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
      (and (not done) nextrecfun (funcall nextrecfun)))
    sort-lists))

(defun sort-reorder-buffer (sort-lists old)
  (let ((inhibit-quit t)
	(last (point-min))
	(min (point-min)) (max (point-max)))
    ;; Make sure insertions done for reordering
    ;; do not go after any markers at the end of the sorted region,
    ;; by inserting a space to separate them.
    (goto-char (point-max))
    (insert-before-markers " ")
    (narrow-to-region min (1- (point-max)))
    (while sort-lists
      (goto-char (point-max))
      (insert-buffer-substring (current-buffer)
			       last
			       (nth 1 (car old)))
      (goto-char (point-max))
      (insert-buffer-substring (current-buffer)
			       (nth 1 (car sort-lists))
162 163
			       (cdr (cdr (car sort-lists))))
      (setq last (cdr (cdr (car old)))
Richard M. Stallman's avatar
Richard M. Stallman committed
164 165 166 167 168 169 170 171 172 173 174 175 176
	    sort-lists (cdr sort-lists)
	    old (cdr old)))
    (goto-char (point-max))
    (insert-buffer-substring (current-buffer)
			     last
			     max)
    ;; Delete the original copy of the text.
    (delete-region min max)
    ;; Get rid of the separator " ".
    (goto-char (point-max))
    (narrow-to-region min (1+ (point)))
    (delete-region (point) (1+ (point)))))

Jim Blandy's avatar
Jim Blandy committed
177
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
178 179 180 181 182 183 184 185 186 187 188
(defun sort-lines (reverse beg end) 
  "Sort lines in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort)."
  (interactive "P\nr")
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      (sort-subr reverse 'forward-line 'end-of-line))))

Jim Blandy's avatar
Jim Blandy committed
189
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
190 191 192 193 194 195 196 197 198 199 200 201 202
(defun sort-paragraphs (reverse beg end)
  "Sort paragraphs in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort)."
  (interactive "P\nr")
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      (sort-subr reverse
		 (function (lambda () (skip-chars-forward "\n \t\f")))
		 'forward-paragraph))))

Jim Blandy's avatar
Jim Blandy committed
203
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229
(defun sort-pages (reverse beg end)
  "Sort pages in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort)."
  (interactive "P\nr")
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      (sort-subr reverse
		 (function (lambda () (skip-chars-forward "\n")))
		 'forward-page))))

(defvar sort-fields-syntax-table nil)
(if sort-fields-syntax-table nil
  (let ((table (make-syntax-table))
	(i 0))
    (while (< i 256)
      (modify-syntax-entry i "w" table)
      (setq i (1+ i)))
    (modify-syntax-entry ?\  " " table)
    (modify-syntax-entry ?\t " " table)
    (modify-syntax-entry ?\n " " table)
    (modify-syntax-entry ?\. "_" table)	; for floating pt. numbers. -wsr
    (setq sort-fields-syntax-table table)))

Jim Blandy's avatar
Jim Blandy committed
230
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
231 232 233 234
(defun sort-numeric-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 number in each line of the region.
root's avatar
root committed
235
With a negative arg, sorts by the ARGth field counted from the right.
Richard M. Stallman's avatar
Richard M. Stallman committed
236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251
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-int
			      (buffer-substring
			        (point)
				(save-excursion
				  ;; This is just wrong! Even without floats...
				  ;; (skip-chars-forward "[0-9]")
				  (forward-sexp 1)
				  (point))))))
		 nil))

root's avatar
root committed
252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271
(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))

Jim Blandy's avatar
Jim Blandy committed
272
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
273 274 275
(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.
root's avatar
root committed
276
With a negative arg, sorts by the ARGth field counted from the right.
Richard M. Stallman's avatar
Richard M. Stallman committed
277 278 279 280 281 282 283 284 285 286
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))
			     nil))
		 (function (lambda () (skip-chars-forward "^ \t\n")))))

(defun sort-fields-1 (field beg end startkeyfun endkeyfun)
root's avatar
root committed
287 288
  (let ((tbl (syntax-table)))
    (if (zerop field) (setq field 1))
Richard M. Stallman's avatar
Richard M. Stallman committed
289 290 291 292 293 294
    (unwind-protect
	(save-excursion
	  (save-restriction
	    (narrow-to-region beg end)
	    (goto-char (point-min))
	    (set-syntax-table sort-fields-syntax-table)
root's avatar
root committed
295
	    (sort-subr nil
Richard M. Stallman's avatar
Richard M. Stallman committed
296 297 298 299 300
		       'forward-line 'end-of-line
		       startkeyfun endkeyfun)))
      (set-syntax-table tbl))))

(defun sort-skip-fields (n)
root's avatar
root committed
301 302 303 304 305 306 307 308 309 310
  (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)))
Richard M. Stallman's avatar
Richard M. Stallman committed
311
	(error "Line has too few fields: %s"
root's avatar
root committed
312
	       (buffer-substring bol eol)))
Richard M. Stallman's avatar
Richard M. Stallman committed
313 314 315
    (skip-chars-forward " \t")))


Jim Blandy's avatar
Jim Blandy committed
316
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333
(defun sort-regexp-fields (reverse record-regexp key-regexp beg end)
  "Sort the region lexicographically as specifed by RECORD-REGEXP and KEY.
RECORD-REGEXP specifies the textual units which should be sorted.
  For example, to sort lines RECORD-REGEXP would be \"^.*$\"
KEY specifies the part of each record (ie each match for RECORD-REGEXP)
  is to be used for sorting.
  If it is \"\\digit\" then the digit'th \"\\(...\\)\" match field from
  RECORD-REGEXP is used.
  If it is \"\\&\" then the whole record is used.
  Otherwise, it is a regular-expression for which to search within the record.
If a match for KEY is not found within a record then that record is ignored.

With a negative prefix arg sorts in reverse order.

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*\\>\""
root's avatar
root committed
334 335 336
  ;; 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.
Richard M. Stallman's avatar
Richard M. Stallman committed
337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377
  (interactive "P\nsRegexp specifying records to sort: 
sRegexp specifying key within record: \nr")
  (cond ((or (equal key-regexp "") (equal key-regexp "\\&"))
	 (setq key-regexp 0))
	((string-match "\\`\\\\[1-9]\\'" key-regexp)
	 (setq key-regexp (- (aref key-regexp 1) ?0))))
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      (let (sort-regexp-record-end) ;isn't dynamic scoping wonderful?
	(re-search-forward record-regexp)
	(setq sort-regexp-record-end (point))
	(goto-char (match-beginning 0))
	(sort-subr reverse
		   (function (lambda ()
			       (and (re-search-forward record-regexp nil 'move)
				    (setq sort-regexp-record-end (match-end 0))
				    (goto-char (match-beginning 0)))))
		   (function (lambda ()
			       (goto-char sort-regexp-record-end)))
		   (function (lambda ()
			       (let ((n 0))
				 (cond ((numberp key-regexp)
					(setq n key-regexp))
				       ((re-search-forward
					  key-regexp sort-regexp-record-end t)
					(setq n 0))
				       (t (throw 'key nil)))
				 (condition-case ()
				     (if (fboundp 'buffer-substring-lessp)
					 (cons (match-beginning n)
					       (match-end n))
					 (buffer-substring (match-beginning n)
							   (match-end n)))
				   ;; if there was no such register
				   (error (throw 'key nil)))))))))))


(defvar sort-columns-subprocess t)

Jim Blandy's avatar
Jim Blandy committed
378
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419
(defun sort-columns (reverse &optional beg end)
  "Sort lines in region alphabetically by a certain range of columns.
For the purpose of this command, the region includes
the entire line that point is in and the entire line the mark is in.
The column positions of point and mark bound the range of columns to sort on.
A prefix argument means sort into reverse order.

Note that `sort-columns' rejects text that contains tabs,
because tabs could be split across the specified columns
and it doesn't know how to handle that.  Also, when possible,
it uses the `sort' utility program, which doesn't understand tabs.
Use \\[untabify] to convert tabs to spaces before sorting."
  (interactive "P\nr")
  (save-excursion
    (let (beg1 end1 col-beg1 col-end1 col-start col-end)
      (goto-char (min beg end))
      (setq col-beg1 (current-column))
      (beginning-of-line)
      (setq beg1 (point))
      (goto-char (max beg end))
      (setq col-end1 (current-column))
      (forward-line)
      (setq end1 (point))
      (setq col-start (min col-beg1 col-end1))
      (setq col-end (max col-beg1 col-end1))
      (if (search-backward "\t" beg1 t)
	  (error "sort-columns does not work with tabs.  Use M-x untabify."))
      (if (not (eq system-type 'vax-vms))
	  ;; Use the sort utility if we can; it is 4 times as fast.
	  (call-process-region beg1 end1 "sort" t t nil
			       (if reverse "-rt\n" "-t\n")
			       (concat "+0." col-start)
			       (concat "-0." col-end))
	;; On VMS, use Emacs's own facilities.
	(save-excursion
	  (save-restriction
	    (narrow-to-region beg1 end1)
	    (goto-char beg1)
	    (sort-subr reverse 'forward-line 'end-of-line
		       (function (lambda () (move-to-column col-start) nil))
		       (function (lambda () (move-to-column col-end) nil)))))))))
root's avatar
root committed
420

Jim Blandy's avatar
Jim Blandy committed
421
;;;###autoload
root's avatar
root committed
422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451
(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)))))
Jim Blandy's avatar
Jim Blandy committed
452 453 454

(provide 'sort)

Eric S. Raymond's avatar
Eric S. Raymond committed
455
;;; sort.el ends here