annotate lisp/tl/range.el @ 123:c77884c6318d

Added tag r20-1b14 for changeset d2f30a177268
author cvs
date Mon, 13 Aug 2007 09:26:04 +0200
parents c0c698873ce1
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
4
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
1 ;;; range.el --- range functions
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
2
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
3 ;; Copyright (C) 1987 .. 1996 Free Software Foundation, Inc.
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
4
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
5 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
6 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
7 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
8 ;; Version:
76
c0c698873ce1 Import from CVS: tag r20-0b33
cvs
parents: 70
diff changeset
9 ;; $Id: range.el,v 1.2 1996/12/28 21:03:09 steve Exp $
4
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
10 ;; Keywords: range
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
11
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
12 ;; This file is part of tl (Tiny Library).
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
13
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
14 ;; This program is free software; you can redistribute it and/or
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
15 ;; modify it under the terms of the GNU General Public License as
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
16 ;; published by the Free Software Foundation; either version 2, or (at
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
17 ;; your option) any later version.
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
18
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
19 ;; This program is distributed in the hope that it will be useful, but
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
22 ;; General Public License for more details.
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
23
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
24 ;; You should have received a copy of the GNU General Public License
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
25 ;; along with This program; see the file COPYING. If not, write to
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
26 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
27 ;; Boston, MA 02111-1307, USA.
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
28
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
29 ;;; Code:
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
30
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
31 ;; These functions were imported from September Gnus 0.40.
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
32
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
33 (defun compress-sorted-numbers (numbers &optional always-list)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
34 "Convert list of numbers to a list of ranges or a single range.
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
35 If ALWAYS-LIST is non-nil, this function will always release a list of
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
36 ranges. [range.el]"
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
37 (let* ((first (car numbers))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
38 (last (car numbers))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
39 result)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
40 (if (null numbers)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
41 nil
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
42 (if (not (listp (cdr numbers)))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
43 numbers
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
44 (while numbers
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
45 (cond ((= last (car numbers)) nil) ;Omit duplicated number
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
46 ((= (1+ last) (car numbers)) ;Still in sequence
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
47 (setq last (car numbers)))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
48 (t ;End of one sequence
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
49 (setq result
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
50 (cons (if (= first last) first
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
51 (cons first last)) result))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
52 (setq first (car numbers))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
53 (setq last (car numbers))))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
54 (setq numbers (cdr numbers)))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
55 (if (and (not always-list) (null result))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
56 (if (= first last) (list first) (cons first last))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
57 (nreverse (cons (if (= first last) first (cons first last))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
58 result)))))))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
59
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
60 (defun expand-range (range)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
61 "Expand a range into a list of numbers. [range.el]"
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
62 (cond ((numberp range)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
63 range)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
64 ((numberp (cdr range))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
65 (index (car range)(cdr range))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
66 )
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
67 (t
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
68 (let (dest ret)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
69 (mapcar (function
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
70 (lambda (sec)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
71 (setq ret (expand-range sec))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
72 (setq dest
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
73 (nconc dest
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
74 (if (and (listp ret)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
75 (listp (cdr ret)))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
76 ret
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
77 (list ret)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
78 )))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
79 ))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
80 range)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
81 dest))))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
82
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
83 (defun member-of-range (number range)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
84 "Return t if NUMBER is a member of RANGE. [range.el]"
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
85 (cond ((numberp range)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
86 (= number range)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
87 )
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
88 ((numberp (cdr range))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
89 (and (<= (car range) number)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
90 (<= number (cdr range))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
91 )
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
92 )
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
93 (t
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
94 (catch 'tag
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
95 (while range
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
96 (if (member-of-range number (car range))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
97 (throw 'tag t)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
98 )
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
99 (setq range (cdr range))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
100 ))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
101 )))
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
102
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
103
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
104 ;;; @ end
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
105 ;;;
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
106
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
107 (provide 'range)
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
108
b82b59fe008d Import from CVS: tag r19-15b3
cvs
parents:
diff changeset
109 ;;; range.el ends here