lisp/emacs-lisp/ring.el

   1 ;;; ring.el --- handle rings of items
   2
   3 ;; Copyright (C) 1992 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: FSF
   6 ;; Keywords: extensions
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;;; This code defines a ring data structure. A ring is a
  27 ;;;     (hd-index tl-index . vector)
  28 ;;; list. You can insert to, remove from, and rotate a ring. When the ring
  29 ;;; fills up, insertions cause the oldest elts to be quietly dropped.
  30 ;;;
  31 ;;; In ring-ref, 0 is the index of the newest element.  Higher indexes
  32 ;;; correspond to older elements until they wrap.
  33 ;;;
  34 ;;; HEAD = index of the newest item on the ring.
  35 ;;; TAIL = index of the oldest item on the ring.
  36 ;;;
  37 ;;; These functions are used by the input history mechanism, but they can
  38 ;;; be used for other purposes as well.
  39
  40 ;;; Code:
  41
  42 ;;;###autoload
  43 (defun ring-p (x)
  44   "Returns t if X is a ring; nil otherwise."
  45   (and (consp x) (integerp (car x))
  46        (consp (cdr x)) (integerp (car (cdr x)))
  47        (vectorp (cdr (cdr x)))))
  48
  49 ;;;###autoload
  50 (defun make-ring (size)
  51   "Make a ring that can contain SIZE elements."
  52   (cons 1 (cons 0 (make-vector (+ size 1) nil))))
  53
  54 (defun ring-plus1 (index veclen)
  55   "INDEX+1, with wraparound"
  56   (let ((new-index (+ index 1)))
  57     (if (= new-index veclen) 0 new-index)))
  58
  59 (defun ring-minus1 (index veclen)
  60   "INDEX-1, with wraparound"
  61   (- (if (= 0 index) veclen index) 1))
  62
  63 (defun ring-length (ring)
  64   "Number of elements in the ring."
  65   (let ((hd (car ring)) (tl (car (cdr ring)))  (siz (length (cdr (cdr ring)))))
  66     (let ((len (if (<= hd tl) (+ 1 (- tl hd)) (+ 1 tl (- siz hd)))))
  67       (if (= len siz) 0 len))))
  68
  69 (defun ring-empty-p (ring)
  70   (= 0 (ring-length ring)))
  71
  72 (defun ring-insert (ring item)
  73   "Insert a new item onto the ring. If the ring is full, dump the oldest
  74 item to make room."
  75   (let* ((vec (cdr (cdr ring)))  (len (length vec))
  76          (new-hd (ring-minus1 (car ring) len)))
  77       (setcar ring new-hd)
  78       (aset vec new-hd item)
  79       (if (ring-empty-p ring) ;overflow -- dump one off the tail.
  80           (setcar (cdr ring) (ring-minus1 (car (cdr ring)) len)))))
  81
  82 (defun ring-remove (ring)
  83   "Remove the oldest item retained on the ring."
  84   (if (ring-empty-p ring) (error "Ring empty")
  85       (let ((tl (car (cdr ring)))  (vec (cdr (cdr ring))))
  86         (setcar (cdr ring) (ring-minus1 tl (length vec)))
  87         (aref vec tl))))
  88
  89 (defun ring-mod (n m)
  90   "Returns N mod M.  M is positive.
  91 Answer is guaranteed to be non-negative, and less than m."
  92   (let ((n (% n m)))
  93     (if (>= n 0) n
  94         (+ n
  95            (if (>= m 0) m (- m)))))) ; (abs m)
  96
  97 (defun ring-ref (ring index)
  98   "Returns RING's INDEX element.
  99 INDEX need not be <= the ring length, the appropriate modulo operation
 100 will be performed.  Element 0 is the most recently inserted; higher indices
 101 correspond to older elements until they wrap."
 102   (let ((numelts (ring-length ring)))
 103     (if (= numelts 0) (error "indexed empty ring")
 104         (let* ((hd (car ring))  (tl (car (cdr ring)))  (vec (cdr (cdr ring)))
 105                (index (ring-mod index numelts))
 106                (vec-index (ring-mod (+ index hd) (length vec))))
 107           (aref vec vec-index)))))
 108
 109 (provide 'ring)
 110
 111 ;;; ring.el ends here