sort.el 16.8 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
Jim Blandy's avatar
Jim Blandy committed
32 33 34 35
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.
Richard M. Stallman's avatar
Richard M. Stallman committed
36 37 38 39 40 41 42 43 44 45 46 47 48

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.

Richard M. Stallman's avatar
Richard M. Stallman committed
49
ENDRECFUN is called with point within the record.
Richard M. Stallman's avatar
Richard M. Stallman committed
50 51
It should move point to the end of the record.

Richard M. Stallman's avatar
Richard M. Stallman committed
52 53
STARTKEYFUN moves from the start of the record to the start of the key.
It may return either a non-nil value to be used as the key, or
54
else the key is the substring between the values of point after
55 56
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
57 58 59 60

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."
61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
  ;; 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)))
79 80 81
				    (function
				     (lambda (a b)
				       (> 0 (compare-buffer-substrings 
82 83
					     nil (car a) (cdr a)
					     nil (car b) (cdr b))))))
84 85
				   (t
				    'string<)))
Jim Blandy's avatar
Jim Blandy committed
86 87 88 89 90 91 92 93
		  (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)
94
				  (> 0 (compare-buffer-substrings 
95 96
					nil (car (car a)) (cdr (car a))
					nil (car (car b)) (cdr (car b)))))))
Jim Blandy's avatar
Jim Blandy committed
97 98 99 100
			      (t
			       (function
				(lambda (a b)
				  (string< (car a) (car b)))))))))
101 102 103 104
	  (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
105 106 107
  nil)

;; Parse buffer into records using the arguments as Lisp expressions;
root's avatar
root committed
108
;; return a list of records.  Each record looks like (KEY STARTPOS . ENDPOS)
Richard M. Stallman's avatar
Richard M. Stallman committed
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
;; 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))))
132
			(cons start (point))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
133 134 135 136 137 138 139 140 141 142 143
      ;; 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)
144 145
				   (cons key (cons start-rec (point))))
				 sort-lists)))
Richard M. Stallman's avatar
Richard M. Stallman committed
146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
      (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))
167 168
			       (cdr (cdr (car sort-lists))))
      (setq last (cdr (cdr (car old)))
Richard M. Stallman's avatar
Richard M. Stallman committed
169 170 171 172 173 174 175 176 177 178 179 180 181
	    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
182
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
183 184 185 186 187 188 189 190 191 192 193
(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
194
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
195 196 197 198 199 200 201 202 203 204 205 206 207
(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
208
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
(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
235
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
236 237 238 239
(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
240
With a negative arg, sorts by the ARGth field counted from the right.
Richard M. Stallman's avatar
Richard M. Stallman committed
241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256
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
257 258 259 260 261 262 263 264 265 266 267
(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))
268
			     (string-to-number
root's avatar
root committed
269 270 271 272 273 274 275 276
			      (buffer-substring
			       (point)
			       (save-excursion
				 (re-search-forward
				  "[+-]?[0-9]*\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
				 (point))))))
		 nil))

Jim Blandy's avatar
Jim Blandy committed
277
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
278 279 280
(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
281
With a negative arg, sorts by the ARGth field counted from the right.
Richard M. Stallman's avatar
Richard M. Stallman committed
282 283 284 285 286 287 288 289 290 291
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
292 293
  (let ((tbl (syntax-table)))
    (if (zerop field) (setq field 1))
Richard M. Stallman's avatar
Richard M. Stallman committed
294 295 296 297 298 299
    (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
300
	    (sort-subr nil
Richard M. Stallman's avatar
Richard M. Stallman committed
301 302 303 304 305
		       'forward-line 'end-of-line
		       startkeyfun endkeyfun)))
      (set-syntax-table tbl))))

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


Jim Blandy's avatar
Jim Blandy committed
321
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338
(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
339 340 341
  ;; 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
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 378 379 380 381 382
  (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
383
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
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 420 421 422 423 424
(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
425

Jim Blandy's avatar
Jim Blandy committed
426
;;;###autoload
root's avatar
root committed
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 452 453 454 455 456
(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
457 458 459

(provide 'sort)

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