lisp/emacs-lisp/ring.el

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