lisp/emacs-lisp/ring.el

   1 ;;; ring.el --- handle rings of marks
   2
   3 ;; Maintainer: FSF
   4 ;; Last-Modified: 22 Apr 1991
   5 ;; Keywords: extensions
   6
   7 ;; Copyright (C) 1992 Free Software Foundation, Inc.
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; This code defines a ring data structure. A ring is a
  28 ;;;     (hd-index tl-index . vector)
  29 ;;; list. You can insert to, remove from, and rotate a ring. When the ring
  30 ;;; fills up, insertions cause the oldest elts to be quietly dropped.
  31 ;;;
  32 ;;; HEAD = index of the newest item on the ring.
  33 ;;; TAIL = index of the oldest item on the ring.
  34 ;;;
  35 ;;; These functions are used by the input history mechanism, but they can
  36 ;;; be used for other purposes as well.
  37
  38 ;;; Code:
  39
  40 (provide 'history)
  41
  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 (defun make-ring (size)
  49   "Make a ring that can contain SIZE elts"
  50   (cons 1 (cons 0 (make-vector (+ size 1) nil))))
  51
  52 (defun ring-plus1 (index veclen)
  53   "INDEX+1, with wraparound"
  54   (let ((new-index (+ index 1)))
  55     (if (= new-index veclen) 0 new-index)))
  56
  57 (defun ring-minus1 (index veclen)
  58   "INDEX-1, with wraparound"
  59   (- (if (= 0 index) veclen index) 1))
  60
  61 (defun ring-length (ring)
  62   "Number of elts in the ring."
  63   (let ((hd (car ring)) (tl (car (cdr ring)))  (siz (length (cdr (cdr ring)))))
  64     (let ((len (if (<= hd tl) (+ 1 (- tl hd)) (+ 1 tl (- siz hd)))))
  65       (if (= len siz) 0 len))))
  66
  67 (defun ring-empty-p (ring)
  68   (= 0 (ring-length ring)))
  69
  70 (defun ring-insert (ring item)
  71   "Insert a new item onto the ring. If the ring is full, dump the oldest
  72 item to make room."
  73   (let* ((vec (cdr (cdr ring)))  (len (length vec))
  74          (new-hd (ring-minus1 (car ring) len)))
  75       (setcar ring new-hd)
  76       (aset vec new-hd item)
  77       (if (ring-empty-p ring) ;overflow -- dump one off the tail.
  78           (setcar (cdr ring) (ring-minus1 (car (cdr ring)) len)))))
  79
  80 (defun ring-remove (ring)
  81   "Remove the oldest item retained on the ring."
  82   (if (ring-empty-p ring) (error "Ring empty")
  83       (let ((tl (car (cdr ring)))  (vec (cdr (cdr ring))))
  84         (set-car (cdr ring) (ring-minus1 tl (length vec)))
  85         (aref vec tl))))
  86
  87 ;;; This isn't actually used in this package. I just threw it in in case
  88 ;;; someone else wanted it. If you want rotating-ring behavior on your history
  89 ;;; retrieval (analagous to kill ring behavior), this function is what you
  90 ;;; need. I should write the yank-input and yank-pop-input-or-kill to go with
  91 ;;; this, and not bind it to a key by default, so it would be available to
  92 ;;; people who want to bind it to a key. But who would want it? Blech.
  93 (defun ring-rotate (ring n)
  94   (if (not (= n 0))
  95       (if (ring-empty-p ring) ;Is this the right error check?
  96           (error "ring empty")
  97           (let ((hd (car ring))  (tl (car (cdr ring)))  (vec (cdr (cdr ring))))
  98             (let ((len (length vec)))
  99               (while (> n 0)
 100                 (setq tl (ring-plus1 tl len))
 101                 (aset ring tl (aref ring hd))
 102                 (setq hd (ring-plus1 hd len))
 103                 (setq n (- n 1)))
 104               (while (< n 0)
 105                 (setq hd (ring-minus1 hd len))
 106                 (aset vec hd (aref vec tl))
 107                 (setq tl (ring-minus1 tl len))
 108                 (setq n (- n 1))))
 109             (set-car ring hd)
 110             (set-car (cdr ring) tl)))))
 111
 112 (defun comint-mod (n m)
 113   "Returns N mod M.  M is positive.
 114 Answer is guaranteed to be non-negative, and less than m."
 115   (let ((n (% n m)))
 116     (if (>= n 0) n
 117         (+ n
 118            (if (>= m 0) m (- m)))))) ; (abs m)
 119
 120 (defun ring-ref (ring index)
 121   (let ((numelts (ring-length ring)))
 122     (if (= numelts 0) (error "indexed empty ring")
 123         (let* ((hd (car ring))  (tl (car (cdr ring)))  (vec (cdr (cdr ring)))
 124                (index (comint-mod index numelts))
 125                (vec-index (comint-mod (+ index hd)
 126                                       (length vec))))
 127           (aref vec vec-index)))))
 128
 129 ;;; ring.el ends here