Mercurial > hg > xemacs-beta

comparison lisp/tl/range.el @ 4:b82b59fe008d r19-15b3

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