home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e070 / 5.ddi / EXPLORER / VIEWER / EXPLORE.LSP < prev    next >
Encoding:
Text File  |  1984-11-04  |  5.6 KB  |  196 lines
  1. ;; San Marco LISP Explorer (TM)
  2. ;; release 2.0 of 22 Oct 84
  3. ;; Copyright (c) 1984 San Marco Associates
  4.  
  5. ;;
  6. ;;aliases
  7. ;;
  8.  
  9. ;;define an alias of a function
  10. (defmacro defalias args
  11.   `(setf (symbol-function ',(first args))
  12.          (symbol-function ',(second args))))
  13.  
  14. ;;make <- be a message-send (funcall)
  15. (defalias <- funcall)
  16.  
  17. ;;make defun-local be defun
  18. (defalias defun-local defun)
  19. (defalias defmacro-local defmacro)
  20.  
  21. ;;make set-symbol be setq
  22. (defalias set-symbol setq)
  23. (defalias set-slocal setq)
  24.  
  25.  
  26. ;;
  27. ;;diskette selection
  28. ;;
  29. (defun exp-with-d (&rest args)
  30.   (when (and *explorer-single-diskette-system*
  31.              (boundp '*screen-active*)
  32.              *screen-active*)
  33.     (<- *query-io* :set-cursorpos 0 0)
  34.     (%sysint #X10 #X200 0 0 0))
  35.   (apply #'with-diskette args))
  36.  
  37. (defun with-viewer (fn path &rest args)
  38.   (apply #'exp-with-d
  39.          *explorer-viewer-diskette*
  40.          fn
  41.          (merge-pathnames (merge-pathnames path ".fas")
  42.                           *explorer-viewer-pathname*)
  43.          args))
  44.  
  45. (defun with-slides (n fn path &rest args)
  46.   (apply #'exp-with-d
  47.          *explorer-slides-diskette*
  48. ;-             (if (= n 1) *explorer-slides1-diskette* *explorer-slides2-diskette*)
  49.          fn
  50.          (merge-pathnames (merge-pathnames path ".tf")
  51.                           *explorer-slides-pathname*)
  52. ;-             (merge-pathnames path (if (= n 1) *explorer-slides1-pathname*
  53. ;-                                               *explorer-slides2-pathname*))
  54.          args))
  55.  
  56.  
  57. ;;
  58. ;;environment variables
  59. ;;
  60.  
  61. ;;default monitor type
  62. (set-symbol *explorer-color* *monitor-is-color*)
  63.  
  64. ;;disk configuration
  65. (set-symbol *explorer-single-diskette-system* *single-diskette-drive-system*)
  66.  
  67. ;;default resident modules
  68. (defvar *explorer-load-all-modules* nil)
  69.  
  70.  
  71. ;;
  72. ;;load variables
  73. ;;
  74. (set-symbol *explorer-core-modules*
  75.   '#(base parameters display history exec inspect tutor-display tutor))
  76. (set-symbol *explorer-all-modules*
  77.   '#(base instantiate parameters display
  78.      history history-read history-write
  79.      exec inspect tutor-display tutor itinerary
  80.      tinspect rworld tworld bworld sworld blocks search
  81.      ))
  82. (set-symbol *inspector-core-modules*
  83.   '#(base parameters display exec tutor-display inspect))
  84.  
  85. (set-symbol *explorer-core-loaded* nil)
  86. (set-symbol *explorer-all-loaded* nil)
  87. (set-symbol *inspector-core-loaded* nil)
  88.  
  89. (set-symbol *utilities-load-message*
  90.   "~%; It will take a minute or two to load the required programs.
  91. ; Now loading various GCLISP utilities.")
  92. (set-symbol *initial-load-message*
  93.   "~%; Now loading the San Marco LISP Explorer (TM).")
  94. (set-symbol *inspector-load-message*
  95.   "~%; Now loading the San Marco Inspector (TM).")
  96.  
  97.  
  98. ;;
  99. ;;loader
  100. ;;
  101. (defun explorer-load-base (&aux *load-verbose*)
  102.   (%sysint #x10 (if *explorer-color* #x003 #x002) 0 0 0)
  103.   (funcall *terminal-io* :set-cursorpos 0 0)
  104.   (explorer-load-utildefs)
  105.   (with-viewer #'fasload "overlay")
  106.   (initialize-module-list)
  107.   (load-module 'parameters)
  108.   (source-load "unstruct")
  109.   (autoload defstruct "defstruc"
  110.             *lisp-library-pathname* *lisp-library-diskette*)
  111.   )
  112.  
  113. (defun explorer-load-utildefs ()
  114.   (format t *utilities-load-message*)
  115.   (with-viewer #'load "defstruc.lsp")
  116.   (with-viewer #'load "wstream.lsp")
  117.   (with-viewer #'load "macro.lsp")
  118.   (with-viewer #'fasload "defs")
  119.   (with-viewer #'fasload "basics")
  120.   (with-viewer #'fasload "compress"))
  121.  
  122. (defun explorer-load (directive)
  123.   (cond (*explorer-all-loaded*)
  124.         (*explorer-load-all-modules*
  125.          (format t *initial-load-message*)
  126.          (map-modules #'load-module *explorer-all-modules*)
  127.          (setf *explorer-all-loaded* t))
  128.         (*explorer-core-loaded*)
  129.         ((eq directive :core)
  130.          (format t *initial-load-message*)
  131.          (map-modules #'load-module *explorer-core-modules*)
  132.          (setf *explorer-core-loaded* t))
  133.         (*inspector-core-loaded*)
  134.         ((eq directive :inspect)
  135.          (format t *inspector-load-message*)
  136.          (map-modules #'load-module *inspector-core-modules*)
  137.          (setf *inspector-core-loaded* t))))
  138.  
  139.  
  140. ;;
  141. ;;top level
  142. ;;
  143.  
  144. (defun i-explore (args keyword directive)
  145.   (case directive
  146.     (:load
  147.      (explorer-load-base)
  148.      (i-explore-internal (first args) (rest args)))
  149.     (:run
  150.      (i-explore-internal (first args) (rest args)))
  151.     (:unload
  152.      (when (and (boundp '*last-loaded-lessons*) (fboundp 'get-lesson))
  153.        (ignore-errors
  154.          (dolist (l *last-loaded-lessons*) (setf (get-lesson l) nil))))
  155.      (source-load "unexplor")
  156.      (autoload i-explore "explore.lsp"
  157.                *explorer-viewer-pathname* *explorer-viewer-diskette*)
  158.      (autoload i-inspect "explore.lsp"
  159.                *explorer-viewer-pathname* *explorer-viewer-diskette*)
  160.      t)))
  161.  
  162. (defun i-inspect (args keyword directive)
  163.   (case directive
  164.     (:load
  165.      (explorer-load-base)
  166.      (explorer-load :inspect)
  167.      (using-modules *inspector-core-modules* (inspect-top-level args)))
  168.     (:run
  169.      (explorer-load :inspect)
  170.      (using-modules *inspector-core-modules* (inspect-top-level args)))
  171.     (:unload
  172.      (source-load "unexplor")
  173.      (autoload i-explore "explore.lsp"
  174.                *explorer-viewer-pathname* *explorer-viewer-diskette*)
  175.      (autoload i-inspect "explore.lsp"
  176.                *explorer-viewer-pathname* *explorer-viewer-diskette*)
  177.      t)))
  178.  
  179. (defun i-explore-internal (directive args)
  180.   (unless directive (setf directive :restart))
  181.   (case directive
  182.     ((:file :files)
  183.      (mapc #'explorer-files args))
  184.     ((:restart :help :itinerary)
  185.      (explorer-load :core)
  186.      (using-modules *explorer-core-modules*
  187.        (catch :explorer-top-level (explore-top-level directive))))
  188.     (otherwise
  189.      (format t "
  190. ; Sorry, the argument ~S is not a known Explorer request.
  191. ; Please try again with one of these-- :HELP :ITINERARY :FILES
  192. ; or use no arguments at all to resume exploration normally.
  193. "         directive)
  194.      'explorer-unknown-request)))
  195.  
  196.