;;; Written by Yasuaki Honda
;;; yhonda@mac.com
;;; Independent Software Developer
;;; Chiba, Japan
;;; Copyright 2002 Yasuaki Honda
;;;
;;; You are granted to use, copy, modify, or distribute this software without
;;; any form of an explicit permission from the author.

;;; This file implements what is described in the NewPackageProposal.rtf
;;; Usage:
;;; Invoke maxima.
;;; perform command to_lisp();
;;; (load "maxima-user-package.lisp") to load this file.
;;; perform (maxima:toplevel)
;;; TOP> is displayed as a prompt.
;;; You can do maxima things like:
;;; TOP> diff(f(x),x);
;;; TOP> integrate(sin(x)*cos(x),x);
;;; TOP> [y0,y1,y2,y3,y4,y5,y6];
;;; however, you can use only exported symbols such as DIFF, SIN, COS and 
;;; INTEGRATE as maxima system symbols.

(in-package :maxima)
(export (list (intern "TOPLEVEL" :maxima)
	      (intern "$DIFF" :maxima)
	      (intern "$SIN" :maxima)
	      (intern "$COS" :maxima)
	      (intern "$INTEGRATE" :maxima))
	:maxima)

;;; create a maxima-user package.
(defpackage :maxima-user
  ;; Use all the exported symbols from maxima. They are Maxima system symbols.
  (:use :maxima)
  ;; This package exports a function named "TOPLEVEL".
  (:export "TOPLEVEL"))

(defun TOPLEVEL ()
  (let ((*package* (find-package :maxima-user)))
    (loop
     (princ "TOP> ")
     (let ((input-line (read-line)))
       ;; you can use quit to quit from this tiny toplevel.
       (if (equal input-line "quit")
	   (return-from TOPLEVEL))
       (with-input-from-string (s input-line)
	 (displa (meval1 (mread s))))))))

;;; The function implode1 is taken from file commac.lisp.
;;; This function interns the symbol.
;;; Last line of the function is changed so that it interns
;;; symbol into "MAXIMA-USER" package instead of "MAXIMA" package.

(defun implode1 (lis upcase &aux (ar *string-for-implode*) (leng 0))
  (declare (type string ar) (fixnum leng))
  (or (> (array-total-size ar) (setq leng (length lis)))
      (adjust-array ar (+ leng 20)))
  (setf (fill-pointer ar) leng)
  (sloop for v in lis
	 for i below leng
	 do
	 (cond ((typep v 'character))
	       ((symbolp v) (setq v (aref (symbol-name v) 0)))
	       ((numberp v) (setq v (code-char v))))
	 (setf (aref ar i) (if upcase (char-upcase v) v)))
  (intern ar :maxima-user))