New org capture template
[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 (concat "drew.adams" "@" "oracle" ".com")
7 ;; Copyright (C) 1996-2014, Drew Adams, all rights reserved.
8 ;; Created: Thu Apr 11 16:46:04 1996
9 ;; Version: 0
10 ;; Last-Updated: Thu Dec 26 09:46:24 2013 (-0800)
11 ;; By: dradams
12 ;; Update #: 226
13 ;; URL: http://www.emacswiki.org/ring%2b.el
14 ;; Doc URL: http://emacswiki.org/RingPlus
15 ;; Keywords: extensions, lisp, emacs-lisp
16 ;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x
17 ;;
18 ;; Features that might be required by this library:
19 ;;
20 ;; `ring'.
21 ;;
22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23 ;;
24 ;;; Commentary:
25 ;;
26 ;; Extensions to `ring.el'.
27 ;;
28 ;; The code in this library is part of GNU Emacs 23 and later, so
29 ;; this library is useful only for releases prior to Emacs 23.
30 ;;
31 ;; Main new functions here:
32 ;;
33 ;; `ring-convert-sequence-to-ring', `ring-insert+extend',
34 ;; `ring-remove+insert+extend', `ring-member', `ring-next',
35 ;; `ring-previous'.
36 ;;
37 ;;
38 ;; This file should be loaded after loading the standard GNU file
39 ;; `ring.el'. So, in your `~/.emacs' file, do this:
40 ;; (eval-after-load "ring" '(progn (require 'ring+))
41 ;;
42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
43 ;;
44 ;;; Change Log:
45 ;;
46 ;; 2011/01/04 dadams
47 ;; Removed autoload cookies (non-interactive commands).
48 ;; 2004/09/26 dadams
49 ;; Renamed convert-sequence-to-ring to ring-convert-sequence-to-ring
50 ;; 2004/09/08 dadams
51 ;; Reversed argument order: ring-member, ring-next, ring-previous.
52 ;; 2004/09/04 dadams
53 ;; Added: convert-sequence-to-ring, ring-insert+extend.
54 ;;
55 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
56 ;;
57 ;; This program is free software; you can redistribute it and/or modify
58 ;; it under the terms of the GNU General Public License as published by
59 ;; the Free Software Foundation; either version 2, or (at your option)
60 ;; any later version.
61
62 ;; This program is distributed in the hope that it will be useful,
63 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
64 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
65 ;; GNU General Public License for more details.
66
67 ;; You should have received a copy of the GNU General Public License
68 ;; along with this program; see the file COPYING. If not, write to
69 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
70 ;; Floor, Boston, MA 02110-1301, USA.
71 ;;
72 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
73 ;;
74 ;;; Code:
75
76 (require 'ring) ;; ring-length, ring-ref, ring-remove, ring-insert
77
78 ;;;;;;;;;;;;;;;;;
79
80 (defun ring-member (ring item)
81 "Return index of ITEM if on RING, else nil.
82 Comparison is done via `equal'. The index is 0-based."
83 (catch 'found
84 (dotimes (ind (ring-length ring) nil)
85 (when (equal item (ring-ref ring ind))
86 (throw 'found 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