-;; Commands to sort text in an Emacs buffer.
+;;; sort.el --- commands to sort text in an Emacs buffer.
+
;; Copyright (C) 1986, 1987 Free Software Foundation, Inc.
+;; Author: Howie Kaye
+;; Maintainer: FSF
+;; Keywords: unix
+
;; 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
-;; the Free Software Foundation; either version 1, or (at your option)
+;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-(provide 'sort)
+;;; Commentary:
+
+;;; This package provides the sorting facilities documented in the Emacs
+;;; user's manual.
-;; Original version of most of this contributed by Howie Kaye
+;;; Code:
+
+(defvar sort-fold-case nil
+ "*Non-nil if the buffer sort functions should ignore case.")
(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.
-We consider this portion of the buffer to be divided into disjoint pieces
-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.
+We divide the accessible portion of the buffer into disjoint pieces
+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 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.
+ENDRECFUN 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
-else the key will be the substring between the values of point after
-STARTKEYFUNC and ENDKEYFUN are called.
+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
+else the key is the substring between the values of point after
+STARTKEYFUN and ENDKEYFUN are called. If STARTKEYFUN is nil, the key
+starts at the beginning of the record.
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."
- (save-excursion
- (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)))
- (message "Sorting records...")
- (setq sort-lists
- (if (fboundp 'sortcar)
- (sortcar sort-lists
- (cond ((floatp (car (car sort-lists)))
- 'f<)
- ((numberp (car (car sort-lists)))
- '<)
- ((consp (car (car sort-lists)))
- 'buffer-substring-lessp)
- (t
- 'string<)))
+ ;; 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))
+ (case-fold-search sort-fold-case))
+ (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)))
+ (function
+ (lambda (a b)
+ (> 0 (compare-buffer-substrings
+ nil (car a) (cdr a)
+ nil (car b) (cdr b))))))
+ (t
+ 'string<)))
(sort sort-lists
- (cond ((floatp (car (car sort-lists)))
- (function
- (lambda (a b)
- (f< (car a) (car b)))))
- ((numberp (car (car 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)))))
+ (> 0 (compare-buffer-substrings
+ nil (car (car a)) (cdr (car a))
+ nil (car (car b)) (cdr (car b)))))))
(t
(function
(lambda (a b)
(string< (car a) (car b)))))))))
- (if reverse (setq sort-lists (nreverse sort-lists)))
- (message "Reordering buffer...")
- (sort-reorder-buffer sort-lists old)))
- (message "Reordering buffer... Done"))
+ (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"))))
nil)
;; Parse buffer into records using the arguments as Lisp expressions;
-;; return a list of records. Each record looks like (KEY STARTPOS ENDPOS)
+;; return a list of records. Each record looks like (KEY STARTPOS . ENDPOS)
;; where KEY is the sort key (a number or string),
;; and STARTPOS and ENDPOS are the bounds of this record in 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)))))))
+ (cons 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))
(equal (car key) start-rec)
(equal (cdr key) (point)))
(cons key key)
- (list key start-rec (point)))
- sort-lists)))
+ (cons key (cons start-rec (point))))
+ sort-lists)))
(and (not done) nextrecfun (funcall nextrecfun)))
sort-lists))
(goto-char (point-max))
(insert-buffer-substring (current-buffer)
(nth 1 (car sort-lists))
- (nth 2 (car sort-lists)))
- (setq last (nth 2 (car old))
+ (cdr (cdr (car sort-lists))))
+ (setq last (cdr (cdr (car old)))
sort-lists (cdr sort-lists)
old (cdr old)))
(goto-char (point-max))
(narrow-to-region min (1+ (point)))
(delete-region (point) (1+ (point)))))
+;;;###autoload
(defun sort-lines (reverse beg end)
"Sort lines in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
(goto-char (point-min))
(sort-subr reverse 'forward-line 'end-of-line))))
+;;;###autoload
(defun sort-paragraphs (reverse beg end)
"Sort paragraphs in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
(function (lambda () (skip-chars-forward "\n \t\f")))
'forward-paragraph))))
+;;;###autoload
(defun sort-pages (reverse beg end)
"Sort pages in region alphabetically; argument means descending order.
Called from a program, there are three arguments:
(modify-syntax-entry ?\. "_" table) ; for floating pt. numbers. -wsr
(setq sort-fields-syntax-table table)))
+;;;###autoload
(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.
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."
+FIELD, BEG and END. BEG and END specify region to sort.
+If you want to sort floating-point numbers, try `sort-float-fields'."
(interactive "p\nr")
(sort-fields-1 field beg end
(function (lambda ()
- (sort-skip-fields (1- field))
- (string-to-int
+ (sort-skip-fields field)
+ (string-to-number
(buffer-substring
(point)
(save-excursion
(point))))))
nil))
+;;;###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
(interactive "p\nr")
(sort-fields-1 field beg end
(function (lambda ()
- (sort-skip-fields (1- field))
- (string-to-float
+ (sort-skip-fields field)
+ (string-to-number
(buffer-substring
(point)
(save-excursion
(point))))))
nil))
+;;;###autoload
(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.
(interactive "p\nr")
(sort-fields-1 field beg end
(function (lambda ()
- (sort-skip-fields (1- field))
+ (sort-skip-fields field)
nil))
(function (lambda () (skip-chars-forward "^ \t\n")))))
startkeyfun endkeyfun)))
(set-syntax-table tbl))))
+;; Position at the beginning of field N on the current line,
+;; assuming point is initially at the beginning of the line.
(defun sort-skip-fields (n)
- (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)))
+ (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)
(error "Line has too few fields: %s"
- (buffer-substring bol eol)))
- (skip-chars-forward " \t")))
-
+ (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")))
\f
+;;;###autoload
(defun sort-regexp-fields (reverse record-regexp key-regexp beg end)
- "Sort the region lexicographically as specifed by RECORD-REGEXP and KEY.
+ "Sort the region lexicographically as specified 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)
\f
(defvar sort-columns-subprocess t)
+;;;###autoload
(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
(function (lambda () (move-to-column col-start) nil))
(function (lambda () (move-to-column col-end) nil)))))))))
+;;;###autoload
(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."
(insert (car ll) "\n")
(setq ll (cdr ll)))
(insert (car ll)))))
+
+(provide 'sort)
+
+;;; sort.el ends here
HCoop / bpt / emacs.git / blobdiff