X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8f924df7df019cce90537647de2627581043b5c4..8bff7c00b717303a526a71286232040b231d14c0:/lisp/sort.el diff --git a/lisp/sort.el b/lisp/sort.el index 59e076ecec..a858ad1f8f 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -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, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Howie Kaye ;; Maintainer: FSF @@ -8,10 +9,10 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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 2, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) 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 @@ -19,9 +20,7 @@ ;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -35,9 +34,10 @@ :group 'data) (defcustom sort-fold-case nil - "*Non-nil if the buffer sort functions should ignore case." + "Non-nil if the buffer sort functions should ignore case." :group 'sort :type 'boolean) +;;;###autoload(put 'sort-fold-case 'safe-local-variable 'booleanp) ;;;###autoload (defun sort-subr (reverse nextrecfun endrecfun @@ -155,8 +155,10 @@ it defaults to `<', otherwise it defaults to `string<'." (let ((last (point-min)) (min (point-min)) (max (point-max)) (old-buffer (current-buffer)) + (mb enable-multibyte-characters) temp-buffer) (with-temp-buffer + (set-buffer-multibyte mb) ;; Record the temporary buffer. (setq temp-buffer (current-buffer)) @@ -201,7 +203,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,16 +249,17 @@ 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 (setq sort-fields-syntax-table table))) (defcustom sort-numeric-base 10 - "*The default base used by `sort-numeric-fields'." + "The default base used by `sort-numeric-fields'." :group 'sort :type 'integer) +;;;###autoload(put 'sort-numeric-base 'safe-local-variable 'integerp) ;;;###autoload (defun sort-numeric-fields (field beg end) @@ -267,25 +272,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 +325,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 +476,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 +491,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 '(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 ms-windows, use Emacs's own facilities. (save-excursion (save-restriction (narrow-to-region beg1 end1) @@ -535,4 +559,5 @@ From a program takes two point or marker arguments, BEG and END." (provide 'sort) +;; arch-tag: fbac12be-2a7b-4c8a-9665-264d61f70bd9 ;;; sort.el ends here