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 1981 Massachusetts Institute of Technology ;;; 9;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10 11(in-package :maxima) 12 13(macsyma-module mformt) 14 15(load-macsyma-macros mforma) 16 17(setf (get '|| 'mformat-ops) nil) 18(setf (get '|| 'mformat-state-vars) nil) 19 20(defmacro def-mformat-op (char &rest body) 21 `(+def-mformat-op ,'|| ,char ,@body)) 22 23(defmacro def-mformat-var (var val init) 24 `(+def-mformat-var ,'|| ,var ,val ,init)) 25 26(defmacro mformat-loop (&rest endcode) 27 `(+mformat-loop ,'|| ,@endcode)) 28 29(def-mformat-var |:-FLAG| nil t) 30(def-mformat-var |@-FLAG| nil t) 31(def-mformat-var parameter 0 t) ; Who can read "~33,34,87A" ? 32(def-mformat-var parameter-p nil t) 33(def-mformat-var text nil nil) 34(def-mformat-var text-temp nil nil) 35(def-mformat-var displa-p nil nil) 36(def-mformat-var pre-%-p nil nil) 37(def-mformat-var post-%-p nil nil) 38 39(defmacro push-text-temp () 40 '(when text-temp 41 (push (cons '(text-string) (nreverse text-temp)) text) 42 (setq text-temp nil))) 43 44(defmacro output-text () 45 '(progn 46 (push-text-temp) 47 (output-text* stream text displa-p pre-%-p post-%-p) 48 (setq text nil 49 displa-p nil 50 pre-%-p nil 51 post-%-p nil))) 52 53(def-mformat-op (#\% #\&) 54 (cond ((or text text-temp) ;; there is text to output. 55 (setq post-%-p t) 56 (output-text)) 57 (t 58 (setq pre-%-p t)))) 59 60(def-mformat-op #\M 61 (push-text-temp) 62 (let ((arg (pop-mformat-arg))) 63 (and |@-FLAG| (atom arg) 64 (setq arg (or (and (symbolp arg) (get arg 'op)) arg))) 65 (cond (|:-FLAG| 66 (push (cons '(text-string) (mstring arg)) text)) 67 (t 68 (setq displa-p t) 69 (push arg text))))) 70 71(def-mformat-op #\A 72 (push-text-temp) 73 (push (cons '(text-string) (exploden (pop-mformat-arg))) text)) 74 75(def-mformat-op #\S 76 (push-text-temp) 77 (push (cons '(text-string) 78 (mapl #'(lambda (c) 79 (rplaca c (get-first-char (car c)))) 80 (explode (pop-mformat-arg)))) 81 text)) 82 83(defun-maclisp mformat n 84 (unless (> n 1) 85 ;; make error message without new symbols. 86 ;; This error should not happen in compiled code because 87 ;; this check is done at compile time too. 88 (maxima-error "MFORMAT: expected two or more arguments.")) 89 (let* ((stream (arg 1)) 90 (sstring (exploden (arg 2))) 91 (arg-index 2)) 92 (when (or (null stream) (eq t stream)) 93 (setq stream *standard-output*)) 94 ;; This is all done via macros to save space, 95 ;; (No functions, no special variable symbols.) 96 ;; If the lack of flexibilty becomes an issue then 97 ;; it can be changed easily. 98 (mformat-loop (output-text)) 99 ;; Keep from getting bitten by buffering. 100 (finish-output stream))) 101 102;;can't change mformat since there are various places where stream = nil means 103;; standard output not a string 104;;note: compile whole file, incremental compiling will not work. 105 106;; AFORMAT 107;; 108;; Basically the same as MFORMAT, which is a "souped-up" FORMAT implementation 109;; with support for the ~M control string. However, unlike MFORMAT, when 110;; DESTINATION is NIL, the function writes its result to a string. 111(defun aformat (destination control-string &rest arguments) 112 (if destination 113 (apply 'mformat destination control-string arguments) 114 (with-output-to-string (st) 115 (let ((*standard-output* st)) 116 (apply 'mformat t control-string arguments))))) 117 118(defun output-text* (stream text displa-p pre-%-p post-%-p) 119 (setq text (nreverse text)) 120 ;; outputs a META-LINE of text. 121 (cond (displa-p (displaf (cons '(mtext) text) stream)) 122 (t 123 (if pre-%-p (terpri stream)) 124 (do () 125 ((null text)) 126 (do ((l (cdr (pop text)) (cdr l))) 127 ((null l)) 128 (write-char (car l) stream))) 129 (if post-%-p (terpri stream))))) 130 131(defun-prop (text-string dimension) (form result) 132 (dimension-atom (maknam (cdr form)) result)) 133 134(defun displaf (object stream) 135 ;; for DISPLA to a file. 136 (if (or (eq stream nil) (eq stream *standard-output*)) 137 (displa object) 138 (let ((*standard-output* stream) 139 (#.ttyoff t)) 140 (displa object)))) 141 142(defun mtell (&rest l) 143 (apply #'mformat nil l)) 144