1;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;; 2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3;;; The data in this file contains enhancments. ;;;;; 4;;; ;;;;; 5;;; Copyright (c) 1984,1987 by William Schelter,University of Texas ;;;;; 6;;; All rights reserved ;;;;; 7;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8;;; (c) Copyright 1982 Massachusetts Institute of Technology ;;; 9;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10 11(in-package :maxima) 12 13(macsyma-module displm macro) 14 15(declare-top 16 ;; evaluate for declarations 17 (special 18 ^w ;If T, then no output goes to the console. 19 linel ;Width of screen. 20 ttyheight ;Height of screen. 21 22 width height depth maxht maxdp level size lop rop break right 23 bkpt bkptwd bkptht bkptdp bkptlevel bkptout lines 24 oldrow oldcol in-p 25 mratp $aliases)) 26 27;;; macros for the DISPLA package. 28 29;; (PUSH-STRING "foo" RESULT) --> (SETQ RESULT (APPEND '(#/o #/o #/f) RESULT)) 30 31(defmacro push-string (string symbol) 32 (check-arg string stringp "a string") 33 (check-arg symbol symbolp "a symbol") 34 `(setq ,symbol (list* ,@(nreverse (exploden string)) ,symbol))) 35 36;; Macros for setting up dispatch table. 37;; Don't call this DEF-DISPLA, since it shouldn't be annotated by 38;; TAGS and @. Syntax is: 39;; (DISPLA-DEF [<operator>] [<dissym> | <l-dissym> <r-dissym>] [<lbp>] [<rbp>]) 40;; If only one integer appears in the form, then it is taken to be an RBP. 41 42;; This should be modified to use GJC's dispatch scheme where the subr 43;; object is placed directly on the symbol's property list and subrcall 44;; is used when dispatching. 45 46(defmacro displa-def (operator dim-function &rest rest &aux l-dissym r-dissym lbp rbp) 47 (dolist (x rest) 48 (cond ((stringp x) 49 (if l-dissym (setq r-dissym x) (setq l-dissym x))) 50 ((integerp x) 51 (if rbp (setq lbp rbp)) 52 (setq rbp x)) 53 (t (merror "DISPLA-DEF: unrecognized object: ~a" x)))) 54 (when l-dissym 55 (setq l-dissym (if r-dissym 56 (cons (exploden l-dissym) (exploden r-dissym)) 57 (exploden l-dissym)))) 58 `(progn 59 (defprop ,operator ,dim-function dimension) 60 ,(when l-dissym `(defprop ,operator ,l-dissym dissym)) 61 ,(when lbp `(defprop ,operator ,lbp lbp)) 62 ,(when rbp `(defprop ,operator ,rbp rbp)))) 63