code for keeping command/result histories

scheme/history.scm

@@ -0,0 +1,56 @@
+(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)
+