update magit submodule
[emacs-init.git] / auto-install / 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-2011, Drew Adams, all rights reserved.
8 ;; Created: Thu Apr 11 16:46:04 1996
9 ;; Version: 21.0
10 ;; Last-Updated: Tue Jan  4 13:43:06 2011 (-0800)
11 ;;           By: dradams
12 ;;     Update #: 211
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