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
|