diff options
| author | Richard M. Stallman | 1999-08-30 23:57:22 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1999-08-30 23:57:22 +0000 |
| commit | 7263dc568d8ff89d638d40c1d69158ba2a247c2a (patch) | |
| tree | fca009c7fa62e798161562cb09ce75c1b658604d | |
| parent | 81fe0ce9f3a85c2e4800eeb5265d263d74a10463 (diff) | |
| download | emacs-7263dc568d8ff89d638d40c1d69158ba2a247c2a.tar.gz emacs-7263dc568d8ff89d638d40c1d69158ba2a247c2a.zip | |
Many doc fixes.
(ring-size, ring-copy): New functions.
| -rw-r--r-- | lisp/emacs-lisp/ring.el | 96 |
1 files changed, 64 insertions, 32 deletions
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el index 7067cf70dbb..f871526a296 100644 --- a/lisp/emacs-lisp/ring.el +++ b/lisp/emacs-lisp/ring.el | |||
| @@ -24,8 +24,8 @@ | |||
| 24 | 24 | ||
| 25 | ;;; Commentary: | 25 | ;;; Commentary: |
| 26 | 26 | ||
| 27 | ;; This code defines a ring data structure. A ring is a | 27 | ;; This code defines a ring data structure. A ring is a |
| 28 | ;; (hd-index length . vector) | 28 | ;; (hd-index length . vector) |
| 29 | ;; list. You can insert to, remove from, and rotate a ring. When the ring | 29 | ;; list. You can insert to, remove from, and rotate a ring. When the ring |
| 30 | ;; fills up, insertions cause the oldest elts to be quietly dropped. | 30 | ;; fills up, insertions cause the oldest elts to be quietly dropped. |
| 31 | ;; | 31 | ;; |
| @@ -35,17 +35,29 @@ | |||
| 35 | ;; | 35 | ;; |
| 36 | ;; hd-index = vector index of the oldest ring item. | 36 | ;; hd-index = vector index of the oldest ring item. |
| 37 | ;; Newer items follow this item; at the end of the vector, | 37 | ;; Newer items follow this item; at the end of the vector, |
| 38 | ;; they wrap around to the start of the vector. | 38 | ;; they wrap around to the start of the vector. |
| 39 | ;; length = number of items currently in the ring. | 39 | ;; length = number of items currently in the ring. |
| 40 | ;; This never exceeds the length of the vector itself. | 40 | ;; This never exceeds the length of the vector itself. |
| 41 | ;; | 41 | ;; |
| 42 | ;; These functions are used by the input history mechanism, but they can | 42 | ;; These functions are used by the input history mechanism, but they can |
| 43 | ;; be used for other purposes as well. | 43 | ;; be used for other purposes as well. |
| 44 | 44 | ||
| 45 | ;;; Change Log: | ||
| 46 | |||
| 47 | ;; Sun Aug 22 12:58:54 1999 Kevin Blake <kblake@ticnet.com> | ||
| 48 | ;; * Added the `ring-size' and `ring-copy' functions. Added documentation | ||
| 49 | to | ||
| 50 | ;; the `ring-empty-p' and `ring-index' functions. Enhanced the | ||
| 51 | documentation | ||
| 52 | ;; of several functions. Added comments to the layout of this module to | ||
| 53 | ;; make things more obvious. | ||
| 54 | |||
| 45 | ;;; Code: | 55 | ;;; Code: |
| 46 | 56 | ||
| 57 | ;;; User Functions: | ||
| 58 | |||
| 47 | ;;;###autoload | 59 | ;;;###autoload |
| 48 | (defun ring-p (x) | 60 | (defun ring-p (x) |
| 49 | "Returns t if X is a ring; nil otherwise." | 61 | "Returns t if X is a ring; nil otherwise." |
| 50 | (and (consp x) (integerp (car x)) | 62 | (and (consp x) (integerp (car x)) |
| 51 | (consp (cdr x)) (integerp (car (cdr x))) | 63 | (consp (cdr x)) (integerp (car (cdr x))) |
| @@ -58,48 +70,66 @@ | |||
| 58 | 70 | ||
| 59 | (defun ring-insert-at-beginning (ring item) | 71 | (defun ring-insert-at-beginning (ring item) |
| 60 | "Add to RING the item ITEM. Add it at the front, as the oldest item." | 72 | "Add to RING the item ITEM. Add it at the front, as the oldest item." |
| 61 | (let* ((vec (cdr (cdr ring))) | 73 | (let* ((vec (cdr (cdr ring))) |
| 62 | (veclen (length vec)) | 74 | (veclen (length vec)) |
| 63 | (hd (car ring)) | 75 | (hd (car ring)) |
| 64 | (ln (car (cdr ring)))) | 76 | (ln (car (cdr ring)))) |
| 65 | (setq ln (min veclen (1+ ln)) | 77 | (setq ln (min veclen (1+ ln)) |
| 66 | hd (ring-minus1 hd veclen)) | 78 | hd (ring-minus1 hd veclen)) |
| 67 | (aset vec hd item) | 79 | (aset vec hd item) |
| 68 | (setcar ring hd) | 80 | (setcar ring hd) |
| 69 | (setcar (cdr ring) ln))) | 81 | (setcar (cdr ring) ln))) |
| 70 | 82 | ||
| 71 | (defun ring-plus1 (index veclen) | 83 | (defun ring-plus1 (index veclen) |
| 72 | "INDEX+1, with wraparound." | 84 | "Returns INDEX+1, with wraparound." |
| 73 | (let ((new-index (+ index 1))) | 85 | (let ((new-index (+ index 1))) |
| 74 | (if (= new-index veclen) 0 new-index))) | 86 | (if (= new-index veclen) 0 new-index))) |
| 75 | 87 | ||
| 76 | (defun ring-minus1 (index veclen) | 88 | (defun ring-minus1 (index veclen) |
| 77 | "INDEX-1, with wraparound." | 89 | "Returns INDEX-1, with wraparound." |
| 78 | (- (if (= 0 index) veclen index) 1)) | 90 | (- (if (= 0 index) veclen index) 1)) |
| 79 | 91 | ||
| 80 | (defun ring-length (ring) | 92 | (defun ring-length (ring) |
| 81 | "Number of elements in the ring RING." | 93 | "Returns the number of elements in the RING." |
| 82 | (car (cdr ring))) | 94 | (car (cdr ring))) |
| 83 | 95 | ||
| 84 | (defun ring-empty-p (ring) | ||
| 85 | (= 0 (car (cdr ring)))) | ||
| 86 | |||
| 87 | (defun ring-index (index head ringlen veclen) | 96 | (defun ring-index (index head ringlen veclen) |
| 97 | "Converts nominal ring index INDEX to an internal index. | ||
| 98 | The internal index refers to the items ordered from newest to oldest. | ||
| 99 | HEAD is the index of the oldest element in the ring. | ||
| 100 | RINGLEN is the number of elements currently in the ring. | ||
| 101 | VECLEN is the size of the vector in the ring." | ||
| 88 | (setq index (mod index ringlen)) | 102 | (setq index (mod index ringlen)) |
| 89 | (mod (1- (+ head (- ringlen index))) veclen)) | 103 | (mod (1- (+ head (- ringlen index))) veclen)) |
| 90 | 104 | ||
| 105 | (defun ring-empty-p (ring) | ||
| 106 | "Returns t if RING is empty; nil otherwise." | ||
| 107 | (= 0 (car (cdr ring)))) | ||
| 108 | |||
| 109 | (defun ring-size (ring) | ||
| 110 | "Returns the size of RING, the maximum number of elements it can contain." | ||
| 111 | (length (cdr (cdr ring)))) | ||
| 112 | |||
| 113 | (defun ring-copy (ring) | ||
| 114 | "Returns a copy of RING." | ||
| 115 | (let* | ||
| 116 | ((vec (cdr (cdr ring))) | ||
| 117 | (hd (car ring)) | ||
| 118 | (ln (car (cdr ring)))) | ||
| 119 | (cons hd (cons ln (copy-sequence vec))))) | ||
| 120 | |||
| 91 | (defun ring-insert (ring item) | 121 | (defun ring-insert (ring item) |
| 92 | "Insert onto ring RING the item ITEM, as the newest (last) item. | 122 | "Insert onto ring RING the item ITEM, as the newest (last) item. |
| 93 | If the ring is full, dump the oldest item to make room." | 123 | If the ring is full, dump the oldest item to make room." |
| 94 | (let* ((vec (cdr (cdr ring))) | 124 | (let* ((vec (cdr (cdr ring))) |
| 95 | (veclen (length vec)) | 125 | (veclen (length vec)) |
| 96 | (hd (car ring)) | 126 | (hd (car ring)) |
| 97 | (ln (car (cdr ring)))) | 127 | (ln (car (cdr ring)))) |
| 98 | (prog1 | 128 | (prog1 |
| 99 | (aset vec (mod (+ hd ln) veclen) item) | 129 | (aset vec (mod (+ hd ln) veclen) item) |
| 100 | (if (= ln veclen) | 130 | (if (= ln veclen) |
| 101 | (setcar ring (ring-plus1 hd veclen)) | 131 | (setcar ring (ring-plus1 hd veclen)) |
| 102 | (setcar (cdr ring) (1+ ln)))))) | 132 | (setcar (cdr ring) (1+ ln)))))) |
| 103 | 133 | ||
| 104 | (defun ring-remove (ring &optional index) | 134 | (defun ring-remove (ring &optional index) |
| 105 | "Remove an item from the RING. Return the removed item. | 135 | "Remove an item from the RING. Return the removed item. |
| @@ -108,18 +138,18 @@ numeric, remove the element indexed." | |||
| 108 | (if (ring-empty-p ring) | 138 | (if (ring-empty-p ring) |
| 109 | (error "Ring empty") | 139 | (error "Ring empty") |
| 110 | (let* ((hd (car ring)) | 140 | (let* ((hd (car ring)) |
| 111 | (ln (car (cdr ring))) | 141 | (ln (car (cdr ring))) |
| 112 | (vec (cdr (cdr ring))) | 142 | (vec (cdr (cdr ring))) |
| 113 | (veclen (length vec)) | 143 | (veclen (length vec)) |
| 114 | (tl (mod (1- (+ hd ln)) veclen)) | 144 | (tl (mod (1- (+ hd ln)) veclen)) |
| 115 | oldelt) | 145 | oldelt) |
| 116 | (if (null index) | 146 | (if (null index) |
| 117 | (setq index (1- ln))) | 147 | (setq index (1- ln))) |
| 118 | (setq index (ring-index index hd ln veclen)) | 148 | (setq index (ring-index index hd ln veclen)) |
| 119 | (setq oldelt (aref vec index)) | 149 | (setq oldelt (aref vec index)) |
| 120 | (while (/= index tl) | 150 | (while (/= index tl) |
| 121 | (aset vec index (aref vec (ring-plus1 index veclen))) | 151 | (aset vec index (aref vec (ring-plus1 index veclen))) |
| 122 | (setq index (ring-plus1 index veclen))) | 152 | (setq index (ring-plus1 index veclen))) |
| 123 | (aset vec tl nil) | 153 | (aset vec tl nil) |
| 124 | (setcar (cdr ring) (1- ln)) | 154 | (setcar (cdr ring) (1- ln)) |
| 125 | oldelt))) | 155 | oldelt))) |
| @@ -135,6 +165,8 @@ will be performed." | |||
| 135 | (let* ((hd (car ring)) (ln (car (cdr ring))) (vec (cdr (cdr ring)))) | 165 | (let* ((hd (car ring)) (ln (car (cdr ring))) (vec (cdr (cdr ring)))) |
| 136 | (aref vec (ring-index index hd ln (length vec)))))) | 166 | (aref vec (ring-index index hd ln (length vec)))))) |
| 137 | 167 | ||
| 168 | ;;; provide ourself: | ||
| 169 | |||
| 138 | (provide 'ring) | 170 | (provide 'ring) |
| 139 | 171 | ||
| 140 | ;;; ring.el ends here | 172 | ;;; ring.el ends here |