Added TEACH;TS XLISP -- teaches lisp.

Resolves #377.

src/teach/init.41

@@ -0,0 +1,155 @@
+;;; -*- Mode:LISP; -*-
+
+
+;;; Suppression of load messages
+
+(sstatus feature noldmsg)
+
+;;; Init bases
+;;;
+;;; Note: The most novice users should not be bothered by "." on the end of
+;;;       numbers. Something later may want to set up *NOPOINT NIL since it's
+;;;	  really the most useful setting, but would be confusing to novices.
+
+(setq base 10. ibase 10. *nopoint t)
+
+;;; Debugging
+
+(nouuo t)	; make tracing easy
+(*rset t)	; enable all the debugging lisp offers
+
+;;; File hacking if on TOPS-20
+(cond ((status feature TOPS-20)
+       (putprop 'teach '(ps kmp/.teach) 'ppn)))
+
+;;; Functions used to change TOPS-20 userid's to get rid of all
+;;; non-alphanumerics.
+
+(defun alpha-numeric? (char)
+  (or (and (not (< char #/0))
+	   (not (> char #/9)))
+      (and (not (< char #/A))
+	   (not (> char #/Z)))
+      (and (not (< char #/a))
+	   (not (> char #/z)))))
+
+(defun alpha-userid (name)
+  (implode (mapcan #'(lambda (c) (if (alpha-numeric? c) (ncons c)))
+		   (exploden name))))
+
+
+;;; Various files that we're gonna need to read and write to and from.
+
+(defvar *default-lesson-filename* '((teach) lesson *))
+(defvar *default-script-filename*
+	(caseq (status filesys)
+	  ((ITS) '((dsk *) script >))
+	  ((DEC20) '((ps *) teach-lisp script /0))))
+(defvar *list-of-lessons-filename* '((teach) lessons dir))
+(defvar *ITS-list-of-list-of-lessons-filenames* (list '((teach) lesson *)))
+(defvar *TOPS-20-list-of-lessons-filename* '((teach) lessons dir))
+
+
+;;; Error handlers
+
+(setq fail-act      #'random-lossage-handler)
+(setq unbnd-vrbl    #'unbound-variable-handler)
+(setq undf-fnctn    #'undefined-function-handler)
+(setq wrng-type-arg #'wrong-type-args-handler)
+(setq wrng-no-args  #'wrong-num-args-handler)
+(setq unseen-go-tag #'unseen-go-tag-handler)
+(setq io-lossage    #'io-lossage-handler)
+
+
+;;; Evaluation control
+; Make eval hold our eval-handler.
+
+(setq eval 'eval-handler) 
+
+;;; Interrupt Characters
+
+(sstatus ttyint #^A #'abort-lesson-handler) ;normally (SETQ ^A T)
+;^B is control-B break
+(sstatus ttyint #^C NIL) ;normally (SETQ ^D NIL)
+(sstatus ttyint #^D NIL) ;normally (SETQ ^D T)
+;^E is free
+;^F is free
+(sstatus ttyint #^G #'redefined-^G-handler) ;quit, but recorded
+;^H is free (backspace)
+;^I is free (tab)
+;^J is free (linefeed)
+;^K is free (used by reader)
+;^L is free (used by reader)
+;^M is free (return)
+(sstatus ttyint #^N #'read-lesson-section-handler)
+(sstatus ttyint #^O #'repeat-lesson-section-handler)
+(sstatus ttyint #^P #'read-previous-lesson-section-handler)
+(sstatus ttyint #^Q nil) ;normally (SETQ ^Q T)
+(sstatus ttyint #^R nil) ;normally (SETQ ^R T)
+(sstatus ttyint #^S nil) ;normally (SETQ ^W T)
+(sstatus ttyint #^T nil) ;normally (SETQ ^R NIL)
+;^U is free
+(sstatus ttyint #^V nil) ;normally (SETQ ^W NIL)
+;^X is (ERROR 'QUIT) -- should this be on by default?
+;^Y is free
+;^Z is return to superior
+;^_ is free, but is hard to type anyway
+;^^ is free
+;^\ is free
+;^] is free
+;Alt is alphabetic
+
+;;; **MORE** hacking
+
+   ;; Special var controlling if  quits are enabled.
+
+(setq quit-disable nil)   
+
+   ;; If this is the first time loading the file, save out info on tty
+   ;; initial specifications.
+
+(defvar *tty-spec-info* nil)
+(cond ((not (boundp '*tty-spec-info*))
+       (setq *tty-spec-info* (syscall 3. 'ttyget tyi))))
+
+   ;; This is the DISPLAY stream to output to if we have a 
+   ;; fancy display terminal (opened only if needed.)
+
+(setq display-tyo nil)
+
+   ;; Use our **MORE** handler
+
+(endpagefn tyo '**more**)
+
+
+;;; Random other flags
+
+(setq gc-overflow #'gc-overflow-handler)
+(setq *rset-trap ())
+(setq tty-return-msg "(Console Connected with Teach Lisp)")
+
+
+(sstatus toplevel '(teach-lisp-top-level))
+(sstatus breaklevel '(breakloop t))
+
+;;; Dialect variant definitions
+
+(define-dialect-variant define "DEFUN")
+(define-dialect-variant defq "SETQ")
+(define-dialect-variant df "(DEFUN name FEXPR ...)")
+(define-dialect-variant de "DEFUN")
+(define-dialect-variant def "DEFUN")
+
+(setq *help-wait-time* 120.)
+
+;;; Figure out what all the lessons will have said about them in 
+;;; the menu.
+(get-list-of-lessons)
+(set-up-lesson-descriptions)
+
+
+;;; Local Modes:;
+;;; Mode:LISP;
+;;; Comment Column:50;
+;;; Lisp DEFVAR Indent:-2;
+;;; End:;