;;; -*- Mode:LISP; -*-

(herald DATABASE)

;;; File hacking if on TOPS-20
(eval-when (eval compile load)
  (cond ((status feature TOPS-20)
	 (putprop 'teach  '(ps kmp/.teach) 'ppn))))

;;; Outside functional declarations
(declare (*lexpr bug sysread)
	 (*expr time:print-current-time)
	 (special *database-new-filename*
		  *database-old-filename*
		  *database-temp-filename*
		  *novice-flag*))

;;; Macro support
(eval-when (eval compile)
  (load '((teach) macro)))

;;; Base setup
(eval-when (eval compile load)
  (setq base 10. ibase 10.))

;;; IOTA snarfing (from BREAK, BREAK1)
(eval-when (eval compile)
  (cond ((not (status feature iota))
	 (load '((liblsp) iota fasl)))))


;; get the properties associated with an old user from the file
;; ((teach) USERID db) and initialize various user information 
;; from this file. if there is a file for this user, he's not 
;; considered a novice.

(defvar *user-status-information* nil)

(defun load-props ()
  (setq *user-status-information* 
	(cond ((probef *database-old-filename*)
	       (setq *novice-flag* nil)
	       (iota ((stream *database-old-filename* '(in ascii dsk)))
		 (sysread stream)))
	      (t (setq *novice-flag* t)
		 (ncons nil)))))

;; write the properties that the user has set for himself out
;; to some file for use in the user's next TEACH-LISP session.

(defun save-props ()
  (iota ((stream *database-temp-filename* '(out ascii dsk)))
    (format stream ";;; -*- Mode:LISP; -*-~
 		    ~%;;; TEACH.~A saved user database for ~A~
 	            ~%;;; Created ~A by ~A~2%"
	    (or (get 'teach 'version) 0)
	    (status userid)
	    (time:print-current-time nil)
	    (status uname))
    (print *user-status-information* stream)
    (cond ((status feature its)
	   (renamef stream *database-new-filename*))
	  (t
	   (let ((name (truename stream)))
	     (close stream)
	     (renamef name *database-new-filename*))))))

;; functions for getting information out of the database.

(defun prop (propname &optional (default nil))
  (do ((plist (plist *user-status-information*)
	      (cddr plist)))
      ((null plist) default)
    (if (eq (car plist) propname)
	(return (cadr plist)))))

(defun set-prop (propname value)
   (putprop *user-status-information* value propname)
   (save-props)
   value)

(defun rem-prop (propname)
  (remprop *user-status-information* propname)
  (save-props)
  nil)

;;; Function to note in our database that explanation about a particular
;;; type of error has been seen.

(defun explanation-has-been-seen (name)
  (let ((seen (prop 'seen)))
    (if (not (memq name seen))
	(set-prop 'seen (cons name seen)))))
      
(defun seen-explanation? (name)
  (let ((seen (prop 'seen)))
    (cond ((memq name seen) t)
	  (t nil))))
      

;;; Function to note in our database that a lesson has been completed.

(defun lesson-has-been-seen (name)
  (let ((seen (prop 'lessons-seen)))
    (if (not (memq name seen))
	(set-prop 'lessons-seen (cons name seen)))))

(defun seen-lesson? (name)
  (let ((seen (prop 'lessons-seen)))
    (cond ((memq name seen) t)
	  (t nil))))
      


;;; Local Modes:;
;;; Mode:LISP;
;;; Comment Column:50;
;;; End:;