Mercurial > hg > xemacs-beta
diff lisp/tl/range.el @ 4:b82b59fe008d r19-15b3
Import from CVS: tag r19-15b3
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:46:56 +0200 |
parents | |
children | 4b173ad71786 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/tl/range.el Mon Aug 13 08:46:56 2007 +0200 @@ -0,0 +1,109 @@ +;;; range.el --- range functions + +;; Copyright (C) 1987 .. 1996 Free Software Foundation, Inc. + +;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> +;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no> +;; MORIOKA Tomohiko <morioka@jaist.ac.jp> +;; Version: +;; $Id: range.el,v 1.1.1.1 1996/12/18 03:55:31 steve Exp $ +;; Keywords: range + +;; This file is part of tl (Tiny Library). + +;; This program 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. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with This program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +;; These functions were imported from September Gnus 0.40. + +(defun compress-sorted-numbers (numbers &optional always-list) + "Convert list of numbers to a list of ranges or a single range. +If ALWAYS-LIST is non-nil, this function will always release a list of +ranges. [range.el]" + (let* ((first (car numbers)) + (last (car numbers)) + result) + (if (null numbers) + nil + (if (not (listp (cdr numbers))) + numbers + (while numbers + (cond ((= last (car numbers)) nil) ;Omit duplicated number + ((= (1+ last) (car numbers)) ;Still in sequence + (setq last (car numbers))) + (t ;End of one sequence + (setq result + (cons (if (= first last) first + (cons first last)) result)) + (setq first (car numbers)) + (setq last (car numbers)))) + (setq numbers (cdr numbers))) + (if (and (not always-list) (null result)) + (if (= first last) (list first) (cons first last)) + (nreverse (cons (if (= first last) first (cons first last)) + result))))))) + +(defun expand-range (range) + "Expand a range into a list of numbers. [range.el]" + (cond ((numberp range) + range) + ((numberp (cdr range)) + (index (car range)(cdr range)) + ) + (t + (let (dest ret) + (mapcar (function + (lambda (sec) + (setq ret (expand-range sec)) + (setq dest + (nconc dest + (if (and (listp ret) + (listp (cdr ret))) + ret + (list ret) + ))) + )) + range) + dest)))) + +(defun member-of-range (number range) + "Return t if NUMBER is a member of RANGE. [range.el]" + (cond ((numberp range) + (= number range) + ) + ((numberp (cdr range)) + (and (<= (car range) number) + (<= number (cdr range)) + ) + ) + (t + (catch 'tag + (while range + (if (member-of-range number (car range)) + (throw 'tag t) + ) + (setq range (cdr range)) + )) + ))) + + +;;; @ end +;;; + +(provide 'range) + +;;; range.el ends here