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