4105a3a8e5b5aec1e4c0ecd2474a08469f2e4b7d
[emacs.git] / .emacs.d / elisp / icicle / ring+.el
1 ;;; ring+.el --- Extensions to `ring.el'.
2 ;;
3 ;; Filename: ring+.el
4 ;; Description: Extensions to `ring.el'.
5 ;; Author: Drew Adams
6 ;; Maintainer: Drew Adams
7 ;; Copyright (C) 1996-2012, Drew Adams, all rights reserved.
8 ;; Created: Thu Apr 11 16:46:04 1996
9 ;; Version: 21.0
10 ;; Last-Updated: Sun Jan 1 14:05:12 2012 (-0800)
11 ;; By: dradams
12 ;; Update #: 212
13 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/ring+.el
14 ;; Keywords: extensions, lisp, emacs-lisp
15 ;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x
16 ;;
17 ;; Features that might be required by this library:
18 ;;
19 ;; `ring'.
20 ;;
21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
22 ;;
23 ;;; Commentary:
24 ;;
25 ;; Extensions to `ring.el'.
26 ;;
27 ;; Main new functions here:
28 ;;
29 ;; `ring-convert-sequence-to-ring', `ring-insert+extend',
30 ;; `ring-remove+insert+extend', `ring-member', `ring-next',
31 ;; `ring-previous'.
32 ;;
33 ;;
34 ;; This file should be loaded after loading the standard GNU file
35 ;; `ring.el'. So, in your `~/.emacs' file, do this:
36 ;; (eval-after-load "ring" '(progn (require 'ring+))
37 ;;
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39 ;;
40 ;;; Change Log:
41 ;;
42 ;; 2011/01/04 dadams
43 ;; Removed autoload cookies (non-interactive commands).
44 ;; 2004/09/26 dadams
45 ;; Renamed convert-sequence-to-ring to ring-convert-sequence-to-ring
46 ;; 2004/09/08 dadams
47 ;; Reversed argument order: ring-member, ring-next, ring-previous.
48 ;; 2004/09/04 dadams
49 ;; Added: convert-sequence-to-ring, ring-insert+extend.
50 ;;
51 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
52 ;;
53 ;; This program is free software; you can redistribute it and/or modify
54 ;; it under the terms of the GNU General Public License as published by
55 ;; the Free Software Foundation; either version 2, or (at your option)
56 ;; any later version.
57
58 ;; This program is distributed in the hope that it will be useful,
59 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
60 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
61 ;; GNU General Public License for more details.
62
63 ;; You should have received a copy of the GNU General Public License
64 ;; along with this program; see the file COPYING. If not, write to
65 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
66 ;; Floor, Boston, MA 02110-1301, USA.
67 ;;
68 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
69 ;;
70 ;;; Code:
71
72 (require 'ring) ;; ring-length, ring-ref, ring-remove, ring-insert
73
74 ;;;;;;;;;;;;;;;;;
75
76
77 (defun ring-member (ring item)
78 "Return index of ITEM if on RING, else nil. Comparison via `equal'.
79 The index is 0-based."
80 (let ((ind 0)
81 (len (1- (ring-length ring)))
82 (memberp nil))
83 (while (and (<= ind len)
84 (not (setq memberp (equal item (ring-ref ring ind)))))
85 (setq ind (1+ ind)))
86 (and memberp ind)))
87
88 (defun ring-next (ring item)
89 "Return the next item in the RING, after ITEM.
90 Raise error if ITEM is not in the RING."
91 (let ((curr-index (ring-member ring item)))
92 (unless curr-index (error "Item is not in the ring: `%s'" item))
93 (ring-ref ring (ring-plus1 curr-index (ring-length ring)))))
94
95 (defun ring-previous (ring item)
96 "Return the previous item in the RING, before ITEM.
97 Raise error if ITEM is not in the RING."
98 (let ((curr-index (ring-member ring item)))
99 (unless curr-index (error "Item is not in the ring: `%s'" item))
100 (ring-ref ring (ring-minus1 curr-index (ring-length ring)))))
101
102
103 (defun ring-insert+extend (ring item &optional grow-p)
104 "Like ring-insert, but if GROW-P is non-nil, then enlarge ring.
105 Insert onto ring RING the item ITEM, as the newest (last) item.
106 If the ring is full, behavior depends on GROW-P:
107 If GROW-P is non-nil, enlarge the ring to accommodate the new item.
108 If GROW-P is nil, dump the oldest item to make room for the new."
109 (let* ((vec (cdr (cdr ring)))
110 (veclen (length vec))
111 (hd (car ring))
112 (ringlen (ring-length ring)))
113 (prog1
114 (cond ((and grow-p (= ringlen veclen)) ; Full ring. Enlarge it.
115 (setq veclen (1+ veclen))
116 (setcdr ring (cons (setq ringlen (1+ ringlen))
117 (setq vec (vconcat vec (vector item)))))
118 (setcar ring hd))
119 (t (aset vec (mod (+ hd ringlen) veclen) item)))
120 (if (= ringlen veclen)
121 (setcar ring (ring-plus1 hd veclen))
122 (setcar (cdr ring) (1+ ringlen))))))
123
124 (defun ring-remove+insert+extend (ring item &optional grow-p)
125 "`ring-remove' ITEM from RING, then `ring-insert+extend' it.
126 This ensures that there is only one ITEM on RING.
127
128 If the RING is full, behavior depends on GROW-P:
129 If GROW-P is non-nil, enlarge the ring to accommodate the new ITEM.
130 If GROW-P is nil, dump the oldest item to make room for the new."
131 (let (ind)
132 (while (setq ind (ring-member ring item)) (ring-remove ring ind)))
133 (ring-insert+extend ring item grow-p))
134
135 (defun ring-convert-sequence-to-ring (seq)
136 "Convert sequence SEQ to a ring. Return the ring.
137 If SEQ is already a ring, return it."
138 (if (ring-p seq)
139 seq
140 (let* ((size (length seq))
141 (ring (make-ring size))
142 (count 0))
143 (while (< count size)
144 (if (or (ring-empty-p ring)
145 (not (equal (ring-ref ring 0) (elt seq count))))
146 (ring-insert-at-beginning ring (elt seq count)))
147 (setq count (1+ count)))
148 ring)))
149
150 ;;;;;;;;;;;;;;;;;;;;;;;
151
152 (provide 'ring+)
153
154 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
155 ;;; ring+.el ends here