RE: ring.el patch: new functions member, next, previous, convert-sequence etc.

["Drew Adams" <drew.adams@oracle.com>]

[-- Attachment #1: Type: text/plain, Size: 810 bytes --]

> From: Drew Adams Sent: Monday, October 08, 2007 3:25 PM
> The attached patch to ring.el provides these new functions:
> `ring-convert-sequence-to-ring',
> `ring-insert+extend', `ring-remove+insert+extend',
> `ring-member', `ring-next', `ring-previous'

Sorry; I meant to send the patch, not the patched file - see attached.

> Change log:
> 
> 2007-10-08  Drew Adams  <drew.adams@oracle.com>
> 
>   * ring.el: Added functions
>     ring-convert-sequence-to-ring, ring-insert+extend,
>     ring-remove+insert+extend, ring-member, ring-next,
>     ring-previous

Here's the Change log in standard format (IIUC):

2007-10-08  Drew Adams  <drew.adams@oracle.com>

	* ring.el (ring-convert-sequence-to-ring, ring-insert+extend,
	ring-remove+insert+extend, ring-member, ring-next, ring-previous):
	New functions.
	

[-- Attachment #2: ring-2007-10-08a.patch --]
[-- Type: application/octet-stream, Size: 3466 bytes --]

*** ring-2007-10-08a.el	Mon Oct  8 15:13:08 2007
--- ring-patched-2007-10-08a.el	Mon Oct  8 15:12:26 2007
***************
*** 164,169 ****
--- 164,241 ----
      (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)

Diff finished at Mon Oct 08 15:13:28

[-- Attachment #3: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel