Mercurial > emacs
changeset 85305:e1264e487a97
(ring-convert-sequence-to-ring)
(ring-insert+extend, ring-remove+insert+extend, ring-member)
(ring-next, ring-previous): New functions.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sun, 14 Oct 2007 22:52:59 +0000 |
parents | 070315abf3d9 |
children | 69156b1b3ee0 |
files | lisp/emacs-lisp/ring.el |
diffstat | 1 files changed, 72 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/emacs-lisp/ring.el Sun Oct 14 22:49:39 2007 +0000 +++ b/lisp/emacs-lisp/ring.el Sun Oct 14 22:52:59 2007 +0000 @@ -164,6 +164,78 @@ (dotimes (var (cadr ring) lst) (push (aref vect (mod (+ start var) size)) lst)))) +(defun ring-member (ring item) + "Return index of ITEM if on RING, else nil. Comparison via `equal'. +The index is 0-based." + (let ((ind 0) + (len (1- (ring-length ring))) + (memberp nil)) + (while (and (<= ind len) + (not (setq memberp (equal item (ring-ref ring ind))))) + (setq ind (1+ ind))) + (and memberp ind))) + +(defun ring-next (ring item) + "Return the next item in the RING, after ITEM. +Raise error if ITEM is not in the RING." + (let ((curr-index (ring-member ring item))) + (unless curr-index (error "Item is not in the ring: `%s'" item)) + (ring-ref ring (ring-plus1 curr-index (ring-length ring))))) + +(defun ring-previous (ring item) + "Return the previous item in the RING, before ITEM. +Raise error if ITEM is not in the RING." + (let ((curr-index (ring-member ring item))) + (unless curr-index (error "Item is not in the ring: `%s'" item)) + (ring-ref ring (ring-minus1 curr-index (ring-length ring))))) + +(defun ring-insert+extend (ring item &optional grow-p) + "Like ring-insert, but if GROW-P is non-nil, then enlarge ring. +Insert onto ring RING the item ITEM, as the newest (last) item. +If the ring is full, behavior depends on GROW-P: + If GROW-P is non-nil, enlarge the ring to accommodate the new item. + If GROW-P is nil, dump the oldest item to make room for the new." + (let* ((vec (cdr (cdr ring))) + (veclen (length vec)) + (hd (car ring)) + (ringlen (ring-length ring))) + (prog1 + (cond ((and grow-p (= ringlen veclen)) ; Full ring. Enlarge it. + (setq veclen (1+ veclen)) + (setcdr ring (cons (setq ringlen (1+ ringlen)) + (setq vec (vconcat vec (vector item))))) + (setcar ring hd)) + (t (aset vec (mod (+ hd ringlen) veclen) item))) + (if (= ringlen veclen) + (setcar ring (ring-plus1 hd veclen)) + (setcar (cdr ring) (1+ ringlen)))))) + +(defun ring-remove+insert+extend (ring item &optional grow-p) + "`ring-remove' ITEM from RING, then `ring-insert+extend' it. +This ensures that there is only one ITEM on RING. + +If the RING is full, behavior depends on GROW-P: + If GROW-P is non-nil, enlarge the ring to accommodate the new ITEM. + If GROW-P is nil, dump the oldest item to make room for the new." + (let (ind) + (while (setq ind (ring-member ring item)) (ring-remove ring ind))) + (ring-insert+extend ring item grow-p)) + +(defun ring-convert-sequence-to-ring (seq) + "Convert sequence SEQ to a ring. Return the ring. +If SEQ is already a ring, return it." + (if (ring-p seq) + seq + (let* ((size (length seq)) + (ring (make-ring size)) + (count 0)) + (while (< count size) + (if (or (ring-empty-p ring) + (not (equal (ring-ref ring 0) (elt seq count)))) + (ring-insert-at-beginning ring (elt seq count))) + (setq count (1+ count))) + ring))) + ;;; provide ourself: (provide 'ring)