Mercurial > emacs
comparison lisp/emacs-lisp/ring.el @ 124:27691d738b4f
Initial revision
author | David Lawrence <tale@gnu.org> |
---|---|
date | Wed, 21 Nov 1990 20:01:35 +0000 |
parents | |
children | b8930c9c15ee |
comparison
equal
deleted
inserted
replaced
123:1af8a4d8f39f | 124:27691d738b4f |
---|---|
1 ;;; Ring Code | |
2 ;;;============================================================================ | |
3 ;;; This code defines a ring data structure. A ring is a | |
4 ;;; (hd-index tl-index . vector) | |
5 ;;; list. You can insert to, remove from, and rotate a ring. When the ring | |
6 ;;; fills up, insertions cause the oldest elts to be quietly dropped. | |
7 ;;; | |
8 ;;; HEAD = index of the newest item on the ring. | |
9 ;;; TAIL = index of the oldest item on the ring. | |
10 ;;; | |
11 ;;; These functions are used by the input history mechanism, but they can | |
12 ;;; be used for other purposes as well. | |
13 | |
14 (provide 'history) | |
15 | |
16 (defun ring-p (x) | |
17 "T if X is a ring; NIL otherwise." | |
18 (and (consp x) (integerp (car x)) | |
19 (consp (cdr x)) (integerp (car (cdr x))) | |
20 (vectorp (cdr (cdr x))))) | |
21 | |
22 (defun make-ring (size) | |
23 "Make a ring that can contain SIZE elts" | |
24 (cons 1 (cons 0 (make-vector (+ size 1) nil)))) | |
25 | |
26 (defun ring-plus1 (index veclen) | |
27 "INDEX+1, with wraparound" | |
28 (let ((new-index (+ index 1))) | |
29 (if (= new-index veclen) 0 new-index))) | |
30 | |
31 (defun ring-minus1 (index veclen) | |
32 "INDEX-1, with wraparound" | |
33 (- (if (= 0 index) veclen index) 1)) | |
34 | |
35 (defun ring-length (ring) | |
36 "Number of elts in the ring." | |
37 (let ((hd (car ring)) (tl (car (cdr ring))) (siz (length (cdr (cdr ring))))) | |
38 (let ((len (if (<= hd tl) (+ 1 (- tl hd)) (+ 1 tl (- siz hd))))) | |
39 (if (= len siz) 0 len)))) | |
40 | |
41 (defun ring-empty-p (ring) | |
42 (= 0 (ring-length ring))) | |
43 | |
44 (defun ring-insert (ring item) | |
45 "Insert a new item onto the ring. If the ring is full, dump the oldest | |
46 item to make room." | |
47 (let* ((vec (cdr (cdr ring))) (len (length vec)) | |
48 (new-hd (ring-minus1 (car ring) len))) | |
49 (setcar ring new-hd) | |
50 (aset vec new-hd item) | |
51 (if (ring-empty-p ring) ;overflow -- dump one off the tail. | |
52 (setcar (cdr ring) (ring-minus1 (car (cdr ring)) len))))) | |
53 | |
54 (defun ring-remove (ring) | |
55 "Remove the oldest item retained on the ring." | |
56 (if (ring-empty-p ring) (error "Ring empty") | |
57 (let ((tl (car (cdr ring))) (vec (cdr (cdr ring)))) | |
58 (set-car (cdr ring) (ring-minus1 tl (length vec))) | |
59 (aref vec tl)))) | |
60 | |
61 ;;; This isn't actually used in this package. I just threw it in in case | |
62 ;;; someone else wanted it. If you want rotating-ring behavior on your history | |
63 ;;; retrieval (analagous to kill ring behavior), this function is what you | |
64 ;;; need. I should write the yank-input and yank-pop-input-or-kill to go with | |
65 ;;; this, and not bind it to a key by default, so it would be available to | |
66 ;;; people who want to bind it to a key. But who would want it? Blech. | |
67 (defun ring-rotate (ring n) | |
68 (if (not (= n 0)) | |
69 (if (ring-empty-p ring) ;Is this the right error check? | |
70 (error "ring empty") | |
71 (let ((hd (car ring)) (tl (car (cdr ring))) (vec (cdr (cdr ring)))) | |
72 (let ((len (length vec))) | |
73 (while (> n 0) | |
74 (setq tl (ring-plus1 tl len)) | |
75 (aset ring tl (aref ring hd)) | |
76 (setq hd (ring-plus1 hd len)) | |
77 (setq n (- n 1))) | |
78 (while (< n 0) | |
79 (setq hd (ring-minus1 hd len)) | |
80 (aset vec hd (aref vec tl)) | |
81 (setq tl (ring-minus1 tl len)) | |
82 (setq n (- n 1)))) | |
83 (set-car ring hd) | |
84 (set-car (cdr ring) tl))))) | |
85 | |
86 (defun comint-mod (n m) | |
87 "Returns N mod M. M is positive. Answer is guaranteed to be non-negative, | |
88 and less than m." | |
89 (let ((n (% n m))) | |
90 (if (>= n 0) n | |
91 (+ n | |
92 (if (>= m 0) m (- m)))))) ; (abs m) | |
93 | |
94 (defun ring-ref (ring index) | |
95 (let ((numelts (ring-length ring))) | |
96 (if (= numelts 0) (error "indexed empty ring") | |
97 (let* ((hd (car ring)) (tl (car (cdr ring))) (vec (cdr (cdr ring))) | |
98 (index (comint-mod index numelts)) | |
99 (vec-index (comint-mod (+ index hd) | |
100 (length vec)))) | |
101 (aref vec vec-index))))) |