code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/ring.el

   1 ;;; ring.el --- handle rings of marks
   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 ;;; HEAD = index of the newest item on the ring.
  32 ;;; TAIL = index of the oldest item on the ring.
  33 ;;;
  34 ;;; These functions are used by the input history mechanism, but they can
  35 ;;; be used for other purposes as well.
  36
  37 ;;; Code:
  38
  39 (provide 'ring)
  40
  41 ;;;###autoload
  42 (defun ring-p (x)
  43   "T if X is a ring; NIL otherwise."
  44   (and (consp x) (integerp (car x))
  45        (consp (cdr x)) (integerp (car (cdr x)))
  46        (vectorp (cdr (cdr x)))))
  47
  48 ;;;###autoload
  49 (defun make-ring (size)
  50   "Make a ring that can contain SIZE elts."
  51   (cons 1 (cons 0 (make-vector (+ size 1) nil))))
  52
  53 (defun ring-plus1 (index veclen)
  54   "INDEX+1, with wraparound"
  55   (let ((new-index (+ index 1)))
  56     (if (= new-index veclen) 0 new-index)))
  57
  58 (defun ring-minus1 (index veclen)
  59   "INDEX-1, with wraparound"
  60   (- (if (= 0 index) veclen index) 1))
  61
  62 (defun ring-length (ring)
  63   "Number of elts in the ring."
  64   (let ((hd (car ring)) (tl (car (cdr ring)))  (siz (length (cdr (cdr ring)))))
  65     (let ((len (if (<= hd tl) (+ 1 (- tl hd)) (+ 1 tl (- siz hd)))))
  66       (if (= len siz) 0 len))))
  67
  68 (defun ring-empty-p (ring)
  69   (= 0 (ring-length ring)))
  70
  71 (defun ring-insert (ring item)
  72   "Insert a new item onto the ring. If the ring is full, dump the oldest
  73 item to make room."
  74   (let* ((vec (cdr (cdr ring)))  (len (length vec))
  75          (new-hd (ring-minus1 (car ring) len)))
  76       (setcar ring new-hd)
  77       (aset vec new-hd item)
  78       (if (ring-empty-p ring) ;overflow -- dump one off the tail.
  79           (setcar (cdr ring) (ring-minus1 (car (cdr ring)) len)))))
  80
  81 (defun ring-remove (ring)
  82   "Remove the oldest item retained on the ring."
  83   (if (ring-empty-p ring) (error "Ring empty")
  84       (let ((tl (car (cdr ring)))  (vec (cdr (cdr ring))))
  85         (setcar (cdr ring) (ring-minus1 tl (length vec)))
  86         (aref vec tl))))
  87
  88 ;;; This isn't actually used in this package. I just threw it in in case
  89 ;;; someone else wanted it. If you want rotating-ring behavior on your history
  90 ;;; retrieval (analagous to kill ring behavior), this function is what you
  91 ;;; need. I should write the yank-input and yank-pop-input-or-kill to go with
  92 ;;; this, and not bind it to a key by default, so it would be available to
  93 ;;; people who want to bind it to a key. But who would want it? Blech.
  94 (defun ring-rotate (ring n)
  95   (if (not (= n 0))
  96       (if (ring-empty-p ring) ;Is this the right error check?
  97           (error "ring empty")
  98           (let ((hd (car ring))  (tl (car (cdr ring)))  (vec (cdr (cdr ring))))
  99             (let ((len (length vec)))
 100               (while (> n 0)
 101                 (setq tl (ring-plus1 tl len))
 102                 (aset ring tl (aref ring hd))
 103                 (setq hd (ring-plus1 hd len))
 104                 (setq n (- n 1)))
 105               (while (< n 0)
 106                 (setq hd (ring-minus1 hd len))
 107                 (aset vec hd (aref vec tl))
 108                 (setq tl (ring-minus1 tl len))
 109                 (setq n (- n 1))))
 110             (setcar ring hd)
 111             (setcar (cdr ring) tl)))))
 112
 113 (defun ring-mod (n m)
 114   "Returns N mod M.  M is positive.
 115 Answer is guaranteed to be non-negative, and less than m."
 116   (let ((n (% n m)))
 117     (if (>= n 0) n
 118         (+ n
 119            (if (>= m 0) m (- m)))))) ; (abs m)
 120
 121 (defun ring-ref (ring index)
 122   (let ((numelts (ring-length ring)))
 123     (if (= numelts 0) (error "indexed empty ring")
 124         (let* ((hd (car ring))  (tl (car (cdr ring)))  (vec (cdr (cdr ring)))
 125                (index (ring-mod index numelts))
 126                (vec-index (ring-mod (+ index hd) (length vec))))
 127           (aref vec vec-index)))))
 128
 129 ;;; ring.el ends here