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

3
;; Copyright (C) 1986, 1987, 1994, 1995, 2002, 2003,
4
;;   2004, 2005, 2006 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
5

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

Richard M. Stallman's avatar
Richard M. Stallman committed
10 11 12 13
;; 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
14
;; the Free Software Foundation; either version 2, or (at your option)
Richard M. Stallman's avatar
Richard M. Stallman committed
15 16 17 18 19 20 21 22
;; 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
Erik Naggum's avatar
Erik Naggum committed
23
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
24 25
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Richard M. Stallman's avatar
Richard M. Stallman committed
26

27 28
;;; Commentary:

Erik Naggum's avatar
Erik Naggum committed
29 30
;; This package provides the sorting facilities documented in the Emacs
;; user's manual.
31

Eric S. Raymond's avatar
Eric S. Raymond committed
32
;;; Code:
Richard M. Stallman's avatar
Richard M. Stallman committed
33

Richard M. Stallman's avatar
Richard M. Stallman committed
34 35 36 37 38 39 40 41
(defgroup sort nil
  "Commands to sort text in an Emacs buffer."
  :group 'data)

(defcustom sort-fold-case nil
  "*Non-nil if the buffer sort functions should ignore case."
  :group 'sort
  :type 'boolean)
42

43
;;;###autoload
44 45
(defun sort-subr (reverse nextrecfun endrecfun
			  &optional startkeyfun endkeyfun predicate)
Richard M. Stallman's avatar
Richard M. Stallman committed
46 47
  "General text sorting routine to divide buffer into records and sort them.

48
We divide the accessible portion of the buffer into disjoint pieces
Jim Blandy's avatar
Jim Blandy committed
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.
Richard M. Stallman's avatar
Richard M. Stallman committed
53 54 55

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.
Richard M. Stallman's avatar
Richard M. Stallman committed
56 57
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order.
Richard M. Stallman's avatar
Richard M. Stallman committed
58 59 60 61 62 63 64 65 66 67

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
68
ENDRECFUN is called with point within the record.
Richard M. Stallman's avatar
Richard M. Stallman committed
69 70
It should move point to the end of the record.

Richard M. Stallman's avatar
Richard M. Stallman committed
71 72
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
73
else the key is the substring between the values of point after
74 75
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
76 77 78

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
79 80 81 82
same as ENDRECFUN.

PREDICATE is the function to use to compare keys.  If keys are numbers,
it defaults to `<', otherwise it defaults to `string<'."
83 84 85 86 87 88
  ;; 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))
89 90
	     (old (reverse sort-lists))
	     (case-fold-search sort-fold-case))
91 92 93 94 95
	(if (null sort-lists)
	    ()
	  (or reverse (setq sort-lists (nreverse sort-lists)))
	  (if messages (message "Sorting records..."))
	  (setq sort-lists
96 97 98 99 100 101 102 103 104 105 106 107
		(sort sort-lists
		      (cond (predicate
			     `(lambda (a b) (,predicate (car a) (car b))))
			    ((numberp (car (car sort-lists)))
			     'car-less-than-car)
			    ((consp (car (car sort-lists)))
			     (lambda (a b)
			       (> 0 (compare-buffer-substrings
				     nil (car (car a)) (cdr (car a))
				     nil (car (car b)) (cdr (car b))))))
			    (t
			     (lambda (a b) (string< (car a) (car b)))))))
108 109 110 111
	  (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
112 113 114
  nil)

;; Parse buffer into records using the arguments as Lisp expressions;
root's avatar
root committed
115
;; return a list of records.  Each record looks like (KEY STARTPOS . ENDPOS)
Richard M. Stallman's avatar
Richard M. Stallman committed
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))))
139
			(cons start (point))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
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)))
144 145 146 147 148 149 150 151
      (if key (push
	       ;; 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)
		 (cons key (cons start-rec (point))))
	       sort-lists))
Richard M. Stallman's avatar
Richard M. Stallman committed
152 153 154 155
      (and (not done) nextrecfun (funcall nextrecfun)))
    sort-lists))

(defun sort-reorder-buffer (sort-lists old)
156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
  (let ((last (point-min))
	(min (point-min)) (max (point-max))
	(old-buffer (current-buffer))
	temp-buffer)
    (with-temp-buffer
      ;; Record the temporary buffer.
      (setq temp-buffer (current-buffer))

      ;; Copy the sorted text into the temporary buffer.
      (while sort-lists
	(goto-char (point-max))
	(insert-buffer-substring old-buffer
				 last
				 (nth 1 (car old)))
	(goto-char (point-max))
	(insert-buffer-substring old-buffer
				 (nth 1 (car sort-lists))
				 (cdr (cdr (car sort-lists))))
	(setq last (cdr (cdr (car old)))
	      sort-lists (cdr sort-lists)
	      old (cdr old)))
Richard M. Stallman's avatar
Richard M. Stallman committed
177
      (goto-char (point-max))
178
      (insert-buffer-substring old-buffer last max)
179 180 181 182 183 184

      ;; Copy the reordered text from the temporary buffer
      ;; to the buffer we sorted (OLD-BUFFER).
      (set-buffer old-buffer)
      (let ((inhibit-quit t))
	;; Make sure insertions done for reordering
185 186 187 188 189
	;; saves any markers at the end of the sorted region,
	;; by leaving the last character of the region.
	(delete-region min (1- max))
  	;; Now replace the one remaining old character with the sorted text.
	(goto-char (point-min))
190
	(insert-buffer-substring temp-buffer)
191
	(delete-region max (1+ max))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
192

Jim Blandy's avatar
Jim Blandy committed
193
;;;###autoload
194
(defun sort-lines (reverse beg end)
Richard M. Stallman's avatar
Richard M. Stallman committed
195 196
  "Sort lines in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
Richard M. Stallman's avatar
Richard M. Stallman committed
197 198 199
REVERSE (non-nil means reverse order), BEG and END (region to sort).
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order."
Richard M. Stallman's avatar
Richard M. Stallman committed
200 201 202 203 204
  (interactive "P\nr")
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
205 206 207
      (let ;; To make `end-of-line' and etc. to ignore fields.
	  ((inhibit-field-text-motion t))
	(sort-subr reverse 'forward-line 'end-of-line)))))
Richard M. Stallman's avatar
Richard M. Stallman committed
208

Jim Blandy's avatar
Jim Blandy committed
209
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
210 211 212
(defun sort-paragraphs (reverse beg end)
  "Sort paragraphs in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
Richard M. Stallman's avatar
Richard M. Stallman committed
213 214 215
REVERSE (non-nil means reverse order), BEG and END (region to sort).
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order."
Richard M. Stallman's avatar
Richard M. Stallman committed
216 217 218 219 220 221
  (interactive "P\nr")
  (save-excursion
    (save-restriction
      (narrow-to-region beg end)
      (goto-char (point-min))
      (sort-subr reverse
222 223 224 225
		 (function
		  (lambda ()
		    (while (and (not (eobp)) (looking-at paragraph-separate))
		      (forward-line 1))))
Richard M. Stallman's avatar
Richard M. Stallman committed
226 227
		 'forward-paragraph))))

Jim Blandy's avatar
Jim Blandy committed
228
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
229 230 231
(defun sort-pages (reverse beg end)
  "Sort pages in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
Richard M. Stallman's avatar
Richard M. Stallman committed
232 233 234
REVERSE (non-nil means reverse order), BEG and END (region to sort).
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order."
Richard M. Stallman's avatar
Richard M. Stallman committed
235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256
  (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)))

257 258 259 260 261
(defcustom sort-numeric-base 10
  "*The default base used by `sort-numeric-fields'."
  :group 'sort
  :type 'integer)

Jim Blandy's avatar
Jim Blandy committed
262
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
263 264 265
(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.
266 267 268
Specified field must contain a number in each line of the region,
which may begin with \"0x\" or \"0\" for hexadecimal and octal values.
Otherwise, the number is interpreted according to sort-numeric-base.
root's avatar
root committed
269
With a negative arg, sorts by the ARGth field counted from the right.
Richard M. Stallman's avatar
Richard M. Stallman committed
270
Called from a program, there are three arguments:
271
FIELD, BEG and END.  BEG and END specify region to sort."
Richard M. Stallman's avatar
Richard M. Stallman committed
272
  (interactive "p\nr")
273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293
  (let ;; To make `end-of-line' and etc. to ignore fields.
      ((inhibit-field-text-motion t))
    (sort-fields-1 field beg end
		   (lambda ()
		     (sort-skip-fields field)
		     (let* ((case-fold-search t)
			    (base
			     (if (looking-at "\\(0x\\)[0-9a-f]\\|\\(0\\)[0-7]")
				 (cond ((match-beginning 1)
					(goto-char (match-end 1))
					16)
				       ((match-beginning 2)
					(goto-char (match-end 2))
					8)
				       (t nil)))))
		       (string-to-number (buffer-substring (point)
							   (save-excursion
							     (forward-sexp 1)
							     (point)))
					 (or base sort-numeric-base))))
		   nil)))
Richard M. Stallman's avatar
Richard M. Stallman committed
294

295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314
;;;;;###autoload
;;(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 field)
;;			     (string-to-number
;;			      (buffer-substring
;;			       (point)
;;			       (save-excursion
;;				 (re-search-forward
;;				  "[+-]?[0-9]*\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
;;				 (point))))))
;;		 nil))
root's avatar
root committed
315

Jim Blandy's avatar
Jim Blandy committed
316
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
317 318 319
(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
320
With a negative arg, sorts by the ARGth field counted from the right.
Richard M. Stallman's avatar
Richard M. Stallman committed
321
Called from a program, there are three arguments:
Richard M. Stallman's avatar
Richard M. Stallman committed
322 323 324
FIELD, BEG and END.  BEG and END specify region to sort.
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order."
Richard M. Stallman's avatar
Richard M. Stallman committed
325
  (interactive "p\nr")
326 327 328 329 330 331 332
  (let ;; To make `end-of-line' and etc. to ignore fields.
      ((inhibit-field-text-motion t))
    (sort-fields-1 field beg end
		   (function (lambda ()
			       (sort-skip-fields field)
			       nil))
		   (function (lambda () (skip-chars-forward "^ \t\n"))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
333 334

(defun sort-fields-1 (field beg end startkeyfun endkeyfun)
root's avatar
root committed
335 336
  (let ((tbl (syntax-table)))
    (if (zerop field) (setq field 1))
Richard M. Stallman's avatar
Richard M. Stallman committed
337 338 339 340 341 342
    (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
343
	    (sort-subr nil
Richard M. Stallman's avatar
Richard M. Stallman committed
344 345 346 347
		       'forward-line 'end-of-line
		       startkeyfun endkeyfun)))
      (set-syntax-table tbl))))

348 349
;; Position at the beginning of field N on the current line,
;; assuming point is initially at the beginning of the line.
Richard M. Stallman's avatar
Richard M. Stallman committed
350
(defun sort-skip-fields (n)
351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372
  (if (> n 0)
      ;; Skip across N - 1 fields.
      (let ((i (1- n)))
	(while (> i 0)
	  (skip-chars-forward " \t")
	  (skip-chars-forward "^ \t\n")
	  (setq i (1- i)))
	(skip-chars-forward " \t")
	(if (eolp)
	    (error "Line has too few fields: %s"
		   (buffer-substring
		    (save-excursion (beginning-of-line) (point))
		    (save-excursion (end-of-line) (point))))))
    (end-of-line)
    ;; Skip back across - N - 1 fields.
    (let ((i (1- (- n))))
      (while (> i 0)
	(skip-chars-backward " \t")
	(skip-chars-backward "^ \t\n")
	(setq i (1- i)))
      (skip-chars-backward " \t"))
    (if (bolp)
Richard M. Stallman's avatar
Richard M. Stallman committed
373
	(error "Line has too few fields: %s"
374 375 376 377 378 379
	       (buffer-substring
		(save-excursion (beginning-of-line) (point))
		(save-excursion (end-of-line) (point)))))
    ;; Position at the front of the field
    ;; even if moving backwards.
    (skip-chars-backward "^ \t\n")))
Richard M. Stallman's avatar
Richard M. Stallman committed
380

381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399
(defvar sort-regexp-fields-regexp)
(defvar sort-regexp-record-end)

;; Move to the beginning of the next match for record-regexp,
;; and set sort-regexp-record-end to the end of that match.
;; If the next match is empty and does not advance point,
;; skip one character and try again.
(defun sort-regexp-fields-next-record ()
  (let ((oldpos (point)))
    (and (re-search-forward sort-regexp-fields-regexp nil 'move)
	 (setq sort-regexp-record-end (match-end 0))
	 (if (= sort-regexp-record-end oldpos)
	     (progn
	       (forward-char 1)
	       (re-search-forward sort-regexp-fields-regexp nil 'move)
	       (setq sort-regexp-record-end (match-end 0)))
	   t)
	 (goto-char (match-beginning 0)))))

Jim Blandy's avatar
Jim Blandy committed
400
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
401
(defun sort-regexp-fields (reverse record-regexp key-regexp beg end)
402
  "Sort the region lexicographically as specified by RECORD-REGEXP and KEY.
Richard M. Stallman's avatar
Richard M. Stallman committed
403 404 405 406
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.
407
  If it is \"\\\\digit\" then the digit'th \"\\\\(...\\\\)\" match field from
Richard M. Stallman's avatar
Richard M. Stallman committed
408
  RECORD-REGEXP is used.
409
  If it is \"\\\\&\" then the whole record is used.
Richard M. Stallman's avatar
Richard M. Stallman committed
410 411 412 413 414
  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.

Richard M. Stallman's avatar
Richard M. Stallman committed
415 416 417
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order.

Richard M. Stallman's avatar
Richard M. Stallman committed
418 419
For example: to sort lines in the region by the first word on each line
 starting with the letter \"f\",
420
 RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\<f\\\\w*\\\\>\""
root's avatar
root committed
421 422 423
  ;; 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.
424
  (interactive "P\nsRegexp specifying records to sort:
Richard M. Stallman's avatar
Richard M. Stallman committed
425 426 427 428 429 430 431 432 433
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))
434 435
      (let (sort-regexp-record-end
	    (sort-regexp-fields-regexp record-regexp))
436
	(re-search-forward sort-regexp-fields-regexp nil t)
Richard M. Stallman's avatar
Richard M. Stallman committed
437 438 439
	(setq sort-regexp-record-end (point))
	(goto-char (match-beginning 0))
	(sort-subr reverse
440
		   'sort-regexp-fields-next-record
Richard M. Stallman's avatar
Richard M. Stallman committed
441 442 443 444 445 446 447 448 449 450 451
		   (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 ()
Richard M. Stallman's avatar
Richard M. Stallman committed
452 453
				     (cons (match-beginning n)
					   (match-end n))
Richard M. Stallman's avatar
Richard M. Stallman committed
454 455 456 457 458 459
				   ;; if there was no such register
				   (error (throw 'key nil)))))))))))


(defvar sort-columns-subprocess t)

Jim Blandy's avatar
Jim Blandy committed
460
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
461 462
(defun sort-columns (reverse &optional beg end)
  "Sort lines in region alphabetically by a certain range of columns.
463
For the purpose of this command, the region BEG...END includes
Richard M. Stallman's avatar
Richard M. Stallman committed
464 465
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.
466
A prefix argument means sort into REVERSE order.
Richard M. Stallman's avatar
Richard M. Stallman committed
467 468
The variable `sort-fold-case' determines whether alphabetic case affects
the sort order.
Richard M. Stallman's avatar
Richard M. Stallman committed
469 470 471 472 473 474 475 476

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
477 478 479
    (let ;; To make `end-of-line' and etc. to ignore fields.
	((inhibit-field-text-motion t)
	 beg1 end1 col-beg1 col-end1 col-start col-end)
Richard M. Stallman's avatar
Richard M. Stallman committed
480 481 482 483 484 485 486 487 488 489 490
      (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)
491
	  (error "sort-columns does not work with tabs -- use M-x untabify"))
492
      (if (not (or (memq system-type '(vax-vms windows-nt))
493 494 495 496 497 498 499 500 501 502 503 504
		   (let ((pos beg1) plist fontified)
		     (catch 'found
		       (while (< pos end1)
			 (setq plist (text-properties-at pos))
			 (setq fontified (plist-get plist 'fontified))
			 (while (consp plist)
			   (unless (or (eq (car plist) 'fontified)
				       (and (eq (car plist) 'face)
					    fontified))
			     (throw 'found t))
			   (setq plist (cddr plist)))
			 (setq pos (next-property-change pos nil end1)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
505
	  ;; Use the sort utility if we can; it is 4 times as fast.
506 507 508
	  ;; Do not use it if there are any non-font-lock properties
	  ;; in the region, since the sort utility would lose the
	  ;; properties.
509 510 511 512
	  ;; Set the field separator to tab to have the same effect as 
	  ;; sort-columns which makes sure there are no tabs in the region
	  ;; worked.
	  (let ((sort-args (list (if reverse "-rt\t" "-t\t")
513 514 515
				 (format "-k1.%d,1.%d"
					 (1+ col-start)
					 (1+ col-end)))))
516 517 518
	    (when sort-fold-case
	      (push "-f" sort-args))
	    (apply #'call-process-region beg1 end1 "sort" t t nil sort-args))
519
	;; On VMS and ms-windows, use Emacs's own facilities.
Richard M. Stallman's avatar
Richard M. Stallman committed
520 521 522 523 524
	(save-excursion
	  (save-restriction
	    (narrow-to-region beg1 end1)
	    (goto-char beg1)
	    (sort-subr reverse 'forward-line 'end-of-line
525 526
		       #'(lambda () (move-to-column col-start) nil)
		       #'(lambda () (move-to-column col-end) nil))))))))
root's avatar
root committed
527

Jim Blandy's avatar
Jim Blandy committed
528
;;;###autoload
root's avatar
root committed
529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558
(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
559 560 561

(provide 'sort)

Miles Bader's avatar
Miles Bader committed
562
;;; arch-tag: fbac12be-2a7b-4c8a-9665-264d61f70bd9
Eric S. Raymond's avatar
Eric S. Raymond committed
563
;;; sort.el ends here