Mercurial > emacs
annotate lisp/emacs-lisp/ring.el @ 911:e18a3f6689a9
entered into RCS
author | Roland McGrath <roland@gnu.org> |
---|---|
date | Mon, 03 Aug 1992 16:41:27 +0000 |
parents | 48e4034a2176 |
children | dbdccee84df3 |
rev | line source |
---|---|
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
1 ;;; ring.el --- handle rings of marks |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
2 |
846
20674ae6bf52
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
811
diff
changeset
|
3 ;; Copyright (C) 1992 Free Software Foundation, Inc. |
20674ae6bf52
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
811
diff
changeset
|
4 |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
5 ;; Maintainer: FSF |
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
6 ;; Keywords: extensions |
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
7 |
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
8 ;; This file is part of GNU Emacs. |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
9 |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
11 ;; it under the terms of the GNU General Public License as published by |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
13 ;; any later version. |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
14 |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
15 ;; GNU Emacs is distributed in the hope that it will be useful, |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
18 ;; GNU General Public License for more details. |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
19 |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
20 ;; You should have received a copy of the GNU General Public License |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
23 |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
24 ;;; Commentary: |
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
25 |
124 | 26 ;;; This code defines a ring data structure. A ring is a |
27 ;;; (hd-index tl-index . vector) | |
28 ;;; list. You can insert to, remove from, and rotate a ring. When the ring | |
29 ;;; fills up, insertions cause the oldest elts to be quietly dropped. | |
30 ;;; | |
31 ;;; HEAD = index of the newest item on the ring. | |
32 ;;; TAIL = index of the oldest item on the ring. | |
33 ;;; | |
34 ;;; These functions are used by the input history mechanism, but they can | |
35 ;;; be used for other purposes as well. | |
36 | |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
37 ;;; Code: |
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
38 |
905 | 39 (provide 'ring) |
124 | 40 |
905 | 41 ;;;###autoload |
124 | 42 (defun ring-p (x) |
43 "T if X is a ring; NIL otherwise." | |
44 (and (consp x) (integerp (car x)) | |
45 (consp (cdr x)) (integerp (car (cdr x))) | |
46 (vectorp (cdr (cdr x))))) | |
47 | |
905 | 48 ;;;###autoload |
124 | 49 (defun make-ring (size) |
905 | 50 "Make a ring that can contain SIZE elts." |
124 | 51 (cons 1 (cons 0 (make-vector (+ size 1) nil)))) |
52 | |
53 (defun ring-plus1 (index veclen) | |
54 "INDEX+1, with wraparound" | |
55 (let ((new-index (+ index 1))) | |
56 (if (= new-index veclen) 0 new-index))) | |
57 | |
58 (defun ring-minus1 (index veclen) | |
59 "INDEX-1, with wraparound" | |
60 (- (if (= 0 index) veclen index) 1)) | |
61 | |
62 (defun ring-length (ring) | |
63 "Number of elts in the ring." | |
64 (let ((hd (car ring)) (tl (car (cdr ring))) (siz (length (cdr (cdr ring))))) | |
65 (let ((len (if (<= hd tl) (+ 1 (- tl hd)) (+ 1 tl (- siz hd))))) | |
66 (if (= len siz) 0 len)))) | |
67 | |
68 (defun ring-empty-p (ring) | |
69 (= 0 (ring-length ring))) | |
70 | |
71 (defun ring-insert (ring item) | |
72 "Insert a new item onto the ring. If the ring is full, dump the oldest | |
73 item to make room." | |
74 (let* ((vec (cdr (cdr ring))) (len (length vec)) | |
75 (new-hd (ring-minus1 (car ring) len))) | |
76 (setcar ring new-hd) | |
77 (aset vec new-hd item) | |
78 (if (ring-empty-p ring) ;overflow -- dump one off the tail. | |
79 (setcar (cdr ring) (ring-minus1 (car (cdr ring)) len))))) | |
80 | |
81 (defun ring-remove (ring) | |
82 "Remove the oldest item retained on the ring." | |
83 (if (ring-empty-p ring) (error "Ring empty") | |
84 (let ((tl (car (cdr ring))) (vec (cdr (cdr ring)))) | |
905 | 85 (setcar (cdr ring) (ring-minus1 tl (length vec))) |
124 | 86 (aref vec tl)))) |
87 | |
88 ;;; This isn't actually used in this package. I just threw it in in case | |
89 ;;; someone else wanted it. If you want rotating-ring behavior on your history | |
90 ;;; retrieval (analagous to kill ring behavior), this function is what you | |
91 ;;; need. I should write the yank-input and yank-pop-input-or-kill to go with | |
92 ;;; this, and not bind it to a key by default, so it would be available to | |
93 ;;; people who want to bind it to a key. But who would want it? Blech. | |
94 (defun ring-rotate (ring n) | |
95 (if (not (= n 0)) | |
96 (if (ring-empty-p ring) ;Is this the right error check? | |
97 (error "ring empty") | |
98 (let ((hd (car ring)) (tl (car (cdr ring))) (vec (cdr (cdr ring)))) | |
99 (let ((len (length vec))) | |
100 (while (> n 0) | |
101 (setq tl (ring-plus1 tl len)) | |
102 (aset ring tl (aref ring hd)) | |
103 (setq hd (ring-plus1 hd len)) | |
104 (setq n (- n 1))) | |
105 (while (< n 0) | |
106 (setq hd (ring-minus1 hd len)) | |
107 (aset vec hd (aref vec tl)) | |
108 (setq tl (ring-minus1 tl len)) | |
109 (setq n (- n 1)))) | |
905 | 110 (setcar ring hd) |
111 (setcar (cdr ring) tl))))) | |
124 | 112 |
905 | 113 (defun ring-mod (n m) |
245 | 114 "Returns N mod M. M is positive. |
115 Answer is guaranteed to be non-negative, and less than m." | |
124 | 116 (let ((n (% n m))) |
117 (if (>= n 0) n | |
118 (+ n | |
119 (if (>= m 0) m (- m)))))) ; (abs m) | |
120 | |
121 (defun ring-ref (ring index) | |
122 (let ((numelts (ring-length ring))) | |
123 (if (= numelts 0) (error "indexed empty ring") | |
124 (let* ((hd (car ring)) (tl (car (cdr ring))) (vec (cdr (cdr ring))) | |
905 | 125 (index (ring-mod index numelts)) |
126 (vec-index (ring-mod (+ index hd) (length vec)))) | |
124 | 127 (aref vec vec-index))))) |
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
128 |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
245
diff
changeset
|
129 ;;; ring.el ends here |