archive/src/buffer1.lisp

   1 ;;; -*- Mode: Lisp; package:maxima; syntax:common-lisp -*- ;;;;;;;;;;;;;;;;;
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;;     The data in this file contains enhancments.                    ;;;;;
   4 ;;;                                                                    ;;;;;
   5 ;;;     Copyright (c) 1984 by William Schelter,University of Texas     ;;;;;
   6 ;;;     All rights reserved                                            ;;;;;
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8
   9
  10
  11 (defvar $default_buffer_name '&Macsyma_Buffer)
  12
  13
  14
  15 (defun into-buffer-name (args)
  16   (let ((name (cond ((zl-NLISTP args)           ;
  17                      $default_buffer_name)
  18                     ((and ($listp (car args))
  19                           (not (null (cadr args))))
  20                      (cadr args))
  21                     (($listp (cadr args))
  22                      (car args))
  23                     (t $default_buffer_name))))
  24     (substring (strmeval name) 1)))
  25
  26
  27
  28 (defun into-buffer-objs (args)
  29   (let ((objs (cond ((zl-NLISTP args)
  30                      args)
  31                     (($listp (car args))
  32                      (cdar args))
  33                     (($listp (cadr args))
  34                      (cdadr args))
  35                     (t args))))
  36     (mapcar #'meval objs)))
  37
  38
  39
  40 (defmspec $into_buffer (args)
  41   (let ((buffer-name (into-buffer-name (cdr args)))
  42         (things-to-output (into-buffer-objs (cdr args))))
  43     (if (null things-to-output)
  44         (merror "INTO_BUFFER: No objects given to put in to buffer"))
  45     (let ((temp zwei::*default-major-mode* ))
  46       ;(setf zwei::*default-major-mode* :macsyma)
  47       (zwei::with-editor-stream (*standard-output* ':buffer-name buffer-name)
  48                                (loop for element in things-to-output
  49                                      do (cl-macsyma::i-$grind element)
  50                                      (format t "~&")))
  51       ;(setf zwei::*default-major-mode* temp )
  52       )
  53   '$done))
  54
  55
  56
  57 (defvar $edlinenum 1)
  58
  59
  60
  61 (defun zwei::macsyma-arglist (fun &aux  spec)
  62   (cond
  63     ((setq spec (get fun 'mfexpr*))(arglist spec))
  64     ((setq spec (mgetl fun '(mexpr aexpr fexpr)))
  65          (cdr (second (second spec))))))
  66
  67
  68
  69
  70 (defun new-concat (&rest l) (intern (lexpr-funcall 'string-append "$" (mapcar 'string l))
  71        'macsyma))
  72
  73 (defun $new_concat (&rest l) (intern (lexpr-funcall 'string-append "$" (mapcar 'string l))
  74        'macsyma))
  75