LCOV - code coverage report
Current view: top level - lisp/emacs-lisp - ring.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 2 100 2.0 %
Date: 2017-08-27 09:44:50 Functions: 2 21 9.5 %

          Line data    Source code
       1             : ;;; ring.el --- handle rings of items   -*- lexical-binding: t; -*-
       2             : 
       3             : ;; Copyright (C) 1992, 2001-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Maintainer: emacs-devel@gnu.org
       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 3 of the License, or
      13             : ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
      22             : 
      23             : ;;; Commentary:
      24             : 
      25             : ;; This code defines a ring data structure.  A ring is a
      26             : ;;     (hd-index length . vector)
      27             : ;; list.  You can insert to, remove from, and rotate a ring.  When the ring
      28             : ;; fills up, insertions cause the oldest elts to be quietly dropped.
      29             : ;;
      30             : ;; In ring-ref, 0 is the index of the newest element.  Higher indexes
      31             : ;; correspond to older elements; when the index equals the ring length,
      32             : ;; it wraps to the newest element again.
      33             : ;;
      34             : ;; hd-index = vector index of the oldest ring item.
      35             : ;;         Newer items follow this item; at the end of the vector,
      36             : ;;         they wrap around to the start of the vector.
      37             : ;; length = number of items currently in the ring.
      38             : ;;         This never exceeds the length of the vector itself.
      39             : ;;
      40             : ;; These functions are used by the input history mechanism, but they can
      41             : ;; be used for other purposes as well.
      42             : 
      43             : ;;; Code:
      44             : 
      45             : ;;; User Functions:
      46             : 
      47             : ;;;###autoload
      48             : (defun ring-p (x)
      49             :   "Return t if X is a ring; nil otherwise."
      50           0 :   (and (consp x) (integerp (car x))
      51           0 :        (consp (cdr x)) (integerp (cadr x))
      52           0 :        (vectorp (cddr x))))
      53             : 
      54             : ;;;###autoload
      55             : (defun make-ring (size)
      56             :   "Make a ring that can contain SIZE elements."
      57          11 :   (cons 0 (cons 0 (make-vector size nil))))
      58             : 
      59             : (defun ring-insert-at-beginning (ring item)
      60             :   "Add to RING the item ITEM, at the front, as the oldest item."
      61           0 :   (let* ((vec (cddr ring))
      62           0 :          (veclen (length vec))
      63           0 :          (hd (car ring))
      64           0 :          (ln (cadr ring)))
      65           0 :     (setq ln (min veclen (1+ ln))
      66           0 :           hd (ring-minus1 hd veclen))
      67           0 :     (aset vec hd item)
      68           0 :     (setcar ring hd)
      69           0 :     (setcar (cdr ring) ln)))
      70             : 
      71             : (defun ring-plus1 (index veclen)
      72             :   "Return INDEX+1, with wraparound."
      73           0 :   (let ((new-index (1+ index)))
      74           0 :     (if (= new-index veclen) 0 new-index)))
      75             : 
      76             : (defun ring-minus1 (index veclen)
      77             :   "Return INDEX-1, with wraparound."
      78           0 :   (- (if (zerop index) veclen index) 1))
      79             : 
      80             : (defun ring-length (ring)
      81             :   "Return the number of elements in the RING."
      82           0 :   (cadr ring))
      83             : 
      84             : (defun ring-index (index head ringlen veclen)
      85             :   "Convert nominal ring index INDEX to an internal index.
      86             : The internal index refers to the items ordered from newest to oldest.
      87             : HEAD is the index of the oldest element in the ring.
      88             : RINGLEN is the number of elements currently in the ring.
      89             : VECLEN is the size of the vector in the ring."
      90           0 :   (setq index (mod index ringlen))
      91           0 :   (mod (1- (+ head (- ringlen index))) veclen))
      92             : 
      93             : (defun ring-empty-p (ring)
      94             :   "Return t if RING is empty; nil otherwise."
      95          11 :   (zerop (cadr ring)))
      96             : 
      97             : (defun ring-size (ring)
      98             :   "Return the size of RING, the maximum number of elements it can contain."
      99           0 :   (length (cddr ring)))
     100             : 
     101             : (defun ring-copy (ring)
     102             :   "Return a copy of RING."
     103           0 :   (let ((vec (cddr ring))
     104           0 :         (hd  (car ring))
     105           0 :         (ln  (cadr ring)))
     106           0 :     (cons hd (cons ln (copy-sequence vec)))))
     107             : 
     108             : (defun ring-insert (ring item)
     109             :   "Insert onto ring RING the item ITEM, as the newest (last) item.
     110             : If the ring is full, dump the oldest item to make room."
     111           0 :   (let* ((vec (cddr ring))
     112           0 :          (veclen (length vec))
     113           0 :          (hd (car ring))
     114           0 :          (ln (cadr ring)))
     115           0 :     (prog1
     116           0 :         (aset vec (mod (+ hd ln) veclen) item)
     117           0 :       (if (= ln veclen)
     118           0 :           (setcar ring (ring-plus1 hd veclen))
     119           0 :         (setcar (cdr ring) (1+ ln))))))
     120             : 
     121             : (defun ring-remove (ring &optional index)
     122             :   "Remove an item from the RING.  Return the removed item.
     123             : If optional INDEX is nil, remove the oldest item.  If it's
     124             : numeric, remove the element indexed."
     125           0 :   (if (ring-empty-p ring)
     126           0 :       (error "Ring empty")
     127           0 :     (let* ((hd (car ring))
     128           0 :            (ln (cadr ring))
     129           0 :            (vec (cddr ring))
     130           0 :            (veclen (length vec))
     131           0 :            (tl (mod (1- (+ hd ln)) veclen))
     132             :            oldelt)
     133           0 :       (when (null index)
     134           0 :         (setq index (1- ln)))
     135           0 :       (setq index (ring-index index hd ln veclen))
     136           0 :       (setq oldelt (aref vec index))
     137           0 :       (while (/= index tl)
     138           0 :         (aset vec index (aref vec (ring-plus1 index veclen)))
     139           0 :         (setq index (ring-plus1 index veclen)))
     140           0 :       (aset vec tl nil)
     141           0 :       (setcar (cdr ring) (1- ln))
     142           0 :       oldelt)))
     143             : 
     144             : (defun ring-ref (ring index)
     145             :   "Return RING's INDEX element.
     146             : INDEX = 0 is the most recently inserted; higher indices
     147             : correspond to older elements.
     148             : INDEX need not be <= the ring length; the appropriate modulo operation
     149             : will be performed."
     150           0 :   (if (ring-empty-p ring)
     151           0 :       (error "Accessing an empty ring")
     152           0 :     (let ((hd (car ring))
     153           0 :           (ln (cadr ring))
     154           0 :           (vec (cddr ring)))
     155           0 :       (aref vec (ring-index index hd ln (length vec))))))
     156             : 
     157             : (defun ring-elements (ring)
     158             :   "Return a list of the elements of RING, in order, newest first."
     159           0 :   (let ((start (car ring))
     160           0 :         (size (ring-size ring))
     161           0 :         (vect (cddr ring))
     162             :         lst)
     163           0 :     (dotimes (var (cadr ring))
     164           0 :       (push (aref vect (mod (+ start var) size)) lst))
     165           0 :     lst))
     166             : 
     167             : (defun ring-member (ring item)
     168             :   "Return index of ITEM if on RING, else nil.
     169             : Comparison is done via `equal'.  The index is 0-based."
     170           0 :   (catch 'found
     171           0 :     (dotimes (ind (ring-length ring))
     172           0 :       (when (equal item (ring-ref ring ind))
     173           0 :         (throw 'found ind)))))
     174             : 
     175             : (defun ring-next (ring item)
     176             :   "Return the next item in the RING, after ITEM.
     177             : Raise error if ITEM is not in the RING."
     178           0 :   (let ((curr-index (ring-member ring item)))
     179           0 :     (unless curr-index (error "Item is not in the ring: `%s'" item))
     180           0 :     (ring-ref ring (ring-plus1 curr-index (ring-length ring)))))
     181             : 
     182             : (defun ring-previous (ring item)
     183             :   "Return the previous item in the RING, before ITEM.
     184             : Raise error if ITEM is not in the RING."
     185           0 :   (let ((curr-index (ring-member ring item)))
     186           0 :     (unless curr-index (error "Item is not in the ring: `%s'" item))
     187           0 :     (ring-ref ring (ring-minus1 curr-index (ring-length ring)))))
     188             : 
     189             : (defun ring-extend (ring x)
     190             :   "Increase the size of RING by X."
     191           0 :   (when (and (integerp x) (> x 0))
     192           0 :     (let* ((hd       (car ring))
     193           0 :            (length   (ring-length ring))
     194           0 :            (size     (ring-size ring))
     195           0 :            (old-vec  (cddr ring))
     196           0 :            (new-vec  (make-vector (+ size x) nil)))
     197           0 :       (setcdr ring (cons length new-vec))
     198             :       ;; If the ring is wrapped, the existing elements must be written
     199             :       ;; out in the right order.
     200           0 :       (dotimes (j length)
     201           0 :         (aset new-vec j (aref old-vec (mod (+ hd j) size))))
     202           0 :       (setcar ring 0))))
     203             : 
     204             : (defun ring-insert+extend (ring item &optional grow-p)
     205             :   "Like `ring-insert', but if GROW-P is non-nil, then enlarge ring.
     206             : Insert onto ring RING the item ITEM, as the newest (last) item.
     207             : If the ring is full, behavior depends on GROW-P:
     208             :   If GROW-P is non-nil, enlarge the ring to accommodate the new item.
     209             :   If GROW-P is nil, dump the oldest item to make room for the new."
     210           0 :   (and grow-p
     211           0 :        (= (ring-length ring) (ring-size ring))
     212           0 :        (ring-extend ring 1))
     213           0 :   (ring-insert ring item))
     214             : 
     215             : (defun ring-remove+insert+extend (ring item &optional grow-p)
     216             :   "`ring-remove' ITEM from RING, then `ring-insert+extend' it.
     217             : This ensures that there is only one ITEM on RING.
     218             : 
     219             : If the RING is full, behavior depends on GROW-P:
     220             :   If GROW-P is non-nil, enlarge the ring to accommodate the new ITEM.
     221             :   If GROW-P is nil, dump the oldest item to make room for the new."
     222           0 :   (let (ind)
     223           0 :     (while (setq ind (ring-member ring item))
     224           0 :       (ring-remove ring ind)))
     225           0 :   (ring-insert+extend ring item grow-p))
     226             : 
     227             : (defun ring-convert-sequence-to-ring (seq)
     228             :   "Convert sequence SEQ to a ring.  Return the ring.
     229             : If SEQ is already a ring, return it."
     230           0 :   (if (ring-p seq)
     231           0 :       seq
     232           0 :     (let* ((size (length seq))
     233           0 :            (ring (make-ring size)))
     234           0 :       (dotimes (count size)
     235           0 :         (when (or (ring-empty-p ring)
     236           0 :                   (not (equal (ring-ref ring 0) (elt seq count))))
     237           0 :           (ring-insert-at-beginning ring (elt seq count))))
     238           0 :       ring)))
     239             : 
     240             : ;;; provide ourself:
     241             : 
     242             : (provide 'ring)
     243             : 
     244             : ;;; ring.el ends here

Generated by: LCOV version 1.12