;|!|;;;; XLISP-STAT 2.1 Copyright (c) 1990-1997, by Luke Tierney
;|!|;;;; Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz
;|!|;;;; You may give out copies of this software; for conditions see the file
;|!|;;;; COPYING included with this distribution.
;|!|
(in-package "XLISP")

(export '(register-saver unregister-saver
          register-restorer unregister-restorer))

(defvar *saver-table* (make-hash-table))
(defvar *restorer-table* (make-hash-table))
;|!|
(defun register-saver (arg fun)
  (setf (gethash arg *saver-table*) fun))

(defun unregister-saver (arg)
  (remhash arg *saver-table*))
;|!|
(defun register-restorer (arg fun)
  (setf (gethash arg *restorer-table*) fun))

(defun unregister-restorer (arg)
  (remhash arg *restorer-table*))
;|!|
(defun save-workspace (name)
  (dolist (h (copy-list *hardware-objects*))
    (send (third h) :remove))
  (maphash #'(lambda (arg fun) (funcall fun arg)) *saver-table*)
  (save name)
  (exit))
;|!|
(defun run-restorers ()
  (maphash #'(lambda (arg fun) (funcall fun arg)) *restorer-table*))
;|!|
(unless (member 'run-restorers *startup-functions*)
        (setf *startup-functions*
              (append *startup-functions* '(run-restorers))))