*** empty log message ***

[gnu-emacs] / lisp / sort.el

diff --git a/lisp/sort.el b/lisp/sort.el
index 235f53e57bac08ab0587fd8317ccc4d79d7e6d12..0ee90121ae080f21482a32fbd54af25d51b5db67 100644 (file)
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -1,11 +1,16 @@
-;; 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.
 
 ;; 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
 ;; 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,
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,


@@ -17,18 +22,22 @@
 ;; along with GNU Emacs; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 ;; 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:

 
 

-;; Original version of most of this contributed by Howie Kaye
+;;; This package provides the sorting facilities documented in the Emacs
+;;; user's manual.
+
+;;; Code:

 
 (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.
 
 
 (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.
 
 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.


@@ -42,62 +51,66 @@ 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.
 
 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.
 
 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."
 
 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)))
+       (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
                  (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)
                               (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)))))))))
                              (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;
   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.
 
 ;; where KEY is the sort key (a number or string),
 ;; and STARTPOS and ENDPOS are the bounds of this record in the buffer.
 


@@ -121,9 +134,7 @@ same as ENDRECFUN."
                      (let ((start (point)))
                        (funcall (or endkeyfun
                                     (prog1 endrecfun (setq done t))))
                      (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))
       ;; Move to end of this record (start of next one, or end of buffer).
       (cond ((prog1 done (setq done nil)))
            (endrecfun (funcall endrecfun))


@@ -135,8 +146,8 @@ same as ENDRECFUN."
                                          (equal (car key) start-rec)
                                          (equal (cdr key) (point)))
                                     (cons key key)
                                          (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))
 
       (and (not done) nextrecfun (funcall nextrecfun)))
     sort-lists))
 


@@ -158,8 +169,8 @@ same as ENDRECFUN."
       (goto-char (point-max))
       (insert-buffer-substring (current-buffer)
                               (nth 1 (car 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))
            sort-lists (cdr sort-lists)
            old (cdr old)))
     (goto-char (point-max))


@@ -173,6 +184,7 @@ same as ENDRECFUN."
     (narrow-to-region min (1+ (point)))
     (delete-region (point) (1+ (point)))))
 
     (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:
 (defun sort-lines (reverse beg end) 
   "Sort lines in region alphabetically; argument means descending order.
 Called from a program, there are three arguments:


@@ -184,6 +196,7 @@ REVERSE (non-nil means reverse order), BEG and END (region to sort)."
       (goto-char (point-min))
       (sort-subr reverse 'forward-line 'end-of-line))))
 
       (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:
 (defun sort-paragraphs (reverse beg end)
   "Sort paragraphs in region alphabetically; argument means descending order.
 Called from a program, there are three arguments:


@@ -197,6 +210,7 @@ REVERSE (non-nil means reverse order), BEG and END (region to sort)."
                 (function (lambda () (skip-chars-forward "\n \t\f")))
                 'forward-paragraph))))
 
                 (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:
 (defun sort-pages (reverse beg end)
   "Sort pages in region alphabetically; argument means descending order.
 Called from a program, there are three arguments:


@@ -223,18 +237,20 @@ REVERSE (non-nil means reverse order), BEG and END (region to sort)."
     (modify-syntax-entry ?\. "_" table)        ; for floating pt. numbers. -wsr
     (setq sort-fields-syntax-table table)))
 
     (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:
 (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))
   (interactive "p\nr")
   (sort-fields-1 field beg end
                 (function (lambda ()
                             (sort-skip-fields (1- field))

-                            (string-to-int
+                            (string-to-number

                              (buffer-substring
                                (point)
                                (save-excursion
                              (buffer-substring
                                (point)
                                (save-excursion


@@ -244,6 +260,7 @@ FIELD, BEG and END.  BEG and END specify region to sort."
                                  (point))))))
                 nil))
 
                                  (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
 (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


@@ -255,7 +272,7 @@ region to sort."
   (sort-fields-1 field beg end
                 (function (lambda ()
                             (sort-skip-fields (1- field))
   (sort-fields-1 field beg end
                 (function (lambda ()
                             (sort-skip-fields (1- field))

-                            (string-to-float
+                            (string-to-number

                              (buffer-substring
                               (point)
                               (save-excursion
                              (buffer-substring
                               (point)
                               (save-excursion


@@ -264,6 +281,7 @@ region to sort."
                                 (point))))))
                 nil))
 
                                 (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.
 (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.


@@ -307,6 +325,7 @@ FIELD, BEG and END.  BEG and END specify region to sort."
     (skip-chars-forward " \t")))
 
 \f
     (skip-chars-forward " \t")))
 
 \f

+;;;###autoload

 (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.
 (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.


@@ -368,6 +387,7 @@ sRegexp specifying key within record: \nr")
 \f
 (defvar sort-columns-subprocess t)
 
 \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
 (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


@@ -410,6 +430,7 @@ Use \\[untabify] to convert tabs to spaces before sorting."
                       (function (lambda () (move-to-column col-start) nil))
                       (function (lambda () (move-to-column col-end) nil)))))))))
 
                       (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."
 (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."


@@ -440,3 +461,7 @@ From a program takes two point or marker arguments, BEG and END."
        (insert (car ll) "\n")
        (setq ll (cdr ll)))
       (insert (car ll)))))
        (insert (car ll) "\n")
        (setq ll (cdr ll)))
       (insert (car ll)))))

+
+(provide 'sort)
+
+;;; sort.el ends here