.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