57 lines
1.5 KiB
Scheme
57 lines
1.5 KiB
Scheme
|
(define-record-type history :history
|
||
|
|
(really-make-history first last)
|
||
|
|
history?
|
||
|
|
(first history-first set-history-first!)
|
||
|
|
(last history-last set-history-last!))
|
||
|
|
|
||
|
|
(define-record-type entry :entry
|
||
|
|
(make-entry data prev next)
|
||
|
|
entry?
|
||
|
|
(data entry-data)
|
||
|
|
(prev entry-prev set-entry-prev!)
|
||
|
|
(next entry-next set-entry-next!))
|
||
|
|
|
||
|
|
(define-record-discloser :entry
|
||
|
|
(lambda (r)
|
||
|
|
`(entry ,(entry-data r))))
|
||
|
|
|
||
|
|
(define (make-empty-history)
|
||
|
|
(really-make-history #f #f))
|
||
|
|
|
||
|
|
(define (append-history-item! history data)
|
||
|
|
(let ((new-entry (make-entry data (history-last history) #f)))
|
||
|
|
(cond
|
||
|
|
((history-last history)
|
||
|
|
=> (lambda (old-last)
|
||
|
|
(set-entry-next! old-last new-entry)
|
||
|
|
(set-history-last! history new-entry)))
|
||
|
|
(else
|
||
|
|
(set-history-first! history new-entry)
|
||
|
|
(set-history-last! history new-entry)))))
|
||
|
|
|
||
|
|
(define (insert-history-item! history entry data)
|
||
|
|
(cond
|
||
|
|
((and (entry-prev entry) (entry-next entry))
|
||
|
|
=> (lambda (next)
|
||
|
|
(let ((new-entry (make-entry data entry next)))
|
||
|
|
(set-entry-prev! next new-entry)
|
||
|
|
(set-entry-next! entry new-entry))))
|
||
|
|
((entry-prev entry)
|
||
|
|
(append-history-item! history data))
|
||
|
|
((entry-next entry)
|
||
|
|
=> (lambda (new-second)
|
||
|
|
(let ((new-first (make-entry data #f new-second)))
|
||
|
|
(set-history-first! history new-first)
|
||
|
|
(set-entry-prev! new-second new-first))))
|
||
|
|
(else
|
||
|
|
(append-history-item! history data))))
|
||
|
|
|
||
|
|
(define history-next-entry entry-next)
|
||
|
|
|
||
|
|
(define history-prev-entry entry-prev)
|
||
|
|
|
||
|
|
(define history-first-entry history-first)
|
||
|
|
|
||
|
|
(define history-last-entry history-last)
|
||
|
|
|