X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/7d5989e14aacad4aa0775339dab645db80ab7144..73b0cd50031a714347109169ceb8bacae338612a:/lisp/emacs-lisp/ring.el

diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index a259d2ba51..affaa9ce32 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -1,17 +1,16 @@
 ;;; ring.el --- handle rings of items
 
-;; Copyright (C) 1992, 2001, 2002, 2003, 2004, 2005,
-;;   2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 2001-2011 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: extensions
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +18,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -51,8 +48,8 @@
 (defun ring-p (x)
   "Return t if X is a ring; nil otherwise."
   (and (consp x) (integerp (car x))
-       (consp (cdr x)) (integerp (car (cdr x)))
-       (vectorp (cdr (cdr x)))))
+       (consp (cdr x)) (integerp (cadr x))
+       (vectorp (cddr x))))
 
 ;;;###autoload
 (defun make-ring (size)
@@ -60,11 +57,11 @@
   (cons 0 (cons 0 (make-vector size nil))))
 
 (defun ring-insert-at-beginning (ring item)
-  "Add to RING the item ITEM.  Add it at the front, as the oldest item."
-  (let* ((vec (cdr (cdr ring)))
+  "Add to RING the item ITEM, at the front, as the oldest item."
+  (let* ((vec (cddr ring))
          (veclen (length vec))
          (hd (car ring))
-         (ln (car (cdr ring))))
+         (ln (cadr ring)))
     (setq ln (min veclen (1+ ln))
           hd (ring-minus1 hd veclen))
     (aset vec hd item)
@@ -73,16 +70,16 @@
 
 (defun ring-plus1 (index veclen)
   "Return INDEX+1, with wraparound."
-  (let ((new-index (+ index 1)))
+  (let ((new-index (1+ index)))
     (if (= new-index veclen) 0 new-index)))
 
 (defun ring-minus1 (index veclen)
   "Return INDEX-1, with wraparound."
-  (- (if (= 0 index) veclen index) 1))
+  (- (if (zerop index) veclen index) 1))
 
 (defun ring-length (ring)
   "Return the number of elements in the RING."
-  (car (cdr ring)))
+  (cadr ring))
 
 (defun ring-index (index head ringlen veclen)
   "Convert nominal ring index INDEX to an internal index.
@@ -95,26 +92,26 @@ VECLEN is the size of the vector in the ring."
 
 (defun ring-empty-p (ring)
   "Return t if RING is empty; nil otherwise."
-  (zerop (car (cdr ring))))
+  (zerop (cadr ring)))
 
 (defun ring-size (ring)
   "Return the size of RING, the maximum number of elements it can contain."
-  (length (cdr (cdr ring))))
+  (length (cddr ring)))
 
 (defun ring-copy (ring)
   "Return a copy of RING."
-  (let* ((vec (cdr (cdr ring)))
-	 (hd  (car ring))
-	 (ln  (car (cdr ring))))
+  (let ((vec (cddr ring))
+	(hd  (car ring))
+	(ln  (cadr ring)))
     (cons hd (cons ln (copy-sequence vec)))))
 
 (defun ring-insert (ring item)
   "Insert onto ring RING the item ITEM, as the newest (last) item.
 If the ring is full, dump the oldest item to make room."
-  (let* ((vec (cdr (cdr ring)))
+  (let* ((vec (cddr ring))
          (veclen (length vec))
          (hd (car ring))
-         (ln (car (cdr ring))))
+         (ln (cadr ring)))
     (prog1
         (aset vec (mod (+ hd ln) veclen) item)
       (if (= ln veclen)
@@ -128,13 +125,13 @@ numeric, remove the element indexed."
   (if (ring-empty-p ring)
       (error "Ring empty")
     (let* ((hd (car ring))
-           (ln (car (cdr ring)))
-           (vec (cdr (cdr ring)))
+           (ln (cadr ring))
+           (vec (cddr ring))
            (veclen (length vec))
            (tl (mod (1- (+ hd ln)) veclen))
            oldelt)
-      (if (null index)
-          (setq index (1- ln)))
+      (when (null index)
+	(setq index (1- ln)))
       (setq index (ring-index index hd ln veclen))
       (setq oldelt (aref vec index))
       (while (/= index tl)
@@ -152,7 +149,9 @@ INDEX need not be <= the ring length; the appropriate modulo operation
 will be performed."
   (if (ring-empty-p ring)
       (error "Accessing an empty ring")
-    (let* ((hd (car ring))  (ln (car (cdr ring)))  (vec (cdr (cdr ring))))
+    (let ((hd (car ring))
+	  (ln (cadr ring))
+	  (vec (cddr ring)))
       (aref vec (ring-index index hd ln (length vec))))))
 
 (defun ring-elements (ring)
@@ -164,9 +163,76 @@ will be performed."
     (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 is done via `equal'.  The index is 0-based."
+  (catch 'found
+    (dotimes (ind (ring-length ring) nil)
+      (when (equal item (ring-ref ring ind))
+	(throw 'found 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 (cddr 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)))
+      (dotimes (count size)
+        (when (or (ring-empty-p ring)
+		  (not (equal (ring-ref ring 0) (elt seq count))))
+	  (ring-insert-at-beginning ring (elt seq count))))
+      ring)))
+
 ;;; provide ourself:
 
 (provide 'ring)
 
-;;; arch-tag: e707682b-ed69-47c9-b20f-cf2c68cc92d2
 ;;; ring.el ends here