cgit.sxemacs.org Git - packages/blob - xemacs-packages/tm/range.el

   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 1998-01-14 06:27:57 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