mirror of
https://github.com/PDP-10/its.git
synced 2026-01-31 05:52:12 +00:00
290 lines
10 KiB
Common Lisp
Executable File
290 lines
10 KiB
Common Lisp
Executable File
;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp; Package: Macsyma -*- ;;;;;;;;;;;;;;;;;;;
|
||
;;; (c) Copyright 1980 Massachusetts Institute of Technology ;;;
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
(macsyma-module edmac macro)
|
||
|
||
#-lispm
|
||
(progn 'compile
|
||
(load-macsyma-macros lmrund)
|
||
(load-macsyma-macros-at-runtime 'lmrund)
|
||
)
|
||
|
||
;; Macsyma display-oriented expression editor
|
||
;; Macros and structure definitions
|
||
;; See EMAXIM;ED > and EMAXIM;EDCOM > for more information.
|
||
;; Written: Feb 17, 1979 By RZ, based on a version by CWH and BEE
|
||
;; Rewritten: June 2, 1979 by CWH for Macsyma Users' Conference
|
||
;; Alt: July 1, 1981 by GJC, annointing for NIL.
|
||
|
||
;; Data Structures
|
||
|
||
;; The smallest fundamental data unit is the expression -- this consists of a
|
||
;; macsyma expression, formatting information, a displayed region, and a
|
||
;; command region. Buffers consist of a collection of expressions and may
|
||
;; share expressions among one another. A subset of the expressions within a
|
||
;; buffer will be displayed in a window. Only complete sub expressions are
|
||
;; displayed, although REVEAL may be used to hide inner structure.
|
||
|
||
(defstruct (expression)
|
||
body ;Body of the expression. A complete
|
||
;subnode of this expression is always
|
||
;displayed.
|
||
displayed ;The displayed portion of the expression.
|
||
;Always a complete subnode.
|
||
region ;That portion of the expression which
|
||
;subsequent commands will affect. May
|
||
;be several branches of a subnode.
|
||
(save-pdl nil) ;Current way of keeping track of where
|
||
;we are.
|
||
(region-length 1) ;Region length -- number of branches included
|
||
;in region. Normally 1 unless extended with
|
||
;extend-forward.
|
||
(operator nil) ;Operator of region node, i.e. this level
|
||
(operand nil) ;Entire node, i.e. the level itself
|
||
;The are both nil when the region is the same
|
||
;as the body.
|
||
expression-label ;Need some way of referring to expressions
|
||
;within a buffer. This label is a symbol
|
||
;and is bound to the body of the expression.
|
||
expression-height ;The height in characters of the expression.
|
||
;Used by the redisplay.
|
||
(reveal-depth 0) ;If depth = 0, then reveal all of expression.
|
||
;See Macsyma $REVEAL function.
|
||
(region-boxed? nil) ;Right now, this means that the expression
|
||
;is current.
|
||
)
|
||
|
||
(defstruct (buffer)
|
||
buffer-name ;Name of the buffer. Used for moving between
|
||
;them.
|
||
(expression-list nil) ;All of the expressions contained within
|
||
;the buffer. Currently, all are displayed.
|
||
(current-exp nil) ;The current expression in this buffer.
|
||
(current-exp-distance-from-top 0) ;If this field is 0, then the
|
||
;current expression is the top expression on
|
||
;the screen.
|
||
(buffer-mode '|Expression|) ;Do we want this?
|
||
)
|
||
|
||
|
||
;; Command definition macro
|
||
|
||
;; Defines an editor command (and a lisp function) with the specified name.
|
||
;; The possible options are:
|
||
;;
|
||
;; (argument n) Makes "n" an entry in the bvl of the function.
|
||
;; Means that this function gets passed its argument
|
||
;; which it uses as it pleases.
|
||
;;
|
||
;; (discard-argument) This function doesn't use its argument and
|
||
;; and doesn't want to be iterated. If neither
|
||
;; of the above two argument options are specified,
|
||
;; then the character dispatcher will iterate the
|
||
;; command if an argument is given.
|
||
;;
|
||
;; (character c) Makes "c" an entry in the bvl of the function. Means
|
||
;; that this function gets passed the character which
|
||
;; invoked it.
|
||
;;
|
||
;; (read-key key "Key: ") This function wants a character to be typed
|
||
;; for purposes of description, assignment, etc.
|
||
;; Control and Meta prefixes are taken care of
|
||
;; by READ-KEY.
|
||
;;
|
||
;; (read-line file-name "File Name: ") This function wants a string
|
||
;; argument to be typed in the
|
||
;; minibuffer, terminated by a
|
||
;; carriage return. "file-name"
|
||
;; will be in the bvl of the function.
|
||
;;
|
||
;; (read-expression exp "Expression: ") This function wants a macsyma
|
||
;; expression as an argument.
|
||
;; Expression returned in the
|
||
;; macsyma internal format.
|
||
;;
|
||
;; Note that the CDDR of the forms starting with READ-LINE and READ-EXPRESSION
|
||
;; can be any arbitrary format string. Note also that the order in which these
|
||
;; forms appear in the bvl is critical. They must appear in the same order
|
||
;; as presented above.
|
||
|
||
;; (defcom foo ((argument n) (character c) (read-line line "Type a ~A:" frobboz))
|
||
;; "Random documentation"
|
||
;; (random-code)) -->
|
||
;;
|
||
;; (progn 'compile
|
||
;; (putprop 'foo 'ed-documentation "Random documentation")
|
||
;; (putprop 'foo 'ed-arg-action 'pass)
|
||
;; (putprop 'foo 'ed-char-action 'pass)
|
||
;; (defun foo (n c &optional (line (read-line "Type a ~A:" frobboz)))
|
||
;; (random-code)))
|
||
|
||
(defmacro defcom (name option-list documentation &rest body)
|
||
(let ((arg-list nil)
|
||
(arg-action 'iterate)
|
||
(char-action 'discard))
|
||
(mapcar
|
||
#'(lambda (option)
|
||
(caseq (car option)
|
||
(argument (push (cadr option) arg-list)
|
||
(setq arg-action 'pass))
|
||
(discard-argument (setq arg-action 'discard))
|
||
(character (push (cadr option) arg-list)
|
||
(setq char-action 'pass))
|
||
(read-key
|
||
(or (memq '&optional arg-list)
|
||
(push '&optional arg-list))
|
||
(push `(,(cadr option) (progn (minibuffer-clear)
|
||
(read-key nil t . ,(cddr option))))
|
||
arg-list))
|
||
((read-line read-expression)
|
||
(or (memq '&optional arg-list)
|
||
(push '&optional arg-list))
|
||
(push `(,(cadr option) (,(car option) . ,(cddr option)))
|
||
arg-list))
|
||
(t (error "Unknown defcom option" (car option)))))
|
||
option-list)
|
||
(setq arg-list (nreverse arg-list))
|
||
`(progn 'compile
|
||
(putprop ',name ,documentation 'ed-documentation)
|
||
(putprop ',name ',arg-action 'ed-arg-action)
|
||
(putprop ',name ',char-action 'ed-char-action)
|
||
#+maclisp
|
||
,@(if (memq '&optional arg-list) `((declare (*lexpr ,name))))
|
||
(defun ,name ,arg-list . ,body))))
|
||
|
||
;; Compatibility macros and other random stuff
|
||
|
||
(defmacro string-capitalize (string)
|
||
`(string-append (string-upcase (substring ,string 0 1))
|
||
(string-downcase (substring ,string 1))))
|
||
|
||
|
||
;; Useful predicates for examining the state of an expression.
|
||
;; Please use these if possible so as to avoid dependence upon our
|
||
;; current form of expression representation.
|
||
|
||
; (eq (body current-exp) (region current-exp)) is also a test for this.
|
||
(defmacro region-contains-top-node? ()
|
||
'(null (save-pdl current-exp)))
|
||
|
||
(defmacro region-contains-terminal-node? ()
|
||
'(atom (cadr (region current-exp))))
|
||
|
||
; (eq (caar (save-pdl current-exp)) 'CDR) is also a test for this.
|
||
(defmacro region-contains-first-branch? ()
|
||
'(eq (region current-exp) (operand current-exp)))
|
||
|
||
(defmacro region-contains-last-branch? ()
|
||
'(null (nthcdr (1+ (region-length current-exp))
|
||
(region current-exp))))
|
||
|
||
(defmacro region-contains-entire-level? ()
|
||
'(= (region-length current-exp)
|
||
(length (cdr (operand current-exp)))))
|
||
|
||
|
||
;; Declarations:
|
||
|
||
(if (fboundp 'special)
|
||
(special buffer-list ;All of the buffers being used.
|
||
;Maintained between invocations
|
||
current-buffer ;Contains the current expression.
|
||
current-exp ;Expression currently being edited.
|
||
|
||
screen-exp-list ;Redisplay state information
|
||
screen-buffer-name ;Should be made intelligent about
|
||
screen-exp-list-length ;windows.
|
||
|
||
previous-buffer ;Previously selected buffer
|
||
|
||
single-char-table ;Dispatch table for single character commands
|
||
c-x-prefix-table ;Dispatch table for control-x prefix commands
|
||
single-char-table-size ;Size of array
|
||
c-x-prefix-table-size ;Size of array
|
||
|
||
buffer-name-count ;For generating buffer names
|
||
kill-pdl ;pdl of deleted expressions
|
||
mark-pdl ;pdl of marks
|
||
need-full-redisplay ;When screen has been completely destroyed
|
||
;Rename to full-redisplay?
|
||
supress-redisplay ;Deliberately supress redisplay until after
|
||
;next command typed.
|
||
|
||
char-to-descriptor-alist ;For converting between
|
||
descriptor-to-char-alist ;characters and their
|
||
;description.
|
||
|
||
idel-chars-available? ;Terminal control information
|
||
idel-lines-available?
|
||
overstrike-available?
|
||
12-bit-kbd-available?
|
||
12-bit-input ;Fixnum input stream for
|
||
;Knight keyboards.
|
||
|
||
%kbd-control ;Bit specifiers for the appropriate
|
||
%kbd-meta ;fields in the Lisp Machine character
|
||
%kbd-control-meta ;representation.
|
||
|
||
*multiple-keystroke-char-typed* ;READ-KEY has to return
|
||
;two values, but can't in Maclisp. Use this
|
||
;global instead. Indicates that a control
|
||
;or meta prefix was typed as a part of the
|
||
;most recently typed character.
|
||
|
||
expr-area-height ;Screen parameters.
|
||
minibuffer-height ;Single window only.
|
||
mode-line-vpos
|
||
minibuffer-vpos
|
||
))
|
||
|
||
(if (fboundp 'fixnum)
|
||
(fixnum screen-region-length buffer-name-count
|
||
single-char-table-size c-x-prefix-table-size
|
||
expr-area-height minibuffer-height
|
||
mode-line-vpos minibuffer-vpos
|
||
%kbd-control %kbd-meta %kbd-control-meta
|
||
))
|
||
|
||
;; Macsyma special variables
|
||
|
||
(if (fboundp 'special)
|
||
(special $outchar $boxchar ttyheight linel $linenum))
|
||
|
||
(if (fboundp 'fixnum)
|
||
(fixnum ttyheight linel $linenum))
|
||
|
||
;; Special variables in MRG;DISPLA
|
||
|
||
(load-macsyma-macros-at-runtime 'displm)
|
||
|
||
;; Inter-module functions -- generally I/O stuff.
|
||
|
||
(if (fboundp '*expr)
|
||
(*expr ed-prologue ed-epilogue enable-echoing disable-echoing
|
||
display-expression display-expressions display-mode-line
|
||
dctl-clear-lines dctl-scroll-region-up dctl-scroll-region-down
|
||
minibuffer-clear expr-area-clear read-char tv-beep
|
||
label-exp box-region unbox-region
|
||
region-as-mexp delete-expression top-level
|
||
make-current-exp make-current-buffer full-redisplay))
|
||
|
||
(if (fboundp '*lexpr)
|
||
(*lexpr set-key make-exp
|
||
read-key read-line read-expression
|
||
minibuffer-print char-to-descriptor
|
||
ed-error ed-internal-error
|
||
replace-region select-buffer))
|
||
|
||
(if (fboundp 'notype)
|
||
(notype (dctl-clear-lines fixnum fixnum)
|
||
(dctl-scroll-region-up fixnum fixnum fixnum)
|
||
(dctl-scroll-region-down fixnum fixnum fixnum)))
|
||
|
||
;; Macsyma system functions.
|
||
(if (fboundp '*expr)
|
||
(*expr retrieve simplify ssimplifya nformat-all meval makelabel mset
|
||
$partfrac))
|
||
|
||
(sstatus feature emaxim-edmac)
|