mirror of
https://github.com/PDP-10/its.git
synced 2026-01-15 16:07:01 +00:00
156 lines
4.1 KiB
Common Lisp
Executable File
156 lines
4.1 KiB
Common Lisp
Executable File
;;; -*- 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:;
|