1 ;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;; The data in this file contains enhancments. ;;;;;
5 ;;; Copyright (c) 1984,1987 by William Schelter,University of Texas ;;;;;
6 ;;; All rights reserved ;;;;;
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 ;;; (c) Copyright 1980 Massachusetts Institute of Technology ;;;
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13 (macsyma-module trutil
)
16 (intern (symbol-name (gensym "TR-GENSYM")) :maxima
))
18 (defun push-defvar (var val
)
19 ;; makes sure there is a form in the beginning of the
20 ;; file that insures the special variable is declared and bound.
21 (or (member var defined_variables
:test
#'eq
)
22 ;; $NO_DEFAULT says that the user takes responsibility for binding.
23 (eq $define_variable
'$no_default
)
24 ;; $MODE is same, but double-checks with the declarations available.
25 (and (eq $define_variable
'$mode
)
27 (do ((l *pre-transl-forms
* (cdr l
)))
29 ;; push one with a priority of 1, which will be over-rided
30 ;; by any user-specified settings.
31 (if (eq $define_variable
'$mode
)
32 (tr-format (intl:gettext
"note: variable ~:M being given a default assignment ~:M~%")
33 var
(if (atom val
) val
34 ;; strip off the quote
36 (push-pre-transl-form `(def-mtrvar ,var
,val
1)))
38 (and (eq (car form
) 'def-mtrvar
)
42 (defun push-pre-transl-form (form)
43 (cond ((member form
*pre-transl-forms
* :test
#'equal
))
45 (push form
*pre-transl-forms
*)
48 (unwind-protect (progn (eval form
) (setq winp t
))
50 (barfo "Bad *pre-transl-forms*"))))))))
52 (defun tr-nargs-check (form &optional
(args-p nil
) (nargs (length (cdr form
))))
53 ;; the maclisp args info format is NIL meaning no info,
54 ;; probably a lexpr. or cons (min . max)
56 (let ((nargs (length (cdr form
)))
57 (min (or (car args-p
) (cdr args-p
)))
59 (cond ((and min
(< nargs min
))
60 (tr-format (intl:gettext
"error: too few arguments supplied to ~:@M~%~:M~%")
63 ((and max
(> nargs max
))
64 (tr-format (intl:gettext
"error: too many arguments supplied to ~:@M~%~:M~%")
67 nargs
) ;; return the number of arguments.