]> code.delx.au - gnu-emacs/blobdiff - lisp/sort.el
Merged from emacs@sv.gnu.org. Last-minute emacsclient rewrites be damned!
[gnu-emacs] / lisp / sort.el
index 541f598e7a57cb06eac6d594c4c1056d1fccbd9f..99293d6b51b7e9a2684e2a5eaad62f982174b915 100644 (file)
@@ -1,6 +1,7 @@
 ;;; sort.el --- commands to sort text in an Emacs buffer
 
-;; Copyright (C) 1986, 1987, 1994, 1995, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1987, 1994, 1995, 2002, 2003,
+;;   2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Howie Kaye
 ;; Maintainer: FSF
@@ -20,8 +21,8 @@
 
 ;; 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, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -201,7 +202,9 @@ the sort order."
     (save-restriction
       (narrow-to-region beg end)
       (goto-char (point-min))
-      (sort-subr reverse 'forward-line 'end-of-line))))
+      (let ;; To make `end-of-line' and etc. to ignore fields.
+         ((inhibit-field-text-motion t))
+       (sort-subr reverse 'forward-line 'end-of-line)))))
 
 ;;;###autoload
 (defun sort-paragraphs (reverse beg end)
@@ -245,7 +248,7 @@ the sort order."
     (while (< i 256)
       (modify-syntax-entry i "w" table)
       (setq i (1+ i)))
-    (modify-syntax-entry ?\  " " table)
+    (modify-syntax-entry ?\s " " table)
     (modify-syntax-entry ?\t " " table)
     (modify-syntax-entry ?\n " " table)
     (modify-syntax-entry ?\. "_" table)        ; for floating pt. numbers. -wsr
@@ -267,25 +270,27 @@ 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
-                (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))
+  (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)))
 
 ;;;;;###autoload
 ;;(defun sort-float-fields (field beg end)
@@ -318,11 +323,13 @@ FIELD, BEG and END.  BEG and END specify region to sort.
 The variable `sort-fold-case' determines whether alphabetic case affects
 the sort order."
   (interactive "p\nr")
-  (sort-fields-1 field beg end
-                (function (lambda ()
-                            (sort-skip-fields field)
-                            nil))
-                (function (lambda () (skip-chars-forward "^ \t\n")))))
+  (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"))))))
 
 (defun sort-fields-1 (field beg end startkeyfun endkeyfun)
   (let ((tbl (syntax-table)))
@@ -467,7 +474,9 @@ 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)
+    (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)
       (goto-char (min beg end))
       (setq col-beg1 (current-column))
       (beginning-of-line)
@@ -480,19 +489,32 @@ Use \\[untabify] to convert tabs to spaces before sorting."
       (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 (or (eq system-type 'vax-vms)
-                  (text-properties-at beg1)
-                  (< (next-property-change beg1 nil end1) end1)))
+      (if (not (or (memq system-type '(vax-vms windows-nt))
+                  (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)))))))
          ;; Use the sort utility if we can; it is 4 times as fast.
-         ;; Do not use it if there are any properties in the region,
-         ;; since the sort utility would lose the properties.
-         (let ((sort-args (list (if reverse "-rt\n" "-t\n")
-                                (concat "+0." (int-to-string col-start))
-                                (concat "-0." (int-to-string col-end)))))
+         ;; Do not use it if there are any non-font-lock properties
+         ;; in the region, since the sort utility would lose the
+         ;; properties.  Tabs are used as field separator; on NetBSD,
+         ;; sort complains if "\n" is used as field separator.
+         (let ((sort-args (list (if reverse "-rt\t" "-t\t")
+                                (format "-k1.%d,1.%d"
+                                        (1+ col-start)
+                                        (1+ col-end)))))
            (when sort-fold-case
              (push "-f" sort-args))
            (apply #'call-process-region beg1 end1 "sort" t t nil sort-args))
-       ;; On VMS, use Emacs's own facilities.
+       ;; On VMS and ms-windows, use Emacs's own facilities.
        (save-excursion
          (save-restriction
            (narrow-to-region beg1 end1)