/[emacs]/emacs/lisp/sort.el
ViewVC logotype

Diff of /emacs/lisp/sort.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.41.2.1 by miles, Fri Apr 4 06:20:11 2003 UTC revision 1.41.2.2 by miles, Tue Oct 14 23:51:24 2003 UTC
# Line 40  Line 40 
40    :type 'boolean)    :type 'boolean)
41    
42  ;;;###autoload  ;;;###autoload
43  (defun sort-subr (reverse nextrecfun endrecfun &optional startkeyfun endkeyfun)  (defun sort-subr (reverse nextrecfun endrecfun
44                              &optional startkeyfun endkeyfun predicate)
45    "General text sorting routine to divide buffer into records and sort them.    "General text sorting routine to divide buffer into records and sort them.
46    
47  We divide the accessible portion of the buffer into disjoint pieces  We divide the accessible portion of the buffer into disjoint pieces
# Line 74  starts at the beginning of the record. Line 75  starts at the beginning of the record.
75    
76  ENDKEYFUN moves from the start of the sort key to the end of the sort key.  ENDKEYFUN moves from the start of the sort key to the end of the sort key.
77  ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the  ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the
78  same as ENDRECFUN."  same as ENDRECFUN.
79    
80    PREDICATE is the function to use to compare keys.  If keys are numbers,
81    it defaults to `<', otherwise it defaults to `string<'."
82    ;; Heuristically try to avoid messages if sorting a small amt of text.    ;; Heuristically try to avoid messages if sorting a small amt of text.
83    (let ((messages (> (- (point-max) (point-min)) 50000)))    (let ((messages (> (- (point-max) (point-min)) 50000)))
84      (save-excursion      (save-excursion
# Line 88  same as ENDRECFUN." Line 92  same as ENDRECFUN."
92            (or reverse (setq sort-lists (nreverse sort-lists)))            (or reverse (setq sort-lists (nreverse sort-lists)))
93            (if messages (message "Sorting records..."))            (if messages (message "Sorting records..."))
94            (setq sort-lists            (setq sort-lists
95                  (if (fboundp 'sortcar)                  (sort sort-lists
96                      (sortcar sort-lists                        (cond (predicate
97                               (cond ((numberp (car (car sort-lists)))                               `(lambda (a b) (,predicate (car a) (car b))))
98                                      ;; This handles both ints and floats.                              ((numberp (car (car sort-lists)))
99                                      '<)                               'car-less-than-car)
100                                     ((consp (car (car sort-lists)))                              ((consp (car (car sort-lists)))
101                                      (function                               (lambda (a b)
102                                       (lambda (a b)                                 (> 0 (compare-buffer-substrings
103                                         (> 0 (compare-buffer-substrings                                       nil (car (car a)) (cdr (car a))
104                                               nil (car a) (cdr a)                                       nil (car (car b)) (cdr (car b))))))
105                                               nil (car b) (cdr b))))))                              (t
106                                     (t                               (lambda (a b) (string< (car a) (car b)))))))
                                     'string<)))  
                   (sort sort-lists  
                         (cond ((numberp (car (car sort-lists)))  
                                'car-less-than-car)  
                               ((consp (car (car sort-lists)))  
                                (function  
                                 (lambda (a 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)))))))))  
107            (if reverse (setq sort-lists (nreverse sort-lists)))            (if reverse (setq sort-lists (nreverse sort-lists)))
108            (if messages (message "Reordering buffer..."))            (if messages (message "Reordering buffer..."))
109            (sort-reorder-buffer sort-lists old)))            (sort-reorder-buffer sort-lists old)))
# Line 150  same as ENDRECFUN." Line 140  same as ENDRECFUN."
140        (cond ((prog1 done (setq done nil)))        (cond ((prog1 done (setq done nil)))
141              (endrecfun (funcall endrecfun))              (endrecfun (funcall endrecfun))
142              (nextrecfun (funcall nextrecfun) (setq done t)))              (nextrecfun (funcall nextrecfun) (setq done t)))
143        (if key (setq sort-lists (cons        (if key (push
144                                   ;; consing optimization in case in which key                 ;; consing optimization in case in which key is same as record.
145                                   ;; is same as record.                 (if (and (consp key)
146                                   (if (and (consp key)                          (equal (car key) start-rec)
147                                            (equal (car key) start-rec)                          (equal (cdr key) (point)))
148                                            (equal (cdr key) (point)))                     (cons key key)
149                                       (cons key key)                   (cons key (cons start-rec (point))))
150                                     (cons key (cons start-rec (point))))                 sort-lists))
                                  sort-lists)))  
151        (and (not done) nextrecfun (funcall nextrecfun)))        (and (not done) nextrecfun (funcall nextrecfun)))
152      sort-lists))      sort-lists))
153    
# Line 546  From a program takes two point or marker Line 535  From a program takes two point or marker
535    
536  (provide 'sort)  (provide 'sort)
537    
538    ;;; arch-tag: fbac12be-2a7b-4c8a-9665-264d61f70bd9
539  ;;; sort.el ends here  ;;; sort.el ends here

Legend:
Removed from v.1.41.2.1  
changed lines
  Added in v.1.41.2.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26