Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
73183f2b
Commit
73183f2b
authored
Aug 02, 1992
by
Richard M. Stallman
Browse files
entered into RCS
parent
594722a8
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
10 additions
and
9 deletions
+10
-9
lisp/emacs-lisp/ring.el
lisp/emacs-lisp/ring.el
+10
-9
No files found.
lisp/emacs-lisp/ring.el
View file @
73183f2b
...
...
@@ -36,16 +36,18 @@
;;; Code:
(
provide
'
history
)
(
provide
'
ring
)
;;;###autoload
(
defun
ring-p
(
x
)
"T if X is a ring; NIL otherwise."
(
and
(
consp
x
)
(
integerp
(
car
x
))
(
consp
(
cdr
x
))
(
integerp
(
car
(
cdr
x
)))
(
vectorp
(
cdr
(
cdr
x
)))))
;;;###autoload
(
defun
make-ring
(
size
)
"Make a ring that can contain SIZE elts"
"Make a ring that can contain SIZE elts
.
"
(
cons
1
(
cons
0
(
make-vector
(
+
size
1
)
nil
))))
(
defun
ring-plus1
(
index
veclen
)
...
...
@@ -80,7 +82,7 @@ item to make room."
"Remove the oldest item retained on the ring."
(
if
(
ring-empty-p
ring
)
(
error
"Ring empty"
)
(
let
((
tl
(
car
(
cdr
ring
)))
(
vec
(
cdr
(
cdr
ring
))))
(
set
-
car
(
cdr
ring
)
(
ring-minus1
tl
(
length
vec
)))
(
setcar
(
cdr
ring
)
(
ring-minus1
tl
(
length
vec
)))
(
aref
vec
tl
))))
;;; This isn't actually used in this package. I just threw it in in case
...
...
@@ -105,10 +107,10 @@ item to make room."
(
aset
vec
hd
(
aref
vec
tl
))
(
setq
tl
(
ring-minus1
tl
len
))
(
setq
n
(
-
n
1
))))
(
set
-
car
ring
hd
)
(
set
-
car
(
cdr
ring
)
tl
)))))
(
setcar
ring
hd
)
(
setcar
(
cdr
ring
)
tl
)))))
(
defun
com
in
t
-mod
(
n
m
)
(
defun
r
in
g
-mod
(
n
m
)
"Returns N mod M. M is positive.
Answer is guaranteed to be non-negative, and less than m."
(
let
((
n
(
%
n
m
)))
...
...
@@ -120,9 +122,8 @@ Answer is guaranteed to be non-negative, and less than m."
(
let
((
numelts
(
ring-length
ring
)))
(
if
(
=
numelts
0
)
(
error
"indexed empty ring"
)
(
let*
((
hd
(
car
ring
))
(
tl
(
car
(
cdr
ring
)))
(
vec
(
cdr
(
cdr
ring
)))
(
index
(
comint-mod
index
numelts
))
(
vec-index
(
comint-mod
(
+
index
hd
)
(
length
vec
))))
(
index
(
ring-mod
index
numelts
))
(
vec-index
(
ring-mod
(
+
index
hd
)
(
length
vec
))))
(
aref
vec
vec-index
)))))
;;; ring.el ends here
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment